(FILECREATED "10-Oct-85 16:19:24" {ERIS}<TEDIT>TEDITPAGE.;22 58107
changes to: (FNS TEDIT.FORMATTEXTBOX TEDIT.SINGLE.PAGEFORMAT TEDIT.FORMAT.HARDCOPY)
previous date: "25-Sep-85 16:14:36" {ERIS}<TEDIT>TEDITPAGE.;19)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITPAGECOMS)
(RPAQQ TEDITPAGECOMS ((RECORDS PAGEFORMATTINGSTATE PAGEREGION)
[VARS (MAXPAGE# 65535)
(MINPAGE# 1)
(TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1)
(TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL (QUOTE LEFT)
72 72 72 72 NIL 1)
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL (QUOTE RIGHT)
72 72 72 72 NIL 1]
(COMS (* Creation, GET, and PUT of page frames.)
(FNS TEDIT.GET.PAGEFRAMES TEDIT.PARSE.PAGEFRAMES TEDIT.PUT.PAGEFRAMES
TEDIT.UNPARSE.PAGEFRAMES))
(COMS (* For setting up page layouts)
(FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT \MICASTOPTS
\PTSTOMICAS))
(COMS (* Perform page layout, based on a regular expression of typed regions.)
(FNS TEDIT.FORMAT.HARDCOPY TEDIT.FORMATBOX TEDIT.FORMATHEADING TEDIT.FORMATPAGE
TEDIT.FORMATTEXTBOX TEDIT.FORMATFOLIO)
(* Aux function to capture page headings during line formatting.)
(FNS TEDIT.HARDCOPY.PAGEHEADING))
(COMS (* Handle varying paper sizes)
(FNS SCALEPAGEUNITS SCALEPAGEXUNITS SCALEPAGEYUNITS \TEDIT.PAPERHEIGHT
\TEDIT.PAPERWIDTH)
(GLOBALVARS TEDIT.PAPER.SIZES)
[VARS (TEDIT.PAPER.SIZES (QUOTE ((A0 2384 3370)
(A1 1684 2384)
(A2 1191 1684)
(A3 842 1191)
(A4 595 842)
(A5 420 595)
(B0 2835 4008)
(B1 2004 2835)
(B2 1417 2004)
(B3 1001 1417)
(B4 709 1001)
(B5 499 709]
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TEDITPAPERSIZE)))
(COMS (* Page numbering option support)
(FNS ROMANNUMERALS))))
[DECLARE: EVAL@COMPILE
(RECORD PAGEFORMATTINGSTATE (PAGE# (* The current page number.
Counted from 1)
FIRSTPAGE
(* T if the current page is the "first page". Is set initially, and can be set again by the user at will.
Gets reset after each page image is printed.)
MINPAGE# (* The page # of the first page to be printed, or NIL)
MAXPAGE# (* The page # of the last page to be printed, or NIL)
STATE (* One of FORMATTING or SEARCHING.)
REQUIREDREGIONTYPE (* If STATE is SEARCHING, the kind of box we're
looking for.)
MAINSTREAM (* The principal textobj/stream source)
CHNO (* Our position in that stream)
PRESSREGION (* The press code's REGION info.)
PAGEHEADINGS (* The list of current values to be printed, indexed
by heading type)
PAGE#GENERATOR (* List of page numbers; later, maybe, a function to
generate page numbers. Used to fill in PAGE#TEXT,
below)
PAGE#TEXT (* If special page numbers are in use, this is the
place to take them from. PAGE# is still used for
recto/verso decisions &c)
PAGEISRECTO (* T if this is a recto page, NIL if it's a VERSO
page.)
PAGEFOOTNOTELINES (* A list of extant footnote lines that should appear
at the next opportunity)
PAGEFLOATINGTOPLINES (* A list of lines that should float to the top of the
next available place)
))
(DATATYPE PAGEREGION (REGIONFILLMETHOD (* What kind of a region this is -- TEXT, FOLIO,
PAGEHEADING, etc.)
REGIONSPEC (* The page-relative region this occupies)
REGIONLOCALINFO (* A PLIST for local information)
(REGIONPARENT FULLXPOINTER)
(* The parent node for this box, for sub-boxes)
REGIONSUBBOXES (* The sub-regions of this region)
REGIONTYPE (* A user-settable region type)
))
]
(/DECLAREDATATYPE (QUOTE PAGEREGION)
(QUOTE (POINTER POINTER POINTER FULLXPOINTER POINTER POINTER))
(QUOTE ((PAGEREGION 0 POINTER)
(PAGEREGION 2 POINTER)
(PAGEREGION 4 POINTER)
(PAGEREGION 6 FULLXPOINTER)
(PAGEREGION 8 POINTER)
(PAGEREGION 10 POINTER)))
(QUOTE 12))
(RPAQQ MAXPAGE# 65535)
(RPAQQ MINPAGE# 1)
(RPAQ TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1)
(TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL (QUOTE LEFT)
72 72 72 72 NIL 1)
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL (QUOTE RIGHT)
72 72 72 72 NIL 1)))
(* Creation, GET, and PUT of page frames.)
(DEFINEQ
(TEDIT.GET.PAGEFRAMES
[LAMBDA (FILE) (* jds "18-Jun-84 02:55")
(* Read a bunch of page frames from the file, and return
it.)
(TEDIT.PARSE.PAGEFRAMES (READ FILE])
(TEDIT.PARSE.PAGEFRAMES
[LAMBDA (PAGELIST PARENT) (* jds "31-Jul-84 15:30")
(* Take an external pageframe and internalize it.)
(PROG (FRAMETYPE PAGEFRAME)
(COND
((type? PAGEREGION PAGELIST)
(RETURN PAGELIST))
((NEQ (QUOTE LIST)
(SETQ FRAMETYPE (pop PAGELIST)))
[SETQ PAGEFRAME (create PAGEREGION
REGIONFILLMETHOD ← FRAMETYPE
REGIONTYPE ←(pop PAGELIST)
REGIONLOCALINFO ←(pop PAGELIST)
REGIONSPEC ←(OR (pop PAGELIST)
(LIST 0 0 0 0]
(replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST)
collect (TEDIT.PARSE.PAGEFRAMES ALIST
PAGEFRAME)))
(RETURN PAGEFRAME))
(T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES FRAMESPEC NIL]
)
(TEDIT.PUT.PAGEFRAMES
[LAMBDA (FILE PAGEFRAMES) (* jds "31-Jul-84 15:22")
(* Put out a description of a set of page-layout frames)
(PROG (STR)
(\DWOUT FILE 0) (* The length of this run of looks)
(\SMALLPOUT FILE \PieceDescriptorPAGEFRAME) (* Mark this as a set of page frames)
(PRIN3 (TEDIT.UNPARSE.PAGEFRAMES PAGEFRAMES)
FILE])
(TEDIT.UNPARSE.PAGEFRAMES
[LAMBDA (PAGEFRAME) (* jds "31-Jul-84 15:00")
(* Take an internal page frame, and create an equivalent
list structure.)
(COND
[(LISTP PAGEFRAME)
(LIST (QUOTE LIST)
(for FRAME in PAGEFRAME collect (TEDIT.UNPARSE.PAGEFRAMES FRAME]
(T (LIST (fetch REGIONFILLMETHOD of PAGEFRAME)
(fetch REGIONTYPE of PAGEFRAME)
(fetch REGIONLOCALINFO of PAGEFRAME)
(fetch REGIONSPEC of PAGEFRAME)
(for SUBREGION in (fetch REGIONSUBBOXES of PAGEFRAME) collect (TEDIT.UNPARSE.PAGEFRAMES
SUBREGION])
)
(* For setting up page layouts)
(DEFINEQ
(TEDIT.SINGLE.PAGEFORMAT
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
PAGEPROPS PAPERSIZE) (* jds " 8-Oct-85 15:26")
(* Given a description in the args, create a pageframe
to describe a single kind of page.)
(PROG ([PAGEREGION (create PAGEREGION
REGIONFILLMETHOD ←(QUOTE PAGE)
REGIONSPEC ←(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 612
HEIGHT ← 792)
REGIONLOCALINFO ←(CONS (QUOTE PAPERSIZE)
(CONS PAPERSIZE PAGEPROPS]
(PAPERWIDTH (\TEDIT.PAPERWIDTH PAPERSIZE))
(PAPERHEIGHT (\TEDIT.PAPERHEIGHT PAPERSIZE))
PAGEWIDTH SUBREGIONS FOLIO FOLIOLEFT SCALEFACTOR HEADINGREGIONS)
(SELECTQ UNITS
((POINTS NIL) (* If units are in printers points, the default, do no
scaling)
(SETQ SCALEFACTOR 1))
(PICAS (* The units are in picas--12pts per.
Scale all values.)
(SETQ SCALEFACTOR 12))
(INCHES (* The units are in inches, at 72.27pts per.
Set the scale factor)
(SETQ SCALEFACTOR 72))
(MICAS (* The units are MICAS, at 2540 to the inch.)
(SETQ SCALEFACTOR .02834646))
[CM (* Units are in CM, at 72.27/2.54pts per.)
(SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 72 2.54]
(\ILLEGAL.ARG UNITS)) (* We need to do the scaling.)
(SETQ PX (SCALEPAGEXUNITS PX SCALEFACTOR PAPERSIZE))
(SETQ PY (SCALEPAGEYUNITS PY SCALEFACTOR PAPERSIZE))
[AND LEFT (SETQ LEFT (FIXR (FTIMES LEFT SCALEFACTOR]
[AND RIGHT (SETQ RIGHT (FIXR (FTIMES RIGHT SCALEFACTOR]
[AND TOP (SETQ TOP (FIXR (FTIMES TOP SCALEFACTOR]
[AND BOTTOM (SETQ BOTTOM (FIXR (FTIMES BOTTOM SCALEFACTOR]
[AND COLWIDTH (SETQ COLWIDTH (FIXR (FTIMES COLWIDTH SCALEFACTOR]
[AND INTERCOL (SETQ INTERCOL (FIXR (FTIMES INTERCOL SCALEFACTOR]
[SETQ HEADINGS (for HDG in HEADINGS collect (LIST (CAR HDG)
(SCALEPAGEXUNITS
(CADR HDG)
SCALEFACTOR PAPERSIZE)
(SCALEPAGEYUNITS
(CADDR HDG)
SCALEFACTOR PAPERSIZE]
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
LEFT))
(COND
[PAGE#S? (SELECTQ PQUAD
(LEFT (* If the page number is flush left, set up the region
to start where he specified.)
(SETQ FOLIOLEFT PX))
(RIGHT (* If it's flush right, set up the region to END
there)
(SETQ FOLIOLEFT (IDIFFERENCE PX 288)))
((CENTERED NIL) (* Otherwise, center the page number around the point
he specifies)
(SETQ FOLIOLEFT (IDIFFERENCE PX 144)))
(SHOULDNT))
[SETQ SUBREGIONS
(LIST (SETQ FOLIO
(create PAGEREGION
REGIONFILLMETHOD ←(QUOTE FOLIO)
REGIONSPEC ←(create REGION
LEFT ← FOLIOLEFT
BOTTOM ← PY
WIDTH ← 288
HEIGHT ← 36]
(replace REGIONLOCALINFO of FOLIO
with (LIST (QUOTE PARALOOKS)
(LIST (QUOTE QUAD)
(OR PQUAD (QUOTE CENTERED)))
(QUOTE CHARLOOKS)
(\TEDIT.UNPARSE.CHARLOOKS.LIST (
\TEDIT.PARSE.CHARLOOKS.LIST
PFONT))
(QUOTE FORMATINFO)
(LISTGET PAGEPROPS (QUOTE FOLIOINFO]
(T (SETQ SUBREGIONS NIL)))
[COND
(HEADINGS (* There are page headings specified for this page.)
[SETQ HEADINGREGIONS (for HEADING in HEADINGS
collect
(* Run thru the list of headings, building a box for each. By default, a heading will have the same width right
margin as the left margin that was specified.)
(create
PAGEREGION
REGIONFILLMETHOD ←(QUOTE HEADING)
REGIONSPEC ←(create
REGION
LEFT ←(CADR HEADING)
BOTTOM ←(CADDR HEADING)
WIDTH ←(IMAX (IDIFFERENCE
PAPERWIDTH
(CADR HEADING))
72)
HEIGHT ← 36)
REGIONLOCALINFO ←(LIST (QUOTE
HEADINGTYPE)
(CAR HEADING]
(SETQ SUBREGIONS (APPEND SUBREGIONS HEADINGREGIONS]
[COND
[(OR (NULL COLS)
(IEQP COLS 1)) (* There is a single column, so treat it as just one
text region bounded by the page margins.)
(SETQ SUBREGIONS
(NCONC1 SUBREGIONS
(create PAGEREGION
REGIONFILLMETHOD ←(QUOTE TEXT)
REGIONSPEC ←(create REGION
LEFT ← LEFT
BOTTOM ← BOTTOM
WIDTH ← PAGEWIDTH
HEIGHT ←(IDIFFERENCE (IDIFFERENCE
PAPERHEIGHT TOP)
BOTTOM]
(T (* There are several columns.
We need to create a text box for each col.)
[COND
[(NULL COLWIDTH) (* He wants us to fill in the column width, given
margins and intercolumn spacing.)
(COND
[INTERCOL (SETQ COLWIDTH (FIXR (FQUOTIENT (IDIFFERENCE
PAGEWIDTH
(ITIMES INTERCOL
(SUB1 COLS)))
COLS]
(T (* Can't default both of them.)
(SHOULDNT "Can't default both Col width and spacing"]
((NULL INTERCOL) (* Or else he wants to give us just the col width and
have us calc the spacing.)
(SETQ INTERCOL (FIXR (FQUOTIENT (IDIFFERENCE PAGEWIDTH (ITIMES
COLWIDTH
COLS))
(SUB1 COLS]
(for COL from 1 to COLS as CLEFT from LEFT by (IPLUS COLWIDTH INTERCOL)
do (SETQ SUBREGIONS
(NCONC1 SUBREGIONS
(create PAGEREGION
REGIONFILLMETHOD ←(QUOTE TEXT)
REGIONSPEC ←(create REGION
LEFT ← CLEFT
BOTTOM ← BOTTOM
WIDTH ← COLWIDTH
HEIGHT ←(IDIFFERENCE
(IDIFFERENCE PAPERHEIGHT TOP)
BOTTOM]
(replace REGIONSUBBOXES of PAGEREGION with SUBREGIONS)
(RETURN PAGEREGION])
(TEDIT.COMPOUND.PAGEFORMAT
[LAMBDA (FIRST VERSO RECTO) (* jds "27-Jul-84 10:15")
(create PAGEREGION
REGIONFILLMETHOD ←(QUOTE SEQUENCE)
REGIONSUBBOXES ←(LIST FIRST (create PAGEREGION
REGIONFILLMETHOD ←(QUOTE ALTERNATE)
REGIONSUBBOXES ←(LIST (OR VERSO FIRST)
(OR RECTO VERSO FIRST))
REGIONSPEC ←(LIST 0 0 0 0)))
REGIONSPEC ←(LIST 0 0 0 0])
(TEDIT.PAGEFORMAT
[LAMBDA (STREAM FORMAT) (* jds "22-Jul-85 15:20")
(* Programmatic interface for page formatting)
(PROG ((TEXTOBJ (TEXTOBJ STREAM)))
(COND
((OR (type? PAGEREGION FORMAT)
(LISTP FORMAT))
(replace TXTPAGEFRAMES of TEXTOBJ with FORMAT)
(replace \DIRTY of TEXTOBJ with T))
(T (\ILLEGAL.ARG FORMAT])
(\MICASTOPTS
[LAMBDA (MicaValue) (* jds "31-Jul-84 13:56")
(FIXR (FQUOTIENT MicaValue 35.27778])
(\PTSTOMICAS
[LAMBDA (PointValue) (* jds "19-Jan-85 16:40")
(FIXR (FTIMES PointValue 35.27778])
)
(* Perform page layout, based on a regular expression of typed regions.)
(DEFINEQ
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG#)
(* jds " 7-Oct-85 17:32")
(* * Format a document for hardcopy)
(RESETLST (PROG ((TEXTOBJ (TEXTOBJ STREAM))
(FORCENEXTPAGE NIL)
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
PAGE# ←(COND
((NUMBERP FIRSTPG#))
(T NIL))
FIRSTPAGE ← T
STATE ← FIRSTPG#
MINPAGE# ← 1
MAXPAGE# ← 65535
CHNO ← 1
PAGEHEADINGS ←(LIST NIL NIL)
PAGE#GENERATOR ←(AND (LISTP FIRSTPG#)
(CDR FIRSTPG#))
PAGE#TEXT ←(AND (LISTP FIRSTPG#)
(CAR FIRSTPG#]
TEXTLEN THISLINE LINE REGION LINES NCHNO PRSTREAM PAGEFRAMES SCRATCHFILE
WASOPEN BEFOREFN AFTERFN)
(SETQ PAGEFRAMES (OR (fetch TXTPAGEFRAMES of TEXTOBJ)
TEDIT.PAGE.FRAMES))
[COND
((LISTP PAGEFRAMES) (* If it's a list, pack it into a real set of specs.)
(SETQ PAGEFRAMES (TEDIT.COMPOUND.PAGEFORMAT (CAR PAGEFRAMES)
(CADR PAGEFRAMES)
(CADDR PAGEFRAMES]
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ THISLINE (fetch THISLINE of TEXTOBJ))
(replace PRESSREGION of FORMATTINGSTATE with TEDIT.DEFAULTPAGEREGION)
(* Print in the usual region on the page)
[SETQ BREAKPAGETITLE (COND
(BREAKPAGETITLE)
((LISTGET PRINTOPTIONS (QUOTE DOCUMENT.NAME)))
([OR (NOT (fetch TXTFILE of TEXTOBJ))
(type? STREAM (fetch FULLNAME of (fetch TXTFILE
of TEXTOBJ)))
(type? STRINGP (fetch TXTFILE of TEXTOBJ))
(type? STRINGP (fetch FULLNAME of (fetch TXTFILE
of TEXTOBJ]
"TEdit Hardcopy Output")
(T (fetch FULLNAME of (fetch TXTFILE of TEXTOBJ]
[SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM STREAM]
(SETQ BEFOREFN (TEXTPROP TEXTOBJ (QUOTE BEFOREHARDCOPYFN)))
[COND
(BEFOREFN (* Let the guy do any pre-hardcopy processing he wants
to do)
(COND
((EQ (QUOTE DON'T)
(APPLY* BEFOREFN TEXTSTREAM TEXTOBJ))
(* If it says not to do the hardcopy, then don't.)
(RETURN]
(RESETLST (SETQ AFTERFN (TEXTPROP TEXTOBJ (QUOTE AFTERHARDCOPYFN)))
(AND AFTERFN (RESETSAVE NIL (LIST AFTERFN TEXTSTREAM)))
(* Set up to do the user's cleanup on the way out, as
well.)
(TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
[COND
((AND FILE (OPENP FILE)
(IMAGESTREAMTYPE FILE))
(* The file he handed us is already an image-type
file. Just append the new stuff to it.)
(SETQ WASOPEN T)
(SETQ PRSTREAM FILE))
(T (* T'wasn't an image stream, so let's open us one.)
(RESETSAVE (SETQ PRSTREAM
(OPENIMAGESTREAM
SCRATCHFILE
[OR IMAGETYPE
(SETQ IMAGETYPE
(CAR (PRINTERPROP (PRINTERTYPE
SERVER)
(QUOTE
CANPRINT]
(LIST (QUOTE FONT)
(FONTCREATE (QUOTE GACHA)
10)
(QUOTE BREAKPAGEFILENAME)
BREAKPAGETITLE)))
(QUOTE (AND RESETSTATE (DELFILE
(CLOSEF? OLDVALUE]
(* So we close and delete the file in case of
trouble.)
(STREAMPROP PRSTREAM (QUOTE FORMATTINGSTATE)
FORMATTINGSTATE)
(* So that subsidiary people can find out the state of
the formatting.)
(while (ILEQ (fetch CHNO of FORMATTINGSTATE)
TEXTLEN)
do (for REGION inside PAGEFRAMES
do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM
(fetch CHNO of
FORMATTINGSTATE)
REGION FORMATTINGSTATE
IMAGETYPE)))
[COND
((NOT WASOPEN) (* Only if we created the image stream should we close
it.)
(SETQ PRSTREAM (CLOSEF PRSTREAM))
(OR DONTSEND (SEND.FILE.TO.PRINTER
PRSTREAM SERVER (APPEND PRINTOPTIONS
(LIST (QUOTE
DOCUMENT.NAME)
BREAKPAGETITLE]
(OR FILE (DELFILE SCRATCHFILE)))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (MKSTRING
(SUB1 (fetch (PAGEFORMATTINGSTATE
PAGE#)
of FORMATTINGSTATE)))
"pg done."])
(TEDIT.FORMATBOX
[LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE SERVERTYPE)
(* jds "19-Feb-85 14:57")
(* Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line
descriptors which, taken together, fill the region.)
(PROG ((REGIONSPEC (fetch (PAGEREGION REGIONSPEC) of REGION))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
CHNO NCHNO LINES SUBREGIONSPEC)
(SELECTQ (fetch REGIONFILLMETHOD of REGION)
(TEXT (* A normal text region. Fill it with text formatted
the usual way.)
(SETQ LINES (TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE)
))
(FOLIO (* A Page Number. Fill it in according to the
instructions)
(SETQ LINES (TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE REGION)))
(HEADING (* A Page heading. Fill it in from a text source we
saved for the occasion.)
(SETQ LINES (TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE REGION))
)
(PAGE (* This box is really a PAGE FRAME.
Fill it in and do whatever other processing is needful
for end of page.)
(SETQ LINES NIL) (* This will send along its own lines to the printer.)
(TEDIT.FORMATPAGE TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE))
((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT)
(* This box is really a list of boxes.
Fill them.)
(SELECTQ (fetch REGIONFILLMETHOD of REGION)
((SEQUENCE RECURSIVE) (* Just run thru filling in the sub-boxes in order.)
(bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION
REGIONSUBBOXES)
of REGION)
while (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE)
TEXTLEN)
do [SETQ SUBREGIONSPEC (create REGION
using (fetch REGIONSPEC of SUBREGION)
LEFT ←(IPLUS (fetch LEFT
of (fetch
REGIONSPEC
of SUBREGION)
)
(fetch LEFT
of REGIONSPEC))
BOTTOM ←(IPLUS
(fetch BOTTOM
of (fetch REGIONSPEC
of SUBREGION))
(fetch BOTTOM of REGIONSPEC]
(TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch (PAGEFORMATTINGSTATE
CHNO)
of FORMATTINGSTATE)
(create PAGEREGION using SUBREGION REGIONSPEC
← SUBREGIONSPEC)
FORMATTINGSTATE)))
[ALTERNATE (* Run through the sub-boxes repeatedly in sequence.)
(while (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of
FORMATTINGSTATE)
TEXTLEN)
do (bind SUBREGIONSPEC for SUBREGION
in (fetch (PAGEREGION REGIONSUBBOXES) of REGION)
while (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO)
of FORMATTINGSTATE)
TEXTLEN)
do [SETQ SUBREGIONSPEC
(create REGION
using (fetch REGIONSPEC of SUBREGION)
LEFT ←(IPLUS (fetch LEFT
of (fetch REGIONSPEC
of SUBREGION))
(fetch LEFT
of REGIONSPEC))
BOTTOM ←(IPLUS (fetch BOTTOM
of (fetch
REGIONSPEC
of SUBREGION))
(fetch BOTTOM
of REGIONSPEC]
(TEDIT.FORMATBOX TEXTOBJ PRSTREAM
(fetch (PAGEFORMATTINGSTATE
CHNO)
of FORMATTINGSTATE)
(create PAGEREGION
using SUBREGION REGIONSPEC ←
SUBREGIONSPEC)
FORMATTINGSTATE]
(SELECTION (* Do one or another box, depending on some criterion.)
)
(SHOULDNT)) (* For now, draw a box around it, too.)
)
NIL)
(for LINE in LINES when LINE
do (* Run thru the lines displaying them all.)
(BLOCK)
(COND
((OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE))
(IGEQ (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)
(fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE)))
(* We're beyond the min page number -- go ahead and
print the line)
(\TEDIT.HARDCOPY.DISPLAYLINE (fetch (TEXTSTREAM TEXTOBJ)
of (fetch LTEXTOBJ of LINE))
LINE
(fetch CACHE of LINE)
REGION PRSTREAM)))
[COND
((EQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch LTEXTOBJ of LINE)))
(* This line refers back to the main text, so update
the current-char pointer.)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE]
(replace CACHE of LINE with NIL)
(replace LTEXTOBJ of LINE with NIL))
(COND
(CHNO (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO])
(TEDIT.FORMATHEADING
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* jds " 1-Mar-85 15:31")
(* Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line
descriptors which, taken together, fill the region.)
(PROG ((CHNO 1)
[REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
VALUE]
(LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
HEADINGSTREAM HEADINGTEXTOBJ PRECONDITIONS TEXTLEN THISLINE LINE YBOT (FORCENEXTPAGE
NIL)
LINES HEADING)
[COND
((SETQ PRECONDITIONS (LISTGET LOCALINFO (QUOTE PRECONDITIONS)))
(* There are preconditions for this heading to appear.
Check them.)
(COND
((for FORM inside PRECONDITIONS thereis (NOT (EVAL FORM)))
(* One of the predicates returned NIL, so don't display
this heading.)
(RETURN]
(COND
([NOT (SETQ HEADING (LISTGET (fetch PAGEHEADINGS of FORMATTINGSTATE)
(LISTGET LOCALINFO (QUOTE HEADINGTYPE]
(* There's no text for this heading.
Punt.)
(RETURN)))
[SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
of (SETQ HEADINGSTREAM (OPENTEXTSTREAM "" NIL NIL NIL
(LIST (QUOTE PARALOOKS)
(fetch PPARALOOKS
of (CAR HEADING]
(\TEDIT.INSERT.PIECES HEADINGTEXTOBJ 1 HEADING)
(for PC in HEADING do (add (fetch TEXTLEN of HEADINGTEXTOBJ)
(fetch PLEN of PC)))
(SETQ TEXTLEN (fetch TEXTLEN of HEADINGTEXTOBJ))
(SETQ LINES (while (AND (ILESSP CHNO TEXTLEN)
(NOT FORCENEXTPAGE))
collect (SETQ THISLINE (create THISLINE))
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE HEADINGTEXTOBJ
(fetch WIDTH
of REGION)
CHNO THISLINE
(SETQ LINE
(create
LINEDESCRIPTOR))
PRSTREAM T))
(replace CACHE of LINE with THISLINE)
(* Mark this line as having cached print info.)
(replace LTEXTOBJ of LINE with HEADINGSTREAM)
(* And remember the document it came from.)
(add (fetch LEFTMARGIN of LINE)
(fetch LEFT of REGION))
(* Format the next possible line)
[COND
[YBOT (* We're into it; take account of this line's height)
(SETQ YBOT (IDIFFERENCE YBOT (fetch LHEIGHT of LINE]
(T (* Just starting out; find the line's position with
respect to the top of the region to be filled.)
(SETQ YBOT (IDIFFERENCE (fetch BOTTOM of REGION)
(fetch DESCENT of LINE]
(* This line is good; use it.)
(replace YBOT of LINE with YBOT)
(replace YBASE of LINE with (IPLUS YBOT (fetch DESCENT of LINE)))
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE)))
(* Keep track of the next character...)
LINE))
(RETURN LINES])
(TEDIT.FORMATPAGE
[LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE) (* jds "12-Jul-85 14:23")
(* Send the text to the printer.)
(PROG ((FORCENEXTPAGE NIL)
(CHNO CH#)
(PAGE# (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE))
(PAGEPROPS (fetch (PAGEREGION REGIONLOCALINFO) of REGION))
TEXTLEN THISLINE LINE LINES NCHNO TPAGE)
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ THISLINE (fetch THISLINE of TEXTOBJ)) (* Print in the usual region on the page)
(COND
(PAGE# (* IF we've already got a starting page number, don't
set another one))
((SETQ TPAGE (LISTGET PAGEPROPS (QUOTE STARTINGPAGE#)))
(* If this page template specifies a starting page
number, use it.)
(SETQ PAGE# TPAGE)
(replace (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE with TPAGE))
(T (SETQ PAGE# 1)
(replace (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE with PAGE#)))
[while [AND (ILEQ CHNO TEXTLEN)
(EQ (QUOTE PAGEHEADING)
(fetch FMTPARATYPE of (fetch PPARALOOKS
of (\CHTOPC CHNO (fetch PCTB of TEXTOBJ]
do (* Go thru any leading page heading paras on the page.)
(\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ 1 CHNO THISLINE (SETQ LINE (create LINEDESCRIPTOR)
)
PRSTREAM)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE]
(replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO)
(for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of REGION)
while (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE)
TEXTLEN)
do (* Now format the subregions of the page.)
(TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch (PAGEFORMATTINGSTATE CHNO) of
FORMATTINGSTATE)
SUBREGION FORMATTINGSTATE))
(COND
((AND (OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE))
(IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE)))
(OR (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE))
(ILESSP PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)))
(ILESSP (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE)
TEXTLEN)) (* There is more to print....)
(* Having PressStartPage, PressNewPage, and PressClose
in a row causes errors, so avoid it!)
(DSPNEWPAGE PRSTREAM) (* Force the new page)
)
((AND (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)
(IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)))
(* We've run past the last page it wants formatted.
Stop the world.)
(replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with TEXTLEN)))
(add (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)
1)
(replace (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE with NIL)
(replace (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE
with (pop (fetch (PAGEFORMATTINGSTATE PAGE#GENERATOR) of FORMATTINGSTATE])
(TEDIT.FORMATTEXTBOX
[LAMBDA (TEXTOBJ PRSTREAM CH# PAGEREGION FORMATTINGSTATE)
(* jds "10-Oct-85 14:36")
(* Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line
descriptors which, taken together, fill the region.)
(PROG* ((CHNO CH#)
[REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
VALUE]
(COLUMNBOTTOM (fetch BOTTOM of REGION))
(FIRSTLINE T)
(BREAKAFTERLASTPARA NIL)
(STREAMSCALE (DSPSCALE NIL PRSTREAM))
(FORCENEXTPAGE NIL)
(FOOTNOTELINES NIL)
(PAGEFOOTNOTES NIL)
TEXTLEN THISLINE LINE YBOT LINES ORPHAN LASTLINE PREVLINE LHEIGHT FMTSPEC SPECIALYPOS)
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ FOOTNOTELINES (fetch PAGEFOOTNOTELINES of FORMATTINGSTATE))
(* Account for lines carried over from prior columns)
[while (AND (ILEQ COLUMNBOTTOM (fetch TOP of REGION))
(SETQ LINE (pop FOOTNOTELINES)))
do (* Move as many potential footnote lines into this
column as will fit.)
(add COLUMNBOTTOM (fetch LHEIGHT of LINE))
(* And move the bottom of the column up to account for
them)
(COND
((IGREATERP COLUMNBOTTOM (fetch TOP of REGION))
(* If we ran out of room for footnotes, put this line
back on the queue)
(push FOOTNOTELINES LINE))
(T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE]
(replace PAGEFOOTNOTELINES of FORMATTINGSTATE with FOOTNOTELINES)
(* Remember any remaining footnotes)
[SETQ LINES
(while (AND (ILEQ CHNO TEXTLEN)
(NOT FORCENEXTPAGE))
collect (SETQ THISLINE (create THISLINE))
(BLOCK) (* Allow other things to happen while we format....)
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ
(fetch WIDTH
of REGION)
CHNO THISLINE
(SETQ LINE
(create
LINEDESCRIPTOR))
PRSTREAM))
(* Format the line, noting any form-feeds)
(COND
((fetch LMARK of LINE) (* This line is a placeholder for a page heading.
All it tells us is what character to skip to so we can
continue.)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE)))
NIL)
[(LISTGET (fetch FMTUSERINFO of (fetch LFMTSPEC of LINE))
(QUOTE FOOTNOTE))
(* This paragraph is a footnote para.)
(SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ LINE))
(* Grab the lines of this footnote)
(for LINE in FOOTNOTELINES as REST on FOOTNOTELINES
do (add COLUMNBOTTOM (fetch LHEIGHT of LINE))
(COND
((IGREATERP COLUMNBOTTOM (OR YBOT (fetch TOP
of REGION)))
(replace PAGEFOOTNOTELINES of FORMATTINGSTATE
with (APPEND (fetch PAGEFOOTNOTELINES
of FORMATTINGSTATE)
REST]
(T (* This line must not represent a special item, e.g. a
page heading. If it does, ignore it.)
(replace CACHE of LINE with THISLINE)
(* Mark this line as having cached print info.)
(replace LTEXTOBJ of LINE with (fetch STREAMHINT of TEXTOBJ))
(* And remember the document it came from.)
(SETQ FMTSPEC (fetch LFMTSPEC of LINE))
(add (fetch LEFTMARGIN of LINE)
(OR (AND (fetch FMTSPECIALX of FMTSPEC)
(NOT (ZEROP (fetch FMTSPECIALX of FMTSPEC))
)
(fetch FMTSPECIALX of (fetch LFMTSPEC
of LINE)))
(fetch LEFT of REGION)))
(* Format the next possible line)
(SETQ SPECIALYPOS NIL) (* So that only the first line of a specially-placed
paragraph is guaranteed to appear in the current box.)
[COND
[(AND (fetch FMTSPECIALY of FMTSPEC)
(NOT (ZEROP (fetch FMTSPECIALY of FMTSPEC)))
(fetch 1STLN of LINE))
(* There is a special Y location for this paragraph.
Move there)
(SETQ SPECIALYPOS (SETQ YBOT (fetch FMTSPECIALY
of FMTSPEC]
[YBOT (* We're into it; take account of this line's height)
(COND
((fetch FMTBASETOBASE of FMTSPEC)
[SETQ LHEIGHT
(IPLUS (fetch DESCENT of LINE)
(fetch FMTBASETOBASE of FMTSPEC)
(COND
((fetch 1STLN of LINE)
(IPLUS (OR (fetch LEADBEFORE
of FMTSPEC)
0)
(OR (fetch LEADAFTER
of (fetch LFMTSPEC
of PREVLINE))
0)))
(T 0]
(SETQ YBOT (IDIFFERENCE (fetch YBASE of PREVLINE)
LHEIGHT)))
(T (SETQ YBOT (IDIFFERENCE YBOT (fetch LHEIGHT
of LINE]
(T (* Just starting out; find the line's position with
respect to the top of the region to be filled.)
(SETQ YBOT (IDIFFERENCE (fetch TOP of REGION)
(IPLUS (fetch LTRUEASCENT
of LINE)
(fetch DESCENT
of LINE]
(COND
((AND (ILESSP YBOT COLUMNBOTTOM)
(NOT SPECIALYPOS))
(* This line hangs off the bottom;
(and isn't the first line of a specially-placed
paragraph) punt it.)
(SETQ FORCENEXTPAGE T)
(SETQ ORPHAN LINE) (* Remember this potential orphan)
NIL)
((AND (NOT FIRSTLINE)
(fetch 1STLN of LINE)
(OR (fetch FMTNEWPAGEBEFORE
of (fetch LFMTSPEC of LINE))
BREAKAFTERLASTPARA))
(* We're supposed to put this line at the start of a
new page/column (any box, later))
(SETQ FORCENEXTPAGE T)
(SETQ ORPHAN NIL)
NIL)
(T (* This line is good; use it.)
(COND
((AND (fetch FMTNEWPAGEAFTER of (fetch LFMTSPEC
of LINE)))
(* We're supposed to put this line at the start of a
new page/column (any box, later))
(SETQ BREAKAFTERLASTPARA T)))
(replace YBOT of LINE with YBOT)
(replace YBASE of LINE with (IPLUS YBOT
(fetch DESCENT
of LINE)))
(SETQ FIRSTLINE NIL) (* Note that we have put text out on this
page/column/box, for first line checking.)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE)))
(* Keep track of the next character...)
(SETQ PREVLINE LINE)
LINE]
(SETQ LINES (DREMOVE NIL LINES)) (* Remove any NILs from the line list;
they're artifacts of running across page headings
in-stream)
[COND
(LINES (* Only worry about widows and orphans if there are
really lines to worry about)
(SETQ LASTLINE (CAR (FLAST LINES)))
(* Find the last line in this box
(column or page))
[COND
((AND ORPHAN (fetch LSTLN of ORPHAN)
(NOT (fetch 1STLN of ORPHAN)))
(* There was an overhanging line, and it was the last
line of the paragraph. Remove the penultimate line.)
(DREMOVE LASTLINE LINES)
(SETQ LASTLINE (CAR (FLAST LINES]
[COND
((AND LASTLINE (fetch 1STLN of LASTLINE)
(NOT (fetch LSTLN of LASTLINE))
(ILESSP (fetch CHARLIM of LASTLINE)
TEXTLEN)) (* The last line on the page is a widow.
Remove it, too.)
(DREMOVE LASTLINE LINES)
(SETQ LASTLINE (CAR (FLAST LINES]
(while (AND LASTLINE (fetch FMTHEADINGKEEP of (fetch LFMTSPEC
of LASTLINE)))
do (* Run thru, removing any trailing headings.
However, assure that there's at least one line on a
page.)
(DREMOVE LASTLINE LINES)
(SETQ ORPHAN LASTLINE)
(* Setting the orphan assures that if we have a page full of headings, we'll print at least one of them.
This keeps us from getting into tight loops that go nowhere.)
(SETQ LASTLINE (CAR (FLAST LINES]
(RETURN (COND
(LINES)
(ORPHAN (* If there's only one line left for this box, return
it anyhow.)
(LIST ORPHAN])
(TEDIT.FORMATFOLIO
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* jds "21-Sep-85 09:49")
(* Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line
descriptors which, taken together, fill the region.)
(PROG ([REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of REGIONSPEC)
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
VALUE]
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of REGIONSPEC))
(FORCENEXTPAGE NIL)
(CHNO 1)
FOLIOTEXTOBJ FOLIOSTREAM TEXTLEN THISLINE LINE YBOT PARALOOKS CHARLOOKS NOFIRSTPAGE PAGE#
FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
(SETQ PARALOOKS (LISTGET FOLIOINFO (QUOTE PARALOOKS)))
(SETQ CHARLOOKS (LISTGET FOLIOINFO (QUOTE CHARLOOKS)))
(SETQ NOFIRSTPAGE (LISTGET FOLIOINFO (QUOTE NOFIRSTPAGE)))
(SETQ INFOLIST (LISTGET FOLIOINFO (QUOTE FORMATINFO)))
(* A LIST OF (FORMAT PRETEXT POSTTEXT))
(SETQ FOLIOFORMAT (CAR INFOLIST))
(SETQ PRETEXT (CADR INFOLIST))
(SETQ POSTTEXT (CADDR INFOLIST))
[SETQ PAGE# (COND
((fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE)
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE)))
(T (SELECTQ FOLIOFORMAT
(LOWERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#) of
FORMATTINGSTATE)))
(UPPERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#) of
FORMATTINGSTATE)
T))
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE]
[COND
(PRETEXT (SETQ PAGE# (CONCAT PRETEXT PAGE#]
[COND
(POSTTEXT (SETQ PAGE# (CONCAT PAGE# POSTTEXT]
[SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM PAGE# NIL NIL NIL
(LIST (QUOTE PARALOOKS)
PARALOOKS
(QUOTE LOOKS)
CHARLOOKS]
(SETQ TEXTLEN (fetch TEXTLEN of FOLIOTEXTOBJ))
(COND
((OR (NOT (fetch (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE))
(NOT NOFIRSTPAGE)) (* If this isn't the first page, OR we want a page # on
the first page, go ahead and format it.)
(RETURN (while (AND (ILEQ CHNO TEXTLEN)
(NOT FORCENEXTPAGE))
collect (SETQ THISLINE (create THISLINE))
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE FOLIOTEXTOBJ
(fetch WIDTH
of REGION)
CHNO THISLINE
(SETQ LINE
(create
LINEDESCRIPTOR))
PRSTREAM))
(replace CACHE of LINE with THISLINE)
(replace LTEXTOBJ of LINE with FOLIOSTREAM)
(add (fetch LEFTMARGIN of LINE)
(fetch LEFT of REGION))
(* Format the next possible line)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE)))
(* Keep track of the next character...)
[COND
[YBOT (* We're into it; take account of this line's height)
(SETQ YBOT (IDIFFERENCE YBOT (fetch LHEIGHT of LINE]
(T (* Just starting out; find the line's position with
respect to the top of the region to be filled.)
(SETQ YBOT (fetch BOTTOM of REGION]
(COND
((ILESSP YBOT (fetch BOTTOM of REGION))
(* This line hangs off the bottom;
punt it.)
NIL)
(T (* This line is good; use it.)
(replace YBOT of LINE with YBOT)
(replace YBASE of LINE with (IPLUS YBOT (fetch DESCENT
of LINE)))
LINE])
)
(* Aux function to capture page headings during line formatting.)
(DEFINEQ
(TEDIT.HARDCOPY.PAGEHEADING
[LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM)
(* jds "14-Jan-85 11:22")
(* Capture the text for this page heading.
Then set LINE:CHARLIM so it will move the document
ahead to the next real text.)
(PROG ((PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM))
(LEN 0)
(FORMATTINGSTATE (STREAMPROP IMAGESTREAM (QUOTE FORMATTINGSTATE)))
(HEADINGTYPE (fetch FMTPARASUBTYPE of PARALOOKS))
NPC PIECES)
(SETQ NPC PC)
(SETQ PIECES (repeatuntil [OR (NOT PC)
(AND (fetch PPARALAST of PC)
(OR (NOT NPC)
(NEQ (fetch FMTPARATYPE
of (fetch PPARALOOKS of NPC))
(QUOTE PAGEHEADING))
(NEQ HEADINGTYPE (fetch FMTPARASUBTYPE
of (fetch PPARALOOKS
of NPC]
collect (* GRAB THE PIECES FOR THIS HEADING.)
(SETQ PC NPC)
(add LEN (fetch PLEN of PC))
(SETQ NPC (fetch NEXTPIECE of PC))
(\TEDIT.COPYTEXTSTREAM.PIECEMAPFN PC TEXTOBJ TEXTOBJ TEXTOBJ)))
(replace LMARK of LINE with T)
(replace CHARLIM of LINE with (SUB1 (IPLUS CHNO LEN)))
(* Set the line's CHARLIM to be the last character in
the page heading.)
(LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
(fetch FMTPARASUBTYPE of PARALOOKS)
PIECES])
)
(* Handle varying paper sizes)
(DEFINEQ
(SCALEPAGEUNITS
[LAMBDA (VALUE FACTOR PAPERSIZE) (* jds "14-Jun-85 15:34")
(* Scale a page-relative value into points: Scale VALUE
by FACTOR, then allow for negative values to mean
"come in from the other side by that much")
(AND VALUE (PROG [(TVAL (FIXR (FTIMES VALUE FACTOR)))
(OTHEREDGE (SELECTQ PAPERSIZE
((NIL LETTER)
612)
(LEGAL 612)
(fetch (TEDITPAPERSIZE TPSWIDTH) of (ASSOC PAPERSIZE
TEDIT.PAPER.SIZES]
[COND
((ILESSP TVAL 0) (* He specified this value as an offset from the
opposite edge. Convert it.)
(SETQ TVAL (IPLUS OTHEREDGE TVAL]
(RETURN TVAL])
(SCALEPAGEXUNITS
[LAMBDA (VALUE FACTOR PAPERSIZE) (* jds "14-Jun-85 16:42")
(* Scale a page-relative value into points: Scale VALUE
by FACTOR, then allow for negative values to mean
"come in from the other side by that much")
(AND VALUE (PROG ((TVAL (FIXR (FTIMES VALUE FACTOR)))
OTHEREDGE)
[COND
((ILESSP TVAL 0) (* He specified this value as an offset from the
opposite edge. Convert it.)
(SETQ OTHEREDGE (\TEDIT.PAPERWIDTH PAPERSIZE))
(SETQ TVAL (IPLUS OTHEREDGE TVAL]
(RETURN TVAL])
(SCALEPAGEYUNITS
[LAMBDA (VALUE FACTOR PAPERSIZE) (* jds "14-Jun-85 16:43")
(* Scale a page-relative value into points: Scale VALUE
by FACTOR, then allow for negative values to mean
"come in from the other side by that much")
(AND VALUE (PROG ((TVAL (FIXR (FTIMES VALUE FACTOR)))
OTHEREDGE)
[COND
((ILESSP TVAL 0) (* He specified this value as an offset from the
opposite edge. Convert it.)
(SETQ OTHEREDGE (\TEDIT.PAPERHEIGHT PAPERSIZE))
(SETQ TVAL (IPLUS OTHEREDGE TVAL]
(RETURN TVAL])
(\TEDIT.PAPERHEIGHT
[LAMBDA (PAPERSIZE) (* jds " 3-Sep-85 15:22")
(SELECTQ PAPERSIZE
((NIL LETTER Letter)
792)
((Legal 8.5x14 LEGAL)
1008)
((A4 a4)
842)
(fetch (TEDITPAPERSIZE TPSHEIGHT) of (ASSOC PAPERSIZE TEDIT.PAPER.SIZES])
(\TEDIT.PAPERWIDTH
[LAMBDA (PAPERSIZE) (* jds " 3-Sep-85 14:53")
(SELECTQ PAPERSIZE
((NIL Letter LETTER 8.5x11) (* letter size paper, 8.5inx11in)
612)
((Legal LEGAL 8.5x14)
612)
((A4 a4) (* A4 ISO-size paper, 210mmx297mm)
595)
(fetch (TEDITPAPERSIZE TPSWIDTH) of (ASSOC PAPERSIZE TEDIT.PAPER.SIZES])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.PAPER.SIZES)
)
(RPAQQ TEDIT.PAPER.SIZES ((A0 2384 3370)
(A1 1684 2384)
(A2 1191 1684)
(A3 842 1191)
(A4 595 842)
(A5 420 595)
(B0 2835 4008)
(B1 2004 2835)
(B2 1417 2004)
(B3 1001 1417)
(B4 709 1001)
(B5 499 709)))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD TEDITPAPERSIZE (TPSNAME TPSWIDTH TPSHEIGHT))
]
)
(* Page numbering option support)
(DEFINEQ
(ROMANNUMERALS
[LAMBDA (NUMBER UCFLG) (* jds "12-Jul-85 13:19")
(* * Take a NUMBER, and render it as a string of roman numerals. If UCFLG, then the numerals will be upper-case;
otherwise, they are lower-case.)
(PROG ((CHARS NIL))
[while (NOT (ZEROP NUMBER)) do (COND
((IGEQ NUMBER 1000)
(push CHARS (QUOTE m))
(add NUMBER -1000))
((IGEQ NUMBER 900)
(push CHARS (QUOTE c))
(push CHARS (QUOTE m))
(add NUMBER -900))
((IGEQ NUMBER 500)
(push CHARS (QUOTE d))
(add NUMBER -500))
((IGEQ NUMBER 400)
(push CHARS (QUOTE c))
(push CHARS (QUOTE d))
(add NUMBER -400))
((IGEQ NUMBER 100)
(push CHARS (QUOTE c))
(add NUMBER -100))
((IGEQ NUMBER 90)
(push CHARS (QUOTE x))
(push CHARS (QUOTE c))
(add NUMBER -90))
((IGEQ NUMBER 50)
(push CHARS (QUOTE l))
(add NUMBER -50))
((IGEQ NUMBER 40)
(push CHARS (QUOTE x))
(push CHARS (QUOTE l))
(add NUMBER -40))
((IGEQ NUMBER 10)
(push CHARS (QUOTE x))
(add NUMBER -10))
((IGEQ NUMBER 9)
(push CHARS (QUOTE i))
(push CHARS (QUOTE x))
(add NUMBER -9))
((IGEQ NUMBER 5)
(push CHARS (QUOTE v))
(add NUMBER -5))
((IGEQ NUMBER 4)
(push CHARS (QUOTE i))
(push CHARS (QUOTE v))
(add NUMBER -4))
(T (push CHARS (QUOTE i))
(add NUMBER -1]
(RETURN (COND
[UCFLG (* The caller wants his roman numerals upper case)
(U-CASE (CONCATLIST (REVERSE CHARS]
(T (CONCATLIST (REVERSE CHARS])
)
(PUTPROPS TEDITPAGE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5100 7704 (TEDIT.GET.PAGEFRAMES 5110 . 5414) (TEDIT.PARSE.PAGEFRAMES 5416 . 6395) (
TEDIT.PUT.PAGEFRAMES 6397 . 6924) (TEDIT.UNPARSE.PAGEFRAMES 6926 . 7702)) (7745 16090 (
TEDIT.SINGLE.PAGEFORMAT 7755 . 14817) (TEDIT.COMPOUND.PAGEFORMAT 14819 . 15260) (TEDIT.PAGEFORMAT
15262 . 15780) (\MICASTOPTS 15782 . 15931) (\PTSTOMICAS 15933 . 16088)) (16172 50208 (
TEDIT.FORMAT.HARDCOPY 16182 . 21586) (TEDIT.FORMATBOX 21588 . 27416) (TEDIT.FORMATHEADING 27418 .
31338) (TEDIT.FORMATPAGE 31340 . 35247) (TEDIT.FORMATTEXTBOX 35249 . 45861) (TEDIT.FORMATFOLIO 45863
. 50206)) (50283 52076 (TEDIT.HARDCOPY.PAGEHEADING 50293 . 52074)) (52116 55329 (SCALEPAGEUNITS 52126
. 52994) (SCALEPAGEXUNITS 52996 . 53745) (SCALEPAGEYUNITS 53747 . 54497) (\TEDIT.PAPERHEIGHT 54499 .
54842) (\TEDIT.PAPERWIDTH 54844 . 55327)) (55841 58022 (ROMANNUMERALS 55851 . 58020)))))
STOP