(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "25-Aug-94 10:55:28" {DSK}export>lispcore>library>TEDITPAGE.;3 123769 changes to%: (VARS TEDITPAGECOMS) (FILES TEDITDCL) previous date%: " 4-Jul-93 00:42:12" {DSK}export>lispcore>library>TEDITPAGE.;2) (* ; " Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TEDITPAGECOMS) (RPAQQ TEDITPAGECOMS ((FILES TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) (COMS (* ;; "Page-numbering font specification/default") (* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)") (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) (INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (FAMILY MODERN SIZE 10 WEIGHT MEDIUM SLOPE REGULAR))))) (* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.") (INITVARS (*TEDIT-PAGE-BREAKS* NIL))) (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)) (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 \TEDIT.FORMAT.FOUNDBOX? TEDIT.SKIP.SPECIALCOND) (* ;; "Aux function to capture page headings during line formatting:") (FNS TEDIT.HARDCOPY.PAGEHEADING) (* ;; " Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):") (FNS TEDIT.HARDCOPY-COLUMN-END)) (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)))))) (COMS (* ; "Page numbering option support") (FNS ROMANNUMERALS)) (COMS (* ;; "Foot note support") (FNS \TEDIT.FORMAT.FOOTNOTE))) ) (FILESLOAD TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RPAQQ \SCRATCHLEN 64) (CONSTANTS (\SCRATCHLEN 64)) ) (FILESLOAD (LOADCOMP) TEDITDCL) ) (* ;; "Page-numbering font specification/default") (* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)") (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) ) (RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (FAMILY MODERN SIZE 10 WEIGHT MEDIUM SLOPE REGULAR))) ) (* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.") (RPAQ? *TEDIT-PAGE-BREAKS* NIL) (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 '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 "13-Nov-86 20:10") (* 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) (PRIN2 (TEDIT.UNPARSE.PAGEFRAMES PAGEFRAMES) FILE *TEDIT-FILE-READTABLE*]) (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 '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) (* ; "Edited 17-Dec-87 14:54 by jds") (* ;; "Given a description in the args, create a pageframe to describe a single kind of page.") (PROG* ((LANDSCAPE? (LISTGET PAGEPROPS 'LANDSCAPE?)) (PAPERWIDTH (\TEDIT.PAPERWIDTH PAPERSIZE LANDSCAPE?)) (PAPERHEIGHT (\TEDIT.PAPERHEIGHT PAPERSIZE LANDSCAPE?)) [PAGEREGION (create PAGEREGION REGIONFILLMETHOD _ 'PAGE REGIONSPEC _ (create REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ PAPERWIDTH HEIGHT _ PAPERHEIGHT) REGIONLOCALINFO _ (CONS 'PAPERSIZE (CONS PAPERSIZE PAGEPROPS] 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 0.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 LANDSCAPE?)) (SETQ PY (SCALEPAGEYUNITS PY SCALEFACTOR PAPERSIZE LANDSCAPE?)) [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 LANDSCAPE?) (SCALEPAGEYUNITS (CADDR HDG) SCALEFACTOR PAPERSIZE LANDSCAPE?] (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 _ 'FOLIO REGIONSPEC _ (create REGION LEFT _ FOLIOLEFT BOTTOM _ PY WIDTH _ 288 HEIGHT _ 36] (replace REGIONLOCALINFO of FOLIO with (LIST 'PARALOOKS (LIST 'QUAD (OR PQUAD 'CENTERED)) 'CHARLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST (\TEDIT.PARSE.CHARLOOKS.LIST PFONT TEDIT.DEFAULT.FOLIO.LOOKS)) 'FORMATINFO (LISTGET PAGEPROPS '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 _ 'HEADING REGIONSPEC _ (create REGION LEFT _ (CADR HEADING) BOTTOM _ (CADDR HEADING) WIDTH _ (IMAX (IDIFFERENCE PAPERWIDTH (CADR HEADING)) 72) HEIGHT _ 36) REGIONLOCALINFO _ (LIST '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 _ '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 _ '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 _ 'SEQUENCE REGIONSUBBOXES _ (LIST FIRST (create PAGEREGION REGIONFILLMETHOD _ '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) (* ; "Edited 12-Jun-90 19:13 by mitani") (* ;;; "Programmatic interface for page formatting") (PROG ((TEXTOBJ (TEXTOBJ STREAM))) (COND ((AND (type? PAGEREGION FORMAT) (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of FORMAT))) (* ;  "This is a single page format. Make it a compound for ALL the pages.") (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (LIST FORMAT FORMAT FORMAT )) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) ([OR (type? PAGEREGION FORMAT) (AND (LISTP FORMAT) (type? PAGEREGION (CAR FORMAT] (* ;; "It's in one of the two forms acceptable to the page formatter--either a real tree of layout info, or a list of first/left/right infos") (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with FORMAT) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) ((LISTP FORMAT) (* ;  "It's likely to be a list acceptable to the parser. Try it that way.") (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with FORMAT) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) (T (\ILLEGAL.ARG FORMAT]) ) (* ;; "Perform page layout, based on a regular expression of typed regions.") (DEFINEQ (TEDIT.FORMAT.HARDCOPY [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG ENDPG) (* ;  "Edited 25-May-93 13:06 by sybalsky:mv:envos") (* ;;; "Format a document for hardcopy") (* ;;; "Returns the number of pages printed (not the final page number!). Returns NIL if the before-print-fn said not to print.") (* ;; "You want both TEXTOBJ and TEXTSTREAM here so that it hangs onto them even if the window goes away out from under it. DON'T REMOVE THEM!!!!") (RESETLST (PROG ((TEXTOBJ (TEXTOBJ STREAM)) (TEXTSTREAM (TEXTSTREAM STREAM)) (FORCENEXTPAGE NIL) [FORMATTINGSTATE (create PAGEFORMATTINGSTATE PAGE# _ (COND ((NUMBERP FIRSTPG#)) (T NIL)) FIRSTPAGE _ T STATE _ FIRSTPG# MINPAGE# _ STARTPG MAXPAGE# _ (OR ENDPG 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 (TEXTOBJ 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 THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) (replace PRESSREGION of FORMATTINGSTATE with TEDIT.DEFAULTPAGEREGION) (* ;  "Print in the usual region on the page") [SETQ BREAKPAGETITLE (COND (BREAKPAGETITLE) ((LISTGET PRINTOPTIONS 'DOCUMENT.NAME)) ([OR (NOT (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (type? STRINGP (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (type? STREAM (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ))) (type? STRINGP (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ] (* ;  "This isn't a real file, so print a generic name on the document break page.") "TEdit Hardcopy Output") (T (* ;  "It's a real file, so use the file name on the break page.") (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ] (SETQ BEFOREFN (TEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)) [COND (BEFOREFN (* ;  "Let the guy do any pre-hardcopy processing he wants to do") (COND ((EQ 'DON'T (APPLY* BEFOREFN TEXTSTREAM TEXTOBJ)) (* ;  "If it says not to do the hardcopy, then don't.") (RETURN] [SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM STREAM] (RESETLST (SETQ AFTERFN (TEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)) (AND AFTERFN (RESETSAVE NIL (LIST AFTERFN TEXTSTREAM TEXTOBJ))) (* ;  "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) 'CANPRINT] (LIST 'FONT (FONTCREATE 'GACHA 10) 'BREAKPAGEFILENAME BREAKPAGETITLE))) '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] (* ;  "So we close and delete the file in case of trouble.") (STREAMPROP PRSTREAM 'FORMATTINGSTATE FORMATTINGSTATE) (* ;  "So that subsidiary people can find out the state of the formatting.") (* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). Thiss will cause a performance hit. Sigh. JDS 9/5/89") (DSPRIGHTMARGIN 131072 PRSTREAM) [while (ILEQ (fetch CHNO of FORMATTINGSTATE) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) do (* ;; "Must use (fetch TEXTLEN...) so that NS characters in an unformatted doc don't cause infinite loops.") (* ;; "Format pages according to the existing layout:") (for REGION inside PAGEFRAMES do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch CHNO of FORMATTINGSTATE) REGION FORMATTINGSTATE IMAGETYPE)) (COND ((EQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) :NEW-PAGE-LAYOUT) (* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.") (SETQ PAGEFRAMES (fetch (PAGEFORMATTINGSTATE NEWPAGELAYOUT) of FORMATTINGSTATE)) (* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)") (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE with (SUB1 (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE))) (replace (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE with 0) (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with :SEARCHING-FOR-EQUIVALENT-PAGE) (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] [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 'DOCUMENT.NAME BREAKPAGETITLE] (OR FILE (DELFILE SCRATCHFILE))) (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (MKSTRING (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE)) "pg done.")) (RETURN (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE))))]) (TEDIT.FORMATBOX [LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE SERVERTYPE) (* ; "Edited 30-May-91 12:51 by jds") (* ;; "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)) CHNO NCHNO LINES LAST-CHNO SUBREGIONSPEC) (SETQ LINES NIL) (SELECTQ (fetch REGIONFILLMETHOD of REGION) (TEXT (* ;  "A normal text region. Fill it with text formatted the usual way.") [COND ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ;  "Only format if we're not looking for something else.") (CL:MULTIPLE-VALUE-SETQ (LINES NIL LAST-CHNO) (TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE]) (FOLIO (* ;  "A Page Number. Fill it in according to the instructions") [COND ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ;  "Only format if we're not looking for something else.") (SETQ LINES (TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE REGION]) (HEADING (* ;  "A Page heading. Fill it in from a text source we saved for the occasion.") [COND ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ;  "Only format if we're not looking for something else.") (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.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ;  "So that if this is the box he's looking for, we'll spot it and stop searching") (TEDIT.FORMATPAGE TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE)) ((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT) (* ;  "This box is really a list of boxes. Fill them.") (\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ;  "So that if this is the box he's looking for, we'll spot it and stop searching") (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 (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (OR (NOT (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)) (ILEQ (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE) (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE))) (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) :NEW-PAGE-LAYOUT)) do [SETQ SUBREGIONSPEC (create REGION using (fetch REGIONSPEC of SUBREGION) LEFT _ (IPLUS (fetch (REGION LEFT) of (fetch REGIONSPEC of SUBREGION )) (fetch (REGION LEFT) of REGIONSPEC)) BOTTOM _ (IPLUS (fetch (REGION BOTTOM) of (fetch REGIONSPEC of SUBREGION )) (fetch (REGION 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 (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) :NEW-PAGE-LAYOUT)) do (bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of REGION) while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE ) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE ) :NEW-PAGE-LAYOUT)) do [SETQ SUBREGIONSPEC (create REGION using (fetch REGIONSPEC of SUBREGION) LEFT _ (IPLUS (fetch (REGION LEFT) of (fetch REGIONSPEC of SUBREGION) ) (fetch (REGION LEFT) of REGIONSPEC)) BOTTOM _ (IPLUS (fetch (REGION BOTTOM) of (fetch REGIONSPEC of SUBREGION) ) (fetch (REGION 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 (LINEDESCRIPTOR LTEXTOBJ) of LINE)) LINE (fetch (LINEDESCRIPTOR CACHE) of LINE) REGION PRSTREAM))) [COND ((EQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (LINEDESCRIPTOR LTEXTOBJ) of LINE))) (* ;;  "This line refers back to the main text, so update the current-char pointer.") (* ;;  "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]") (SETQ CHNO (IMAX (OR CHNO 0) (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] (push (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) of FORMATTINGSTATE) LINE) (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with NIL)) (COND (LAST-CHNO (* ;  "We got a definite last chno from FORMATTEXTBOX, so use it.") (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with LAST-CHNO )) (CHNO (* ;  "Otherwise, use the new char no if we computed one.") (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO]) (TEDIT.FORMATHEADING [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 9-Oct-90 13:24 by jds") (* ;; "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 THISLINE LINE YBOT (FORCENEXTPAGE NIL) LINES HEADING) [COND ((SETQ PRECONDITIONS (LISTGET LOCALINFO '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 (PAGEFORMATTINGSTATE PAGEHEADINGS) of FORMATTINGSTATE ) (LISTGET LOCALINFO 'HEADINGTYPE] (* ;  "There's no text for this heading. Punt.") (RETURN))) [SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (SETQ HEADINGSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'PARALOOKS (fetch (PIECE PPARALOOKS) of (CAR HEADING ] (\TEDIT.INSERT.PIECES HEADINGTEXTOBJ 1 HEADING) (for PC in HEADING do (add (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ ) (fetch (PIECE PLEN) of PC))) (SETQ LINES (while (AND (ILESSP CHNO (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ )) (NOT FORCENEXTPAGE)) collect (SETQ THISLINE (create THISLINE)) (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE HEADINGTEXTOBJ (fetch (REGION WIDTH) of REGION) CHNO THISLINE (SETQ LINE (create LINEDESCRIPTOR )) PRSTREAM T)) (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) (* ;  "Mark this line as having cached print info.") (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with HEADINGSTREAM ) (* ;  "And remember the document it came from.") (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) (fetch (REGION LEFT) of REGION)) (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) (fetch (REGION 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 (LINEDESCRIPTOR 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 (REGION BOTTOM) of REGION ) (fetch (LINEDESCRIPTOR DESCENT) of LINE] (* ; "This line is good; use it.") (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) (* ;  "Keep track of the next character...") LINE)) (RETURN LINES]) (TEDIT.FORMATPAGE [LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE) (* ;  "Edited 4-Jul-93 00:29 by sybalskY:MV:ENVOS") (* ;; "Format a whole page -- run thru the page's sub-boxes filling them in by type:") (* ;; " FOLIO -- page number") (* ;; " PAGEHEADING -- running heads/footers") (* ;; " TEXT -- plain running text.") [COND ((NOT (EQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) :SEARCHING-FOR-EQUIVALENT-PAGE)) (* ;; "Only do real page formatting work if we're not trying to get ourselves to an equivalent page frame spec (having switched page layouts in mid-document).") (PROG ((FORCENEXTPAGE NIL) (CHNO CH#) (PAGE# (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) (PAGEPROPS (fetch (PAGEREGION REGIONLOCALINFO) of REGION)) (PAGEREGION (\TEDIT.SCALEREGION (fetch (PAGEREGION REGIONSPEC) of REGION) (DSPSCALE NIL PRSTREAM))) (END-OF-PAGE-FN (TEXTPROP TEXTOBJ 'END-OF-PAGE-FN)) (PRE-EXISTING-FONT (DSPFONT NIL PRSTREAM)) TEXTLEN THISLINE LINE LINES NCHNO TPAGE END-OF-PAGE-MARKER STARTING-FILEPTR PC NEWPARALOOKS) (* ;; "For real page independence, we need to reset the font to where it was as of the beginning of the page before calling DSPNEWPAGE. This avoids font creation in a page prolog, which might get missed otherwise.") (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) (* ;  "Print in the usual region on the page") (COND ([AND (ILEQ CHNO TEXTLEN) (EQ 'NEWPAGELAYOUT (fetch FMTPARATYPE of (SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES [fetch (PIECE PPARALOOKS) of (SETQ PC (\CHTOPC CHNO (fetch (TEXTOBJ PCTB) of TEXTOBJ] PC TEXTOBJ] (* ;; "The first paragraph on this page starts a new page layout.") (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with :NEW-PAGE-LAYOUT ) [replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 (CDR (\TEDIT.PARABOUNDS TEXTOBJ CHNO] [replace (PAGEFORMATTINGSTATE NEWPAGELAYOUT) of FORMATTINGSTATE with (TEDIT.PARSE.PAGEFRAMES (LISTGET (fetch (FMTSPEC FMTUSERINFO) of NEWPARALOOKS) 'NEWPAGELAYOUT] (RETURN))) (COND (PAGE# (* ;  "If we've already got a starting page number, don't set another one") ) ((SETQ TPAGE (LISTGET PAGEPROPS '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#))) (COND ((LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.") [COND ((fetch (STREAM OTHERPROPS) of PRSTREAM) (LISTPUT (fetch (STREAM OTHERPROPS) of PRSTREAM) 'PRINTERMODE 'LANDSCAPE)) (T (NCONC (fetch (STREAM OTHERPROPS) of PRSTREAM) (LIST 'PRINTERMODE 'LANDSCAPE](* ;  "Puts the info. into stream , IP creater may use") (DSPPUSHSTATE PRSTREAM) (DSPROTATE 90 PRSTREAM) (DSPTRANSLATE 0 (- (ffetch (REGION HEIGHT) of PAGEREGION)) PRSTREAM))) [COND (*TEDIT-PAGE-BREAKS* (* ;; "Only save the starting fileptr if we're making signatures, since we could be paginating to the screen as well.") (SETQ STARTING-FILEPTR (GETFILEPTR PRSTREAM] (DSPCLIPPINGREGION PAGEREGION PRSTREAM) (* ;  "Set the clipping region to the whole sheet of paper.") (DSPRIGHTMARGIN (fetch (REGION WIDTH) of PAGEREGION) PRSTREAM) [while [AND (ILEQ CHNO TEXTLEN) (EQ 'PAGEHEADING (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) of (\CHTOPC CHNO (fetch (TEXTOBJ 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 (LINEDESCRIPTOR 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)) (DSPFONT PRE-EXISTING-FONT PRSTREAM) [COND (*TEDIT-PAGE-BREAKS* (SHOW.IP PRSTREAM) (SETQ *TEDIT-PAGE-BREAKS* (NCONC1 *TEDIT-PAGE-BREAKS* (CONS STARTING-FILEPTR (GETFILEPTR PRSTREAM] (COND ((LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.") (AND (fetch (STREAM OTHERPROPS) of PRSTREAM) (LISTPUT (fetch (STREAM OTHERPROPS) of PRSTREAM) 'PRINTERMODE NIL)) (DSPTRANSLATE 0 (ffetch (REGION HEIGHT) of PAGEREGION) PRSTREAM) (DSPROTATE 0 PRSTREAM) (DSPPOPSTATE PRSTREAM))) [COND ([AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) TEXTLEN) (OR (NOT END-OF-PAGE-FN) (NEQ (SETQ END-OF-PAGE-MARKER (APPLY* END-OF-PAGE-FN TEXTOBJ FORMATTINGSTATE)) 'DON'T)) (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 ] (* ; "There is more to print....") (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 (ADD1 TEXTLEN))) ((EQ END-OF-PAGE-MARKER 'DON'T) (* ;  "The guy's e-o-page fn said stop. So stop.") (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 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 ] (* ;; "Some things happen regardless of whether we're searching or not: Need to count pages we pass over to find an equivalent page in the new layout:") (add (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE) 1]) (TEDIT.FORMATTEXTBOX [LAMBDA (TEXTOBJ PRSTREAM CH# PAGEREGION FORMATTINGSTATE) (* ;  "Edited 3-Jul-93 22:14 by sybalskY:MV:ENVOS") (* ;; "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.") (COND ((NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) 'SEARCHING) (* ;; "Only format text if we're really formatting.") (LET* ((CHNO CH#) [REGION (for VALUE in (ffetch (PAGEREGION REGIONSPEC) of PAGEREGION) collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM) VALUE] (COLUMNBOTTOM (fetch (REGION BOTTOM) of REGION)) (FIRSTLINE T) (BREAKAFTERLASTPARA NIL) (STREAMSCALE (DSPSCALE NIL PRSTREAM)) (FORCENEXTPAGE NIL) (FOOTNOTELINES (ffetch PAGEFOOTNOTELINES of FORMATTINGSTATE)) (PAGEFOOTNOTES NIL) COLUMN-YBASE PRIOR-COLUMN-YBOT THISLINE LINE YBOT LINES ORPHAN LASTLINE PREVLINE LHEIGHT FMTSPEC SPECIALYPOS NEWPAGETYPE FINAL-CHNO FOOTNOTE-REMNANTS KEPT-ONE-LINE) (* ;; "Account for lines carried over from prior columns:") [while (AND (ILEQ COLUMNBOTTOM (fetch (REGION TOP) of REGION)) (SETQ LINE (pop FOOTNOTELINES))) do (* ;; "Move as many potential footnote lines into this column as will fit.") (* ;  "And move the bottom of the column up to account for them") (COND ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) of LINE)) (fetch (REGION TOP) of REGION)) (* ;  "If we ran out of room for footnotes, put this line back on the queue") (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS IGNORE KEPT-ONE-LINE) (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION TEXTOBJ FORMATTINGSTATE)) [COND (KEPT-ONE-LINE (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] (SETQ FOOTNOTELINES (APPEND FOOTNOTE-REMNANTS FOOTNOTELINES)) (RETURN)) (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] (freplace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE with FOOTNOTELINES ) (* ;  "Remember any remaining footnotes") [SETQ LINES (while (AND (ILEQ CHNO (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (NOT FORCENEXTPAGE)) collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) of FORMATTINGSTATE)) (create LINEDESCRIPTOR))) (* ;  "Grab a line descriptor from the recycling list, or create a new one.") (SETQ THISLINE (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) (create THISLINE))) (* ;  "And a recycled or new THISLINE cache for char widths &c") (BLOCK) (* ;  "Allow other things to happen while we format....") (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) CHNO THISLINE LINE PRSTREAM)) (* ;  "Format the line, noting any form-feeds") (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) (* ;  "Mark this line as having cached print info.") (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) (* ;  "And remember the document it came from.") (COND ((fetch (LINEDESCRIPTOR LMARK) of LINE) (* ;; "This line is a placeholder for a page heading, OR for a conditional line that is to be skipped (e.g., and EVEN text para on an odd page). All it tells us is what character to skip to so we can continue.") (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) LINE) ((LISTGET (fetch (FMTSPEC FMTUSERINFO) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) 'FOOTNOTE) (* ;; "This paragraph is a footnote para.") (COND (FORCENEXTPAGE (HELP))) (SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ PRSTREAM LINE REGION PAGEREGION FORMATTINGSTATE)) [SETQ CHNO (PLUS 1 (fetch (LINEDESCRIPTOR CHARLIM) of (CAR (FLAST FOOTNOTELINES] (* ; "Grab the lines of this footnote") [COND [(fetch (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE) (* ;;  "There are overflow footnote lines from this page already. Add to them.") (replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE with (COPY (APPEND (fetch (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE) FOOTNOTELINES] (T (* ;;  "No overflow footnote lines yet. Try adding more footnotes to this page/column.") (for LINE in FOOTNOTELINES as REST on FOOTNOTELINES do (COND ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) of LINE)) (OR YBOT (fetch (REGION TOP) of REGION))) (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS IGNORE) (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION TEXTOBJ FORMATTINGSTATE 3 (NOT FIRSTLINE))) [replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE with (COPY (APPEND FOOTNOTE-REMNANTS (CDR REST] [SETQ FINAL-CHNO (IMAX CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of (CAR (FLAST REST] [COND (FIRSTLINE (* ; "If this overflowing footnote line happens before any real text line, go ahead and update the colbottom, because we want to stop here anyhow.") (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] (RETURN)) (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT ) of LINE] NIL) (T (* ;  "This line must not represent a special item, e.g. a page heading. If it does, ignore it.") (SETQ FMTSPEC (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) )) (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) (fetch (REGION LEFT) of REGION))) (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) )) (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) (fetch (REGION 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 (FMTSPEC FMTSPECIALY) of FMTSPEC) (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) (fetch (LINEDESCRIPTOR 1STLN) of LINE)) (* ;  "There is a special Y location for this paragraph. Move there") (SETQ SPECIALYPOS (SETQ YBOT (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC] [(AND COLUMN-YBASE (\NEW-COLUMN-START LINE FMTSPEC)) (* ;;  "This is the first line of a new column; back YBOT back down to match the prior column.") (SETQ YBOT (- COLUMN-YBASE (fetch (LINEDESCRIPTOR DESCENT) of LINE] [YBOT (* ;  "We're into it; take account of this line's height") (COND [(fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) (SETQ LHEIGHT (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE) (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) (COND ((fetch (LINEDESCRIPTOR 1STLN) of LINE) (IPLUS (OR (fetch (FMTSPEC LEADBEFORE) of FMTSPEC) 0) (OR (fetch (FMTSPEC LEADAFTER) of (fetch (LINEDESCRIPTOR LFMTSPEC) of PREVLINE)) 0))) (T 0] (T (COND [(\FIRST-COLUMN-START LINE FMTSPEC) (SETQ YBOT (IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT) (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR 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 (REGION TOP) of REGION) (IPLUS (fetch (LINEDESCRIPTOR LTRUEASCENT) of LINE) (fetch (LINEDESCRIPTOR 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 FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LINE)) (SETQ ORPHAN LINE) (* ; "Remember this potential orphan") NIL) ((AND (NOT FIRSTLINE) (fetch (LINEDESCRIPTOR 1STLN) of LINE) (SETQ NEWPAGETYPE (OR (fetch (FMTSPEC FMTNEWPAGEBEFORE) of (fetch (LINEDESCRIPTOR LFMTSPEC ) of LINE)) BREAKAFTERLASTPARA))) (* ;;  "We're supposed to put this line at the start of a new page/column (any box, later)") (SETQ FORCENEXTPAGE 'USERBREAK) (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LINE)) (SETQ ORPHAN NIL) (COND ((NEQ NEWPAGETYPE T) (* ;  "This isn't simply go to a new box; we need to set up the search for it.") (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'SEARCHING) (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE with NEWPAGETYPE))) NIL) (T (* ; "This line is good; use it.") (COND ((AND (fetch (FMTSPEC FMTNEWPAGEAFTER) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE))) (* ;  "We're supposed to put the line after this one at the start of a new page/column (any box, later)") (SETQ BREAKAFTERLASTPARA T))) (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) (COND (PRIOR-COLUMN-YBOT (SETQ PRIOR-COLUMN-YBOT (IMIN PRIOR-COLUMN-YBOT YBOT))) (T (SETQ PRIOR-COLUMN-YBOT YBOT))) (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) [COND ((\FIRST-COLUMN-START LINE FMTSPEC) (* ;; "This is the start of a new group of paragraphs to be lined up in columns. Save the YBASE for these guys for the other columns.") (SETQ COLUMN-YBASE (fetch (LINEDESCRIPTOR YBASE) 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 (LINEDESCRIPTOR 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") (TEDIT.HARDCOPY-COLUMN-END LINES ORPHAN FORCENEXTPAGE CHNO PAGEFOOTNOTES REGION TEXTOBJ FORMATTINGSTATE FINAL-CHNO]) (TEDIT.FORMATFOLIO [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* ; "Edited 30-May-91 12:51 by jds") (* ;; "Print a page number (called a %"folio%" in the biz) at the location and with the alignment specified in the REGIONSPEC.") (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 THISLINE LINE YBOT PARALOOKS CHARLOOKS NOFIRSTPAGE PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST) (SETQ PARALOOKS (LISTGET FOLIOINFO 'PARALOOKS)) (SETQ CHARLOOKS (OR (LISTGET FOLIOINFO 'CHARLOOKS) TEDIT.DEFAULT.FOLIO.LOOKS)) (SETQ NOFIRSTPAGE (LISTGET FOLIOINFO 'NOFIRSTPAGE)) (SETQ INFOLIST (LISTGET FOLIOINFO '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 'PARALOOKS PARALOOKS 'LOOKS CHARLOOKS] (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 (fetch (TEXTOBJ TEXTLEN) of FOLIOTEXTOBJ)) (NOT FORCENEXTPAGE)) collect (SETQ THISLINE (create THISLINE)) (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE FOLIOTEXTOBJ (fetch (REGION WIDTH) of REGION) CHNO THISLINE (SETQ LINE (create LINEDESCRIPTOR )) PRSTREAM)) (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with FOLIOSTREAM) (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) (fetch (REGION LEFT) of REGION)) (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) (fetch (REGION LEFT) of REGION)) (* ; "Format the next possible line") (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR 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 (LINEDESCRIPTOR 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 (SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) (fetch (LINEDESCRIPTOR DESCENT) of LINE] (COND ((ILESSP YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION ) (fetch (LINEDESCRIPTOR DESCENT) of LINE))) (* ;  "This line hangs off the bottom; punt it.") NIL) (T (* ; "This line is good; use it.") (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) LINE]) (\TEDIT.FORMAT.FOUNDBOX? [LAMBDA (PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Apr-88 17:35 by jds") (* ;;; "Return T if we're either not looking to begin in a new box, or we are and we've found it.") (* ;;; "This is part of generalizing the 'go to a new page' code to allow going to an arbitrary new formatting box.") (SELECTQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) (FORMATTING (* ;  "we're just munching along formatting. Keep going.") T) (SEARCHING (* ;  "We're searching for a page box of the right type. Decide if this is it or not.") (COND ((EQ (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE ) (fetch (PAGEREGION REGIONTYPE) of PAGEREGION)) (* ;  "What we're looking for matches what we've got. Turn off the search and return T") (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'FORMATTING) T))) (:SEARCHING-FOR-EQUIVALENT-PAGE (* ;; "We've switched document formats in mid-document, and need to find the corresponding page frame to continue properly.") [COND ((IEQP (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE) (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE)) (* ;  "We've formatted enough pages up to now.") (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'FORMATTING]) T]) (TEDIT.SKIP.SPECIALCOND [LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM) (* ;  "Edited 25-May-93 13:44 by sybalsky:mv:envos") (* ;; "This is a special-paragraph that should be skipped in this context (e.g. an EVEN para on an odd page). 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 'FORMATTINGSTATE)) (HEADINGTYPE (fetch FMTPARASUBTYPE of PARALOOKS)) NPC PIECES) (SETQ NPC PC) (SETQ PIECES (repeatuntil [OR (NOT PC) (AND (fetch (PIECE PPARALAST) of PC) (OR (NOT NPC) (NEQ (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) of NPC)) 'PAGEHEADING) (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE of (fetch (PIECE PPARALOOKS) of NPC] collect (* ;  "GRAB THE PIECES FOR THIS HEADING.") (SETQ PC NPC) (AND PC (add LEN (fetch (PIECE PLEN) of PC)) (SETQ NPC (fetch (PIECE NEXTPIECE) of PC))) NIL)) (replace (LINEDESCRIPTOR LMARK) of LINE with 'SPECIAL) (* ;  "Mark this as text to skip, as far as the main formatter's concerned.") (replace (LINEDESCRIPTOR 1STLN) of LINE with T) (replace (LINEDESCRIPTOR LSTLN) of LINE with T) (replace (LINEDESCRIPTOR LHEIGHT) of LINE with 0) (replace (LINEDESCRIPTOR ASCENT) of LINE with 0) (replace (LINEDESCRIPTOR DESCENT) of LINE with 0) (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with 0) (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with 0) (replace (LINEDESCRIPTOR CHARLIM) of LINE with (SUB1 (IPLUS CHNO LEN))) (* ;  "Set the line's CHARLIM to be the last character in the page heading.") ]) ) (* ;; "Aux function to capture page headings during line formatting:") (DEFINEQ (TEDIT.HARDCOPY.PAGEHEADING [LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM) (* ; "Edited 18-Mar-93 13:07 by jds") (* ;; "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 'FORMATTINGSTATE)) (HEADINGTYPE (fetch FMTPARASUBTYPE of PARALOOKS)) NPC PIECES) (SETQ NPC PC) [SETQ PIECES (repeatuntil [OR (NOT PC) (NOT (type? PIECE PC)) (AND (fetch (PIECE PPARALAST) of PC) (OR (NOT NPC) (NEQ (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) of NPC)) 'PAGEHEADING) (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE of (fetch (PIECE PPARALOOKS) of NPC] collect (* ;  "GRAB THE PIECES FOR THIS HEADING.") (SETQ PC NPC) (COND ((type? PIECE PC) (add LEN (fetch (PIECE PLEN) of PC)) (SETQ NPC (fetch (PIECE NEXTPIECE) of PC)) (\TEDIT.COPYTEXTSTREAM.PIECEMAPFN PC TEXTOBJ TEXTOBJ TEXTOBJ] (replace (LINEDESCRIPTOR LMARK) of LINE with T) (replace (LINEDESCRIPTOR CHARLIM) of LINE with (SUB1 (IPLUS CHNO LEN))) (* ;  "Set the line's CHARLIM to be the last character in the page heading.") (replace (LINEDESCRIPTOR 1STLN) of LINE with T) (replace (LINEDESCRIPTOR LSTLN) of LINE with T) (replace (LINEDESCRIPTOR LHEIGHT) of LINE with 0) (replace (LINEDESCRIPTOR ASCENT) of LINE with 0) (replace (LINEDESCRIPTOR DESCENT) of LINE with 0) (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with 0) (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with 0) (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE) (fetch FMTPARASUBTYPE of PARALOOKS) PIECES]) ) (* ;; " Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):") (DEFINEQ (TEDIT.HARDCOPY-COLUMN-END [LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 11-May-93 01:21 by jds") (* ;; "Do column-end processing for TEdit hardcopy -- widow elimination, respect keep-together specifications, etc.") (* ;; "RETURNS:") (* ;; " -- List of line descriptors in the column") (* ;; " -- List of line descriptors removed from the end of the column.") (* ;; " -- ?? CHNO for start of next line in sequence??") (SETQ ORIGINAL-LINES (DREMOVE NIL ORIGINAL-LINES)) (* ; "Remove any NILs from the list of lines; they're artifacts of running into page headings in mid-page.") (LET ((LINES (COPY ORIGINAL-LINES)) LASTLINE (REMOVED-LINES (LIST ORPHAN))) [COND (LINES (* ;  "Only worry about widows and orphans if there are really lines to worry about") [for LINE in LINES when (fetch (LINEDESCRIPTOR LMARK) of LINE) do (DREMOVE LINE LINES) (SETQ FINAL-CHNO (AND FINAL-CHNO (IMAX FINAL-CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] (SETQ LASTLINE (CAR (FLAST LINES))) (* ;  "Find the last line in this box (column or page)") [COND ((AND ORPHAN (fetch (LINEDESCRIPTOR LSTLN) of ORPHAN) (NOT (fetch (LINEDESCRIPTOR 1STLN) of ORPHAN))) (* ;; "There was an overhanging line, and it was the last line of the paragraph. Remove the penultimate line.") (SETQ LINES (DREMOVE LASTLINE LINES)) (CL:PUSH LASTLINE REMOVED-LINES) (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LASTLINE)) (SETQ LASTLINE (CAR (FLAST LINES] [COND ((AND LASTLINE (fetch (LINEDESCRIPTOR 1STLN) of LASTLINE) (NOT (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE)) (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LASTLINE) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) (* ;  "The last line on the page is a widow. Remove it, too.") (SETQ LINES (DREMOVE LASTLINE LINES)) (CL:PUSH LASTLINE REMOVED-LINES) (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LASTLINE)) (SETQ LASTLINE (CAR (FLAST LINES] (COND [(NOT LINES) (* ;; "This is a 2- or 3-line paragraph, with only the first 1 or 2 lines fitting on ANY page. Just return the first 1 or two lines, and we'll have to eat the widow.") (SETQ LINES ORIGINAL-LINES) (SETQ FINAL-CHNO (COND (ORPHAN (fetch (LINEDESCRIPTOR CHAR1) of ORPHAN)) (T (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of (CAR (FLAST ORIGINAL-LINES] ([AND (NEQ FORCENEXTPAGE 'USERBREAK) (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (OR (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) of LASTLINE)) (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LASTLINE)) (NOT (FETCH (LINEDESCRIPTOR LSTLN) OF LASTLINE] (* ;; "Only do widow/orphan detection if this is NOT a page break the user asked for. And this isn't the end of the document.") (for LASTLINE in (REVERSE LINES) while [OR (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) of LASTLINE)) (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LASTLINE)) (NOT (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE] do (* ;; "Run thru, removing any trailing headings. However, assure that there's at least one line on a page.") finally (COND [(AND LASTLINE (AND (NOT (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) of LASTLINE))) (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE))) (* ;; "OK we found a line that DOESN'T need to be kept with the other paragraphs. Chop off the list starting AFTER it.") [SETQ LINES (LDIFF LINES (SETQ LASTLINE (CDR (MEMB LASTLINE LINES] (SETQ REMOVED-LINES (APPEND LASTLINE REMOVED-LINES)) (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of (CAR LASTLINE] (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "WARNING: Page full of headings on page " (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE] [COND (FOOTNOTELINES (* ;; "There are footnotes--fix up their vertical locations, so they're aligned on the botton of the column.") (bind [YBOT _ (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) (fetch (LINEDESCRIPTOR DESCENT) of (CAR (FLAST FOOTNOTELINES] for LINE in (REVERSE FOOTNOTELINES) do (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( LINEDESCRIPTOR DESCENT) of LINE))) (add YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] (COND ((OR LINES FOOTNOTELINES) (* ;  "There really ARE lines in this column; take care of them.") (CL:VALUES (APPEND LINES FOOTNOTELINES) REMOVED-LINES FINAL-CHNO NIL)) ((AND ORPHAN (NOT ORIGINAL-LINES) (NOT DONT-KEEP-SINGLE-LINE)) (* ;  "If there's only one line left for this box, return it anyhow.") (CL:VALUES (CONS ORPHAN FOOTNOTELINES) NIL (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of ORPHAN)) T)) ((AND (NOT DONT-KEEP-SINGLE-LINE) REMOVED-LINES) (CL:VALUES (LIST (SETQ LASTLINE (CAR REMOVED-LINES))) (CDR REMOVED-LINES) (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LASTLINE)) NIL)) (ORPHAN (* ; "WAS ORPHAN.") (* ;; "There's only the one line, so let's go back and try again.") (CL:VALUES NIL (LIST ORPHAN) FINAL-CHNO NIL]) ) (* ;; "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 LANDSCAPE?) (* ; "Edited 21-Apr-88 10:46 by jds") (* ;; "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 LANDSCAPE?)) (SETQ TVAL (IPLUS OTHEREDGE TVAL] (RETURN TVAL]) (SCALEPAGEYUNITS [LAMBDA (VALUE FACTOR PAPERSIZE LANDSCAPE?) (* ; "Edited 17-Dec-87 14:52 by jds") (* ;; "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 LANDSCAPE?)) (SETQ TVAL (IPLUS OTHEREDGE TVAL] (RETURN TVAL]) (\TEDIT.PAPERHEIGHT [LAMBDA (PAPERSIZE LANDSCAPE?) (* ; "Edited 29-Dec-86 15:06 by jds") (* ;;; "Compute the HEIGHT of a sheet of paper, according to PAPERSIZE, in points.") (COND (LANDSCAPE? (* ;  "The paper is landscape, so its height is the WIDTH of the same paper size, normal.") (\TEDIT.PAPERWIDTH PAPERSIZE NIL)) (T (* ;  "Not landscape, so look up the size spec:") (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 LANDSCAPE?) (* ; "Edited 9-Dec-87 20:10 by jds") (* ;;; "Compute the WIDTH of a sheet of paper, according to PAPERSIZE and LANDSCAPE?") (LET (CANONICAL-PAPERSIZE) (COND (LANDSCAPE? (* ;  "It's landscape paper, so look at the HEIGHT of the corresponding normal paper.") (\TEDIT.PAPERHEIGHT PAPERSIZE NIL)) (T (* ;  "Not landscape, so look up the size spec:") (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) (COND ((SETQ CANONICAL-PAPERSIZE (ASSOC PAPERSIZE TEDIT.PAPER.SIZES)) (fetch (TEDITPAPERSIZE TPSWIDTH) of CANONICAL-PAPERSIZE)) (T (\ILLEGAL.ARG PAPERSIZE]) ) (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)) ) (* ; "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 'm) (add NUMBER -1000)) ((IGEQ NUMBER 900) (push CHARS 'c) (push CHARS 'm) (add NUMBER -900)) ((IGEQ NUMBER 500) (push CHARS 'd) (add NUMBER -500)) ((IGEQ NUMBER 400) (push CHARS 'c) (push CHARS 'd) (add NUMBER -400)) ((IGEQ NUMBER 100) (push CHARS 'c) (add NUMBER -100)) ((IGEQ NUMBER 90) (push CHARS 'x) (push CHARS 'c) (add NUMBER -90)) ((IGEQ NUMBER 50) (push CHARS 'l) (add NUMBER -50)) ((IGEQ NUMBER 40) (push CHARS 'x) (push CHARS 'l) (add NUMBER -40)) ((IGEQ NUMBER 10) (push CHARS 'x) (add NUMBER -10)) ((IGEQ NUMBER 9) (push CHARS 'i) (push CHARS 'x) (add NUMBER -9)) ((IGEQ NUMBER 5) (push CHARS 'v) (add NUMBER -5)) ((IGEQ NUMBER 4) (push CHARS 'i) (push CHARS 'v) (add NUMBER -4)) (T (push CHARS 'i) (add NUMBER -1] (RETURN (COND [UCFLG (* The caller wants his roman  numerals upper case) (U-CASE (CONCATLIST (REVERSE CHARS] (T (CONCATLIST (REVERSE CHARS]) ) (* ;; "Foot note support") (DEFINEQ (\TEDIT.FORMAT.FOOTNOTE [LAMBDA (TEXTOBJ PRSTREAM LINE REGION PAGEREGION FORMATTINGSTATE) (* ; "Edited 30-May-91 12:52 by jds") (* ;; "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.") (LET* ((CHNO (fetch (LINEDESCRIPTOR CHAR1) of LINE)) (STREAMSCALE (DSPSCALE NIL PRSTREAM)) THISLINE LINE YBOT LINES ORPHAN LASTLINE PREVLINE LHEIGHT FMTSPEC SPECIALYPOS NEWPAGETYPE) (SETQ LINES (while [AND (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (OR (NOT PREVLINE) (NOT (fetch (LINEDESCRIPTOR LSTLN) of PREVLINE] collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) of FORMATTINGSTATE)) (create LINEDESCRIPTOR))) (* ;  "Grab a line descriptor from the recycling list, or create a new one.") (SETQ THISLINE (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) (create THISLINE))) (* ;  "And a recycled or new THISLINE cache for char widths &c") (BLOCK) (* ;  "Allow other things to happen while we format....") (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) CHNO THISLINE LINE PRSTREAM) (* ;  "Format the line, noting any form-feeds") (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) (* ;  "Mark this line as having cached print info.") (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) (* ;  "And remember the document it came from.") (SETQ FMTSPEC (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) (fetch (REGION LEFT) of REGION)) (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) (fetch (REGION LEFT) of REGION)) (* ; "Format the next possible line") (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR 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") LINES]) ) (PUTPROPS TEDITPAGE COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993 1994)) (DECLARE%: DONTCOPY (FILEMAP (NIL (3553 7108 (TEDIT.GET.PAGEFRAMES 3563 . 3915) (TEDIT.PARSE.PAGEFRAMES 3917 . 5620) ( TEDIT.PUT.PAGEFRAMES 5622 . 6250) (TEDIT.UNPARSE.PAGEFRAMES 6252 . 7106)) (7154 19997 ( TEDIT.SINGLE.PAGEFORMAT 7164 . 17723) (TEDIT.COMPOUND.PAGEFORMAT 17725 . 18351) (TEDIT.PAGEFORMAT 18353 . 19995)) (20084 97190 (TEDIT.FORMAT.HARDCOPY 20094 . 31166) (TEDIT.FORMATBOX 31168 . 46475) ( TEDIT.FORMATHEADING 46477 . 53053) (TEDIT.FORMATPAGE 53055 . 64626) (TEDIT.FORMATTEXTBOX 64628 . 84946 ) (TEDIT.FORMATFOLIO 84948 . 91873) (\TEDIT.FORMAT.FOUNDBOX? 91875 . 94064) (TEDIT.SKIP.SPECIALCOND 94066 . 97188)) (97270 100471 (TEDIT.HARDCOPY.PAGEHEADING 97280 . 100469)) (100580 110247 ( TEDIT.HARDCOPY-COLUMN-END 100590 . 110245)) (110292 115296 (SCALEPAGEUNITS 110302 . 111530) ( SCALEPAGEXUNITS 111532 . 112296) (SCALEPAGEYUNITS 112298 . 113063) (\TEDIT.PAPERHEIGHT 113065 . 113994 ) (\TEDIT.PAPERWIDTH 113996 . 115294)) (115618 119532 (ROMANNUMERALS 115628 . 119530)) (119568 123634 (\TEDIT.FORMAT.FOOTNOTE 119578 . 123632))))) STOP