(FILECREATED "25-Nov-84 14:37:50" {IVY}<TEDIT>TEDITPAGE.;4 63326
changes to: (FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.FORMATFOLIO)
previous date: " 9-Nov-84 17:42:01" {IVY}<TEDIT>TEDITPAGE.;3)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITPAGECOMS)
(RPAQQ TEDITPAGECOMS ((RECORDS PAGEFORMATTINGSTATE PAGEREGION)
[VARS (MAXPAGE# 65535)
(MINPAGE# 1)
(TEDIT.PAGE.FRAMES (TEDIT.COMPOUND.PAGEFORMAT (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)))
(TEDIT.PAGEMENU.SPEC (LIST (create MB.BUTTON MBLABEL ← (QUOTE APPLY)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.APPLY.PAGEFORMATTING)
)
(create MB.TEXT MBSTRING ← " " MBFONT ←
(FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(create MB.BUTTON MBLABEL ← (QUOTE SHOW)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.SHOW.PAGEFORMATTING))
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "For page: ")
(create MB.NWAY MBBUTTONS ← (QUOTE (First%(&Default%)
Other% Left
Other% Right)))
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Page numbers: ")
(create MB.TEXT MBSTRING ← " " MBFONT ←
(FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(create MB.NWAY MBBUTTONS ← (QUOTE (No Yes))
MBINITSTATE ← (QUOTE Yes))
(create MB.TEXT MBSTRING ← " ")
(create MB.TEXT MBSTRING ← "X: ")
(create MB.INSERT MBINITENTRY ← 25.5)
(create MB.TEXT MBSTRING ← " ")
(create MB.TEXT MBSTRING ← "Y: ")
(create MB.INSERT MBINITENTRY ← 3)
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Alignment: ")
(create MB.NWAY MBBUTTONS ← (QUOTE (Left Centered Right))
MBINITSTATE ← (QUOTE Centered))
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Margins: Left")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← " Right")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← " Top")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← " Bottom")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Columns: ")
(create MB.INSERT MBINITENTRY ← 1)
(create MB.TEXT MBSTRING ← " Col Width: ")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Space between cols: ")
(create MB.INSERT MBINITENTRY ← 1)
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Page Headings:" MBFONT ←
(FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT]
(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 SCALEPAGEUNITS
\MICASTOPTS))
(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 (* Menu to support user creation of page frames)
(FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING
TEDIT.UNPARSE.PAGEFORMAT)
(FILES TEDITMENU)
(VARS (TEDIT.EXPANDED.PAGEMENU (\TEDITPAGEMENU.CREATE)))
(GLOBALVARS TEDIT.EXPANDED.PAGEMENU))))
[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# MAXPAGE# 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.)
))
(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)))
(RPAQQ MAXPAGE# 65535)
(RPAQQ MINPAGE# 1)
(RPAQ TEDIT.PAGE.FRAMES (TEDIT.COMPOUND.PAGEFORMAT (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)))
(RPAQ TEDIT.PAGEMENU.SPEC (LIST (create MB.BUTTON MBLABEL ← (QUOTE APPLY)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.APPLY.PAGEFORMATTING))
(create MB.TEXT MBSTRING ← " " MBFONT ← (FONTCREATE (QUOTE
HELVETICA)
8
(QUOTE BOLD)))
(create MB.BUTTON MBLABEL ← (QUOTE SHOW)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.SHOW.PAGEFORMATTING))
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "For page: ")
(create MB.NWAY MBBUTTONS ← (QUOTE (First%(&Default%) Other% Left
Other% Right)))
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Page numbers: ")
(create MB.TEXT MBSTRING ← " " MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(create MB.NWAY MBBUTTONS ← (QUOTE (No Yes))
MBINITSTATE ← (QUOTE Yes))
(create MB.TEXT MBSTRING ← " ")
(create MB.TEXT MBSTRING ← "X: ")
(create MB.INSERT MBINITENTRY ← 25.5)
(create MB.TEXT MBSTRING ← " ")
(create MB.TEXT MBSTRING ← "Y: ")
(create MB.INSERT MBINITENTRY ← 3)
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Alignment: ")
(create MB.NWAY MBBUTTONS ← (QUOTE (Left Centered Right))
MBINITSTATE ← (QUOTE Centered))
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Margins: Left")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← " Right")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← " Top")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← " Bottom")
(create MB.INSERT MBINITENTRY ← 6)
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Columns: ")
(create MB.INSERT MBINITENTRY ← 1)
(create MB.TEXT MBSTRING ← " Col Width: ")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Space between cols: ")
(create MB.INSERT MBINITENTRY ← 1)
(create MB.TEXT MBSTRING ← "
")
(create MB.TEXT MBSTRING ← "Page Headings:" MBFONT ←
(FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT MBSTRING ← " Y:")
(create MB.INSERT)))
(* 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)
(* jds "25-Nov-84 14:08")
(PROG ((PAGEREGION (create PAGEREGION
REGIONFILLMETHOD ←(QUOTE PAGE)
REGIONSPEC ←(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 612
HEIGHT ← 792)))
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.27))
[CM (* Units are in CM, at 72.27/2.54pts per.)
(SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 72.27 2.54]
(\ILLEGAL.ARG UNITS)) (* We need to do the scaling.)
(SETQ PX (SCALEPAGEUNITS PX SCALEFACTOR 612))
(SETQ PY (SCALEPAGEUNITS PY SCALEFACTOR 792))
[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)
(SCALEPAGEUNITS (CADR HDG)
SCALEFACTOR 612)
(SCALEPAGEUNITS (CADDR HDG)
SCALEFACTOR 792]
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE 612 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 72)))
((CENTERED NIL) (* Otherwise, center the page number around the point
he specifies)
(SETQ FOLIOLEFT (IDIFFERENCE PX 36)))
(SHOULDNT))
[SETQ SUBREGIONS (LIST (SETQ FOLIO (create PAGEREGION
REGIONFILLMETHOD ←(QUOTE FOLIO)
REGIONSPEC ←(create REGION
LEFT ←(
\PTSTOMICAS
FOLIOLEFT)
BOTTOM ←(
\PTSTOMICAS
PY)
WIDTH ←(
\PTSTOMICAS
72)
HEIGHT ←(
\PTSTOMICAS
36]
(replace REGIONLOCALINFO of FOLIO with (LIST (QUOTE PARALOOKS)
(LIST (QUOTE QUAD)
(OR PQUAD (QUOTE CENTERED)))
(QUOTE CHARLOOKS)
PFONT)))
(T (SETQ SUBREGIONS NIL)))
[COND
(HEADINGS (* There are page headings specified for this page.)
[SETQ HEADINGREGIONS (for HEADING in HEADINGS
collect (create PAGEREGION
REGIONFILLMETHOD ←(QUOTE HEADING)
REGIONSPEC ←(create
REGION
LEFT ←(\PTSTOMICAS (CADR HEADING))
BOTTOM ←(\PTSTOMICAS (CADDR HEADING))
WIDTH ←(\PTSTOMICAS 72)
HEIGHT ←(\PTSTOMICAS 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 ←(\PTSTOMICAS LEFT)
BOTTOM ←(\PTSTOMICAS BOTTOM)
WIDTH ←(\PTSTOMICAS PAGEWIDTH)
HEIGHT ←(\PTSTOMICAS (IDIFFERENCE
(IDIFFERENCE
792 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 ←(\PTSTOMICAS CLEFT)
BOTTOM ←(\PTSTOMICAS BOTTOM)
WIDTH ←(\PTSTOMICAS
COLWIDTH)
HEIGHT ←(\PTSTOMICAS
(IDIFFERENCE
(IDIFFERENCE 792 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 "30-Jul-84 14:18")
(* Programmatic interface for page formatting)
(PROG ((TEXTOBJ (TEXTOBJ STREAM)))
(COND
((type? PAGEREGION FORMAT)
(replace TXTPAGEFRAMES of TEXTOBJ with FORMAT))
(T (\ILLEGAL.ARG FORMAT])
(SCALEPAGEUNITS
[LAMBDA (VALUE FACTOR OTHEREDGE) (* jds "30-Aug-84 13:19")
(* 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]
[COND
((ILESSP TVAL 0) (* He specified this value as an offset from the
opposite edge. Convert it.)
(SETQ TVAL (IPLUS OTHEREDGE TVAL]
(RETURN TVAL])
(\MICASTOPTS
[LAMBDA (MicaValue) (* jds "31-Jul-84 13:56")
(FIXR (FQUOTIENT MicaValue 35.27778])
)
(* Perform page layout, based on a regular expression of typed regions.)
(DEFINEQ
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS SERVERTYPE)
(* jds "12-Sep-84 16:24")
(* Send the text to the printer.)
(RESETLST (PROG ((TEXTOBJ (TEXTOBJ STREAM))
(FORCENEXTPAGE NIL)
(FORMATTINGSTATE (create PAGEFORMATTINGSTATE
PAGE# ← 1
FIRSTPAGE ← T
STATE ←(QUOTE FORMATTING)
MINPAGE# ← 1
MAXPAGE# ← 65535
CHNO ← 1))
(PAGEHEADINGS (LIST NIL NIL))
TEXTLEN THISLINE LINE REGION LINES NCHNO PRSTREAM PAGEFRAMES SCRATCHFILE WASOPEN)
(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]
(RESETLST [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
(SETQ SERVERTYPE (OR SERVERTYPE (PRINTERTYPE SERVER)
))
(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.)
(TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
(while (ILEQ (fetch CHNO of FORMATTINGSTATE)
TEXTLEN)
do (for REGION inside PAGEFRAMES
do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch CHNO of
FORMATTINGSTATE)
REGION FORMATTINGSTATE SERVERTYPE)))
[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-Sep-84 17:50")
(* 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 " 7-Sep-84 19:37")
(* 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 (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))
(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 PAGEHEADINGS (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 " 7-Sep-84 19:50")
(* Send the text to the printer.)
(PROG ((FORCENEXTPAGE NIL)
(CHNO CH#)
(PAGE# (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE))
TEXTLEN THISLINE LINE LINES NCHNO)
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ THISLINE (fetch THISLINE of TEXTOBJ)) (* Print in the usual region on the page)
[while (AND [EQ (QUOTE PAGEHEADING)
(fetch FMTPARATYPE of (fetch PPARALOOKS
of (\CHTOPC CHNO (fetch PCTB of TEXTOBJ]
(ILEQ CHNO TEXTLEN))
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!)
(SELECTQ (IMAGESTREAMTYPE PRSTREAM)
(PRESS (NEWPAGE.PRESS PRSTREAM))
(INTERPRESS (NEWPAGE.IP PRSTREAM))
NIL) (* Force the new page)
))
(add (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)
1)
(replace (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE with NIL])
(TEDIT.FORMATTEXTBOX
[LAMBDA (TEXTOBJ PRSTREAM CH# PAGEREGION FORMATTINGSTATE)
(* jds " 9-Nov-84 16:32")
(* 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 (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))
(FIRSTLINE T)
(BREAKAFTERLASTPARA NIL)
TEXTLEN THISLINE LINE YBOT (FORCENEXTPAGE NIL)
LINES ORPHAN LASTLINE SPECIALYPOS)
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
[SETQ LINES (while (AND (ILEQ CHNO TEXTLEN)
(NOT FORCENEXTPAGE))
collect (SETQ THISLINE (create THISLINE))
(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
((NOT (fetch LMARK of LINE))
(* 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.)
(add (fetch LEFTMARGIN of LINE)
(OR (AND (fetch FMTSPECIALX of (fetch LFMTSPEC
of LINE))
[NOT (ZEROP (fetch FMTSPECIALX
of (fetch LFMTSPEC of LINE]
(SCALEPAGEUNITS (fetch FMTSPECIALX
of (fetch LFMTSPEC
of LINE))
1.0 612))
(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 (fetch LFMTSPEC of LINE))
[NOT (ZEROP (fetch FMTSPECIALY
of (fetch LFMTSPEC of LINE]
(fetch 1STLN of LINE))
(* There is a special Y location for this paragraph.
Move there)
(SETQ SPECIALYPOS (SETQ YBOT
(SCALEPAGEUNITS (fetch FMTSPECIALY
of (fetch LFMTSPEC of LINE))
1.0 792]
[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 TOP of REGION)
(IPLUS (fetch LTRUEASCENT
of LINE)
(fetch DESCENT of LINE]
(COND
((AND (ILESSP YBOT (fetch BOTTOM of REGION))
(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...)
LINE)))
(T (* 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]
(SETQ LINES (DREMOVE NIL LINES))
[COND
(LINES (* Only worry about widows and orphans if there are
really lines to worry about)
(SETQ LASTLINE (CAR (FLAST LINES)))
[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]
(RETURN LINES])
(TEDIT.FORMATFOLIO
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* jds "25-Nov-84 14:12")
(* 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 (fetch (PAGEREGION REGIONSPEC) of REGIONSPEC))
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of REGIONSPEC))
(FORCENEXTPAGE NIL)
(CHNO 1)
FOLIOTEXTOBJ FOLIOSTREAM TEXTLEN THISLINE LINE YBOT PARALOOKS CHARLOOKS NOFIRSTPAGE)
(SETQ PARALOOKS (LISTGET FOLIOINFO (QUOTE PARALOOKS)))
(SETQ CHARLOOKS (LISTGET FOLIOINFO (QUOTE CHARLOOKS)))
(SETQ NOFIRSTPAGE (LISTGET FOLIOINFO (QUOTE NOFIRSTPAGE)))
[SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM (MKSTRING
(fetch (PAGEFORMATTINGSTATE
PAGE#)
of FORMATTINGSTATE))
NIL NIL NIL
(LIST (QUOTE PARALOOKS)
PARALOOKS
(QUOTE LOOKS)
CHARLOOKS]
(SETQ TEXTLEN (fetch TEXTLEN of FOLIOTEXTOBJ))
(COND
((OR (NEQ (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)
1)
(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 STREAM LINE PARALOOKS CHNO) (* jds "30-Aug-84 14:50")
(* 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 STREAM))
(LEN 0)
NPC PIECES)
(SETQ NPC PC)
(SETQ PIECES (repeatuntil (OR (NOT PC)
(fetch PPARALAST of PC))
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)))
(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 PAGEHEADINGS (fetch FMTPARASUBTYPE of PARALOOKS)
PIECES])
)
(* Menu to support user creation of page frames)
(DEFINEQ
(\TEDIT.SHOW.PAGEFORMATTING
[LAMBDA (OBJ SEL W) (* jds "24-Oct-84 17:52")
(* Take a document's page formatting, and display it in
the menu.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(CH# (ADD1 (fetch CH# of SEL)))
SCRATCHSEL NEWLOOKS NEXTB BUTTON PAGEID OPAGEFRAMES FIRST REST PFONT HEADING HEADINGS)
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ)) (* The PIECE containing the text to describe)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ BUTTON (CAR NEXTB))
(SELECTQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(First%(&Default%) (SETQ PAGEID (QUOTE FIRST)))
(Other% Left (SETQ PAGEID (QUOTE LEFT)))
(Other% Right (SETQ PAGEID (QUOTE RIGHT)))
(PROGN (TEDIT.PROMPTPRINT MAINTEXT
"First specify which kind of page you want to see."
T)
(RETURN)))
(SETQ OPAGEFRAMES (OR (fetch TXTPAGEFRAMES of MAINTEXT)
TEDIT.PAGE.FRAMES))
[COND
((LISTP OPAGEFRAMES) (* No problem, this is already just a list of
first-recto-verso frames)
)
(T (* This is probably a parsed-up version of the thing.
Fix it to a list.)
(COND
[(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of OPAGEFRAMES)
(QUOTE SEQUENCE))
(SETQ FIRST (CAR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES)))
(SETQ REST (CADR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES)))
(COND
[(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REST)
(QUOTE ALTERNATE))
(SETQ OPAGEFRAMES (CONS FIRST (fetch (PAGEREGION REGIONSUBBOXES) of REST]
(T (SETQ OPAGEFRAMES NIL]
(T (SETQ OPAGEFRAMES NIL]
(COND
((NOT OPAGEFRAMES) (* If the formatting isn't in our simplified 3-way
format, punt out of this.)
(TEDIT.PROMPTPRINT MAINTEXT "Format too complex to edit." T)
(RETURN)))
(SELECTQ PAGEID
(FIRST (SETQ NEWLOOKS (CAR OPAGEFRAMES)))
(LEFT (SETQ NEWLOOKS (CADR OPAGEFRAMES)))
(RIGHT (SETQ NEWLOOKS (CADDR OPAGEFRAMES)))
NIL)
(SETQ NEWLOOKS (TEDIT.UNPARSE.PAGEFORMAT NEWLOOKS (QUOTE PICAS)))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
[IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE)
(COND
((pop NEWLOOKS)
(QUOTE Yes))
(T (QUOTE No]
(SETQ BUTTON (CAR NEXTB))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
(pop NEWLOOKS)) (* Page # X location)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Page # Y location)
(SETQ PFONT (pop NEWLOOKS)) (* Skip the font info for now.)
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ BUTTON (CAR NEXTB)) (* How to align the page number)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(SELECTQ (pop NEWLOOKS)
(LEFT (QUOTE Left))
(RIGHT (QUOTE Right))
(CENTERED (QUOTE Centered))
(QUOTE Centered)))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# (pop NEWLOOKS))
(* Left Margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Right Margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Top margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Bottom Margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* # of columns)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Column width)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Intercolumn spacing)
(SETQ HEADINGS (pop NEWLOOKS))
(for HEADING# from 1 to 4
do (SETQ HEADING (pop HEADINGS))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop HEADING))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop HEADING))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop HEADING)))
(\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
PFONT) (* The font for the page numbers to appear in.)
(\SHOWSEL SCRATCHSEL NIL NIL)
(replace SET of SCRATCHSEL with NIL)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (fetch TEXTLEN of TEXTOBJ))
(TEDIT.UPDATE.SCREEN TEXTOBJ])
(\TEDITPAGEMENU.CREATE
[LAMBDA NIL (* gbn " 8-Oct-84 18:25")
(* Creates the TEdit Expanded Menu)
(SETQ TEDIT.EXPANDED.PAGEMENU (\TEXTMENU.DOC.CREATE (APPEND TEDIT.PAGEMENU.SPEC
TEDIT.MENUDIVIDER.SPEC
[LIST (create MB.TEXT
MBSTRING ←
"Character Looks for Page Numbers: "
MBFONT ←(FONTCREATE
(QUOTE HELVETICA)
10
(QUOTE BOLD]
TEDIT.CHARLOOKSMENU.SPEC])
(\TEDIT.APPLY.PAGEFORMATTING
[LAMBDA (OBJ SEL W) (* jds "30-Aug-84 15:20")
(* Change the page formatting for this document)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(CH# (ADD1 (fetch CH# of SEL)))
SCRATCHSEL NEXTB BUTTON OPAGEFRAMES PAGEID PX PY LEFT BOTTOM TOP RIGHT ALIGNMENT PAGENOS
COLS COLWIDTH INTERCOL PFONT NPAGEFORMAT HEADINGTYPE HEADINGX HEADINGY HEADINGS)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* Skip the SHOW button.)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SELECTQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(First%(&Default%) (SETQ PAGEID (QUOTE FIRST)))
(Other% Left (SETQ PAGEID (QUOTE LEFT)))
(Other% Right (SETQ PAGEID (QUOTE RIGHT)))
(PROGN (TEDIT.PROMPTPRINT MAINTEXT "Set KIND OF PAGE before APPLYing." T)
(RETURN))) (* Find which page, for later.)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (CDR NEXTB))
(SELECTQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(No (SETQ PAGENOS NIL))
(Yes (SETQ PAGENOS T))
NIL) (* Find about page numbers)
(SETQ PX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#))
[SETQ PY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(SETQ BUTTON (CAR NEXTB))
[SETQ ALIGNMENT (U-CASE (IMAGEOBJPROP BUTTON (QUOTE STATE]
(* PX PY PFONT ALIGNMENT)
(* Margins: LEFT, RIGHT, TOP, BOTTOM)
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ LEFT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#))
[SETQ RIGHT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ TOP (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ BOTTOM (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ COLWIDTH (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ INTERCOL (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* Col count, width, spacing)
(SETQ HEADINGS (for HEADING# from 1 to 4
when [PROG1 [SETQ HEADINGTYPE (MBUTTON.NEXT.FIELD.AS.ATOM
TEXTOBJ
(ADD1 (fetch CH# of SCRATCHSEL]
[SETQ HEADINGX (MBUTTON.NEXT.FIELD.AS.NUMBER
TEXTOBJ
(ADD1 (fetch CH# of SCRATCHSEL]
(SETQ HEADINGY (MBUTTON.NEXT.FIELD.AS.NUMBER
TEXTOBJ
(ADD1 (fetch CH# of SCRATCHSEL]
collect (LIST HEADINGTYPE HEADINGX HEADINGY)))
[SETQ PFONT (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(SETQ NPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT (AND (NEQ ALIGNMENT
(QUOTE OFF))
ALIGNMENT)
LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL
HEADINGS (QUOTE PICAS)))
(SETQ OPAGEFRAMES (fetch TXTPAGEFRAMES of MAINTEXT))
[COND
((NOT (LISTP OPAGEFRAMES))
(SETQ OPAGEFRAMES (LIST NPAGEFORMAT NPAGEFORMAT NPAGEFORMAT]
(SELECTQ PAGEID
(FIRST (RPLACA OPAGEFRAMES NPAGEFORMAT))
(LEFT (RPLACA (CDR OPAGEFRAMES)
NPAGEFORMAT))
(RIGHT (RPLACA (CDDR OPAGEFRAMES)
NPAGEFORMAT))
NIL)
(replace TXTPAGEFRAMES of MAINTEXT with OPAGEFRAMES)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE PROCESS])
(TEDIT.UNPARSE.PAGEFORMAT
[LAMBDA (PAGEREGION UNITS) (* jds "30-Aug-84 15:11")
(PROG ((REGIONS (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION))
PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM (COLS 0)
COLWIDTH
(INTERCOL 0)
SPECS PAGENOS OLDRIGHT SCALEFACTOR HEADINGS)
[for REGION in REGIONS
do (COND
((EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION)
(QUOTE FOLIO))
(SETQ PAGENOS T)
[SETQ PX (\MICASTOPTS (fetch LEFT of (fetch REGIONSPEC of REGION]
[SETQ PY (\MICASTOPTS (fetch BOTTOM of (fetch REGIONSPEC of REGION]
(SETQ SPECS (fetch REGIONLOCALINFO of REGION))
(SETQ PFONT (LISTGET SPECS (QUOTE CHARLOOKS)))
[SETQ PQUAD (CADR (LISTGET SPECS (QUOTE PARALOOKS]
(SELECTQ PQUAD
(LEFT)
(RIGHT (SETQ PX (IPLUS PX 72)))
(CENTERED (SETQ PX (IPLUS PX 36)))
NIL))
[(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION)
(QUOTE HEADING))
(SETQ HEADINGS (NCONC1 HEADINGS (LIST (LISTGET (fetch REGIONLOCALINFO
of REGION)
(QUOTE HEADINGTYPE))
(\MICASTOPTS (fetch LEFT
of (fetch REGIONSPEC
of REGION)))
(\MICASTOPTS (fetch BOTTOM
of (fetch REGIONSPEC
of REGION]
(T (add COLS 1)
[SETQ COLWIDTH (\MICASTOPTS (fetch WIDTH of (fetch REGIONSPEC of REGION]
[SETQ RIGHT (IDIFFERENCE 612 (\MICASTOPTS (fetch RIGHT
of (fetch REGIONSPEC of REGION]
(COND
((EQ OLDRIGHT T))
(OLDRIGHT (SETQ INTERCOL (\MICASTOPTS (IDIFFERENCE (fetch LEFT
of (fetch REGIONSPEC
of REGION))
OLDRIGHT)))
(SETQ OLDRIGHT T))
(T (SETQ OLDRIGHT (fetch RIGHT of (fetch REGIONSPEC of REGION)))
[SETQ LEFT (\MICASTOPTS (fetch LEFT of (fetch REGIONSPEC of REGION]
[SETQ TOP (IDIFFERENCE 792 (\MICASTOPTS (fetch TOP
of (fetch REGIONSPEC
of REGION]
(SETQ BOTTOM (\MICASTOPTS (fetch BOTTOM of (fetch REGIONSPEC of REGION]
(SELECTQ UNITS
((POINTS NIL) (* If units are in printers points, the default, do no
scaling)
)
(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 .7227))
[CM (* Units are in CM, at 72.27/2.54pts per.)
(SETQ SCALEFACTOR (CONSTANT (FQUOTIENT .7227 2.54]
(\ILLEGAL.ARG UNITS))
[COND
(SCALEFACTOR (* We need to do the scaling.)
(AND PX (SETQ PX (FQUOTIENT (FIXR (FQUOTIENT PX SCALEFACTOR))
100)))
(AND PY (SETQ PY (FQUOTIENT (FIXR (FQUOTIENT PY SCALEFACTOR))
100)))
(AND LEFT (SETQ LEFT (FQUOTIENT (FIXR (FQUOTIENT LEFT SCALEFACTOR))
100)))
(AND RIGHT (SETQ RIGHT (FQUOTIENT (FIXR (FQUOTIENT RIGHT SCALEFACTOR))
100)))
(AND TOP (SETQ TOP (FQUOTIENT (FIXR (FQUOTIENT TOP SCALEFACTOR))
100)))
(AND BOTTOM (SETQ BOTTOM (FQUOTIENT (FIXR (FQUOTIENT BOTTOM SCALEFACTOR))
100)))
(AND COLWIDTH (SETQ COLWIDTH (FQUOTIENT (FIXR (FQUOTIENT COLWIDTH
SCALEFACTOR))
100)))
(AND INTERCOL (SETQ INTERCOL (FQUOTIENT (FIXR (FQUOTIENT INTERCOL
SCALEFACTOR))
100)))
(SETQ HEADINGS (for HDG in HEADINGS
collect (LIST (CAR HDG)
(FQUOTIENT (FIXR (FQUOTIENT (CADR HDG)
SCALEFACTOR))
100)
(FQUOTIENT (FIXR (FQUOTIENT (CADDR HDG)
SCALEFACTOR))
100]
(RETURN (LIST PAGENOS PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL
HEADINGS])
)
(FILESLOAD TEDITMENU)
(RPAQ TEDIT.EXPANDED.PAGEMENU (\TEDITPAGEMENU.CREATE))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.EXPANDED.PAGEMENU)
)
(PUTPROPS TEDITPAGE COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9728 12332 (TEDIT.GET.PAGEFRAMES 9738 . 10042) (TEDIT.PARSE.PAGEFRAMES 10044 . 11023) (
TEDIT.PUT.PAGEFRAMES 11025 . 11552) (TEDIT.UNPARSE.PAGEFRAMES 11554 . 12330)) (12373 20574 (
TEDIT.SINGLE.PAGEFORMAT 12383 . 18928) (TEDIT.COMPOUND.PAGEFORMAT 18930 . 19371) (TEDIT.PAGEFORMAT
19373 . 19786) (SCALEPAGEUNITS 19788 . 20421) (\MICASTOPTS 20423 . 20572)) (20656 46514 (
TEDIT.FORMAT.HARDCOPY 20666 . 24363) (TEDIT.FORMATBOX 24365 . 30193) (TEDIT.FORMATHEADING 30195 .
33796) (TEDIT.FORMATPAGE 33798 . 36448) (TEDIT.FORMATTEXTBOX 36450 . 43242) (TEDIT.FORMATFOLIO 43244
. 46512)) (46589 47779 (TEDIT.HARDCOPY.PAGEHEADING 46599 . 47777)) (47837 63090 (
\TEDIT.SHOW.PAGEFORMATTING 47847 . 53894) (\TEDITPAGEMENU.CREATE 53896 . 54502) (
\TEDIT.APPLY.PAGEFORMATTING 54504 . 58832) (TEDIT.UNPARSE.PAGEFORMAT 58834 . 63088)))))
STOP