(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "25-Aug-94 10:54:07" {DSK}<king>export>lispcore>library>TEDITHCPY.;4
 104820 

      changes to%:  (VARS TEDITHCPYCOMS) (FILES TEDITDCL)

      previous date%: "29-Mar-94 17:25:49" {DSK}<king>export>lispcore>library>TEDITHCPY.;3)


(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT TEDITHCPYCOMS)

(RPAQQ TEDITHCPYCOMS
 ((FILES TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) (COMS (* ;; "Generic interface functions and common code") (FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX)) (COMS (* ;; "Functions for scaling distances and regions as needed during hardcopy.") (FNS \TEDIT.SCALE \TEDIT.SCALEREGION)) (COMS (* ;; "PRESS-specific code") (VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495))) (* ; "0.75 inches from bottom, 1 from top")) (COMS (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.") (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY) (P (LISTPUT (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE INTERPRESS) PRINTFILETYPES)) (QUOTE TEDIT) (FUNCTION \TEDIT.HARDCOPY))) (P (LET ((PRESSVALUES (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE PRESS) PRINTFILETYPES)))) (COND (PRESSVALUES (* ; "Only install PRESS printing if PRESS is loaded.") (LISTPUT PRESSVALUES (QUOTE TEDIT) (FUNCTION \TEDIT.PRESS.HARDCOPY))))))) (COMS (* ;; "vars for Japanese Line Break") (VARS (TEDIT.DONT.BREAK.CHARS (QUOTE (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539 9571 9573 9575 9582))) (TEDIT.DONT.LAST.CHARS (QUOTE (8524 8538 8536 8534)))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) (COMS (* ;; "Support for hardcopying several files as one document") (FNS TEDIT-BOOK)))
)

(FILESLOAD TEDITDCL)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ \SCRATCHLEN
 64)


(CONSTANTS (\SCRATCHLEN 64))
)


(FILESLOAD (LOADCOMP) TEDITDCL)
)



(* ;; "Generic interface functions and common code")


(DEFINEQ

(TEDIT.HARDCOPY

  [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)

                                                             (* ; "Edited  5-Jan-88 16:09 by jds")

          
          (* ;; "Send the text to the printer.")


    (COND
       [(OR SERVER DEFAULTPRINTINGHOST)
          
          (* ;; "We can only hardcopy if there is a server specified, or the system will give us a reasonable default one.")


        (for
 IMAGETYPE in
 (PRINTERPROP (PRINTERTYPE SERVER)
                                         'CANPRINT)
           do
 (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER 
                                 PRINTOPTIONS IMAGETYPE)) finally
 (ERROR (CONCAT 
                                                                  "Can't print TEDIT documents on a "
                                                                                    (PRINTERTYPE
                                                                                     SERVER)
                                                                                    " printer."]
       (T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM)
                 "Can't HARDCOPY:  No print server specified." T])

(TEDIT.HCPYFILE

  [LAMBDA (STREAM FILE BREAKPAGETITLE)
                  (* ; "Edited 12-Jun-90 18:36 by mitani")


         (* Create a hardcopy-format FILE from the text on STREAM, with the file type 

       depending on what the default printer is.)


    (LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE)
                                 'CANPRINT]
          TEXTOBJ FILENM TXTFILE)
         (COND
            ([SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT
                                                         (SETQ TEXTOBJ (TEXTOBJ STREAM))
                                                         (CONCAT IMAGETYPE " file name:  ")
                                                         (COND
                                                            ((type?
 STREAM (SETQ TXTFILE
                                                                                (fetch

                                                                                 (TEXTOBJ TXTFILE)
                                                                                   of
 TEXTOBJ)))
                                                             (* There was a file, so supply 

                                                           default)

                                                             (PACKFILENAME 'VERSION NIL 'EXTENSION
                                                                    (SELECTQ IMAGETYPE
                                                                        (PRESS 'PRESS)
                                                                        (INTERPRESS 'IP)
                                                                        NIL)
                                                                    'BODY
                                                                    (fetch
 (STREAM FULLFILENAME)
                                                                       of
 TXTFILE]
             (TEDIT.FORMAT.HARDCOPY STREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])

(\TEDIT.HARDCOPY.DISPLAYLINE

  [LAMBDA (TEXTOBJ LINE THISLINE REGION PRSTREAM)
        (* ; "Edited 29-Mar-94 13:44 by jds")


    (* ;; "Display LINE on the HARDCOPY file under way.")


    (* ;; "If possible, use the information cached in THISLINE")


    (PROG ((CH 0)
           (CHLIST (fetch
 CHARS of
 (OR (fetch
 (LINEDESCRIPTOR CACHE) of
 LINE)
                                               THISLINE)))
           (WLIST (fetch
 (THISLINE WIDTHS) of
 (OR (fetch
 (LINEDESCRIPTOR CACHE)
                                                             of
 LINE)
                                                          THISLINE)))
           (LOOKS (fetch
 LOOKS of
 (OR (fetch
 (LINEDESCRIPTOR CACHE) of
 LINE)
                                              THISLINE)))
           (TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
           (LEFTMARGIN (fetch
 (LINEDESCRIPTOR LEFTMARGIN) of
 LINE))
           (STREAMSCALE (DSPSCALE NIL PRSTREAM))
           (LINELEN (fetch
 LEN of
 (OR (fetch
 (LINEDESCRIPTOR CACHE) of
 LINE)
                                              THISLINE)))
           OLOOKS LOOKSTARTX FONT OFONT CURRENTY FIRST-SCALED-CHAR KERN)
          (COND
             ((ILEQ (fetch
 (LINEDESCRIPTOR CHAR1) of
 LINE)
                    TEXTLEN)                                 (* ; 

                                  "Only display the line if it appears before the end of the text!")

              (COND
                 ((fetch
 (LINEDESCRIPTOR CACHE) of
 LINE)
                                                             (* ; 

                                   "This line was cached.  Don';t need to re-compute the breaks &c")

                  )
                 ((NEQ (fetch
 DESC of
 THISLINE)
                       LINE)                                 (* ; "Format the line to our specs")

                  (\TEDIT.HARDCOPY.FORMATLINE
 TEXTOBJ (fetch
 (REGION WIDTH) of
 REGION)
                         (fetch
 (LINEDESCRIPTOR CHAR1) of
 LINE)
                         THISLINE LINE NIL PRSTREAM)))       (* ; 

                                                           "Use the characters cached in THISLINE.")

              (SETQ OLOOKS (\EDITELT LOOKS 0))
              (COND
                 ((ZEROP (SETQ FIRST-SCALED-CHAR (fetch
 (THISLINE TLFIRSTSPACE) of
 THISLINE))
                         )                                   (* ; 

                                                           "For expanding spaces to justify a line")

                  (DSPSPACEFACTOR (fetch
 (THISLINE TLSPACEFACTOR) of
 THISLINE)
                         PRSTREAM)
                  (SETQ FIRST-SCALED-CHAR -1)))
              (MOVETO LEFTMARGIN [SETQ CURRENTY (COND
                                                   [(AND (fetch
 (CHARLOOKS CLOFFSET) of

                                                                                         OLOOKS)
                                                         (NEQ 0 (fetch
 (CHARLOOKS CLOFFSET)
                                                                   of
 OLOOKS)))
                                                    (IPLUS (fetch
 (LINEDESCRIPTOR YBASE)
                                                              of
 LINE)
                                                           (FIXR (FTIMES STREAMSCALE
                                                                        (fetch
 (CHARLOOKS 
                                                                                          CLOFFSET)
                                                                           of
 OLOOKS]
                                                   (T (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE]
                     PRSTREAM)
              (DSPFONT (SETQ OFONT (fetch
 (CHARLOOKS CLFONT) of
 OLOOKS))
                     PRSTREAM)
              [COND
                 ((SETQ KERN (LISTGET (fetch
 (CHARLOOKS CLUSERINFO) of
 OLOOKS)
                                    'KERN))
                  (SETQ KERN (FIXR (FTIMES STREAMSCALE KERN]
              (STREAMPROP PRSTREAM 'KERN KERN)
              (SETQ LOOKSTARTX LEFTMARGIN)
              (while
 (EQ (CHARCODE SPACE)
                             (\EDITELT CHLIST LINELEN)) do
 
                                                             (* ; 

      "Trim any trailing blanks off the line, to avoid the INTERPRESS CORRECT bug that they cause.")

                                                              (add
 LINELEN -1))
              (bind
 (LOOKNO _ 1)
                     (TX _ LEFTMARGIN)
                     DX for
 I from
 0 to
 LINELEN
                 do
 (SETQ CH (\EDITELT CHLIST I))
                       (SETQ DX (\EDITELT WLIST I))
                       [COND
                          ((EQ I FIRST-SCALED-CHAR)          (* ; "Time to turn on space scaling.")

                           (DSPSPACEFACTOR (fetch
 (THISLINE TLSPACEFACTOR) of
 THISLINE)
                                  PRSTREAM)
                           (LET ((X (DSPXPOSITION NIL PRSTREAM))
                                 (Y (DSPYPOSITION NIL PRSTREAM)))
                                (MOVETO 0 0 PRSTREAM)
                                (MOVETO X Y PRSTREAM]
                       [SELECTC CH
                           (LMInvisibleRun 
                                           (* ;; 

                                       "An INVISIBLE run -- skip it, and skip over the char count:")


                                (add
 LOOKNO 1))
                           (LMLooksChange 

                                     (* ;; "Change in character looks.  Do any cleanup (like underlining) for the prior characters, and set up the new looks, like font:")


                                          (\TEDIT.HARDCOPY.MODIFYLOOKS
 LINE LOOKSTARTX TX
                                                 (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                                                 OLOOKS PRSTREAM)
                                          (DSPFONT (fetch
 (CHARLOOKS CLFONT)
                                                      of
 (SETQ OLOOKS (\EDITELT LOOKS LOOKNO)))
                                                 PRSTREAM)
                                          (add
 LOOKNO 1)
                                          (DSPYPOSITION
                                           [SETQ CURRENTY
                                            (COND
                                               [(AND (fetch
 (CHARLOOKS CLOFFSET) of
 OLOOKS)
                                                     (NEQ 0 (fetch
 (CHARLOOKS CLOFFSET)
                                                               of
 OLOOKS)))
                                                (IPLUS (fetch
 (LINEDESCRIPTOR YBASE) of

                                                                                         LINE)
                                                       (FIXR (FTIMES STREAMSCALE (fetch

                                                                                  (CHARLOOKS CLOFFSET
                                                                                         )
                                                                                    of
 OLOOKS]
                                               (T (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE]
                                           PRSTREAM)
                                          [COND
                                             ((SETQ KERN (LISTGET (fetch
 (CHARLOOKS CLUSERINFO)
                                                                     of
 OLOOKS)
                                                                'KERN))
                                              (SETQ KERN (FIXR (FTIMES STREAMSCALE KERN]
                                          (STREAMPROP PRSTREAM 'KERN KERN)
                                          (SETQ LOOKSTARTX TX))
                           ((CHARCODE SPACE) 
                                             (* ;; 

               "Space:  Just print it, because we set up the space adjustment to do justification.")


                                                             (* ; 

                                                           "(DSPXPOSITION (IPLUS TX DX) PRSTREAM)")

                                (\OUTCHAR PRSTREAM CH))
                           ((CHARCODE (TAB %#^I)) 
                                                  (* ;; 

                                "TAB: use the width from the cache to decide the right formatting:")


                                [COND
                                   ((OR (IEQP CH (CHARCODE %#^I))
                                        (fetch
 (CHARLOOKS CLLEADER) of
 OLOOKS)
                                        (EQ (fetch
 (CHARLOOKS CLUSERINFO) of
 OLOOKS)
                                            'DOTTEDLEADER))

                                    (* ;; 

                                  "Dotted leaders are meta-TAB, or have the DOTTEDLEADER looks.")


                                    (LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.)
                                                            (FONTCOPY (fetch
 (CHARLOOKS CLFONT)
                                                                         of
 OLOOKS)
                                                                   'DEVICE PRSTREAM)))
                                           (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
                                                                          (IREMAINDER TX DOTWIDTH]
                                          (DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH)
                                                 PRSTREAM)   (* ; 

                                            "Move over to the next even multiple of a dot's width.")

                                          (while
 (ILEQ TTX (IPLUS TX DX))
                                             do
          (* ; 

                                                         "Print enough dots to fill the TAB's gap.")

                                                   (\OUTCHAR PRSTREAM (CHARCODE %.))
                                                   (add
 TTX DOTWIDTH]
                                (DSPXPOSITION (IPLUS TX DX)
                                       PRSTREAM))
                           ((CHARCODE CR) 
                                          (* ;; 

                                        "Do nothing for carriage return, since it ends the line.")


                                NIL)
                           (NIL 
                                (* ;; "Do nothing if it's NIL, which signals a character we deleted during line formatting (e.g., an unused discretionary hyphen)")


                                NIL)
                           (COND
                              [(SMALLP CH)                   (* ; 

                                                           "CH is a char code, just print it")

                               (COND
                                  ((AND (IGEQ CH 192)
                                        (ILEQ CH 207))       (* ; "This is an NS accent character.  Readjust our position with MOVETO, so that the accent overprints the next character.")

                                   (MOVETO (+ TX (RSH (- (\EDITELT WLIST (ADD1 I))
                                                         DX)
                                                      1))
                                          CURRENTY PRSTREAM)
                                   (\OUTCHAR PRSTREAM CH)
                                   (MOVETO TX CURRENTY PRSTREAM)
                                   (SETQ DX 0))
                                  (T (\OUTCHAR PRSTREAM CH]
                              (T                             (* ; "CH is an object.")


                                 (* ;; "Add SETXY command to PRSTREAM,to avoid the XP-9's BUG")


                                 (DSPXPOSITION (IPLUS TX 1)
                                        PRSTREAM)
                                 (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN)
                                        CH PRSTREAM (IMAGESTREAMTYPE PRSTREAM)
                                        TEXTOBJ)
                                 (MOVETO (IPLUS TX DX)
                                        CURRENTY PRSTREAM]
                       (add
 TX DX) finally
 

                                             (* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:")


                                             (\TEDIT.HARDCOPY.MODIFYLOOKS
 LINE LOOKSTARTX TX
                                                    (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                                                    OLOOKS PRSTREAM)
                                             (COND
                                                ((fetch
 (FMTSPEC FMTREVISED)
                                                    of
 (fetch
 (LINEDESCRIPTOR LFMTSPEC)
                                                              of
 LINE))
                                                             (* ; 

                                                     "This paragraph has been revised, so mark it.")

                                                 (\TEDIT.MARK.REVISION TEXTOBJ (fetch

                                                                                (LINEDESCRIPTOR
                                                                                 LFMTSPEC)
                                                                                  of
 LINE)
                                                        PRSTREAM LINE])

(\TEDIT.HARDCOPY.FORMATLINE

  [LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING? PAGEINFO)

                                                             (* ; "Edited 29-Mar-94 17:15 by jds")


(* ;;; "Given a starting place, format the next line of text.  Return T if a control-L was seen on the line.")


    (DECLARE
 (SPECVARS LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST
                        WLIST DEVICE NEWASCENT NEWDESCENT IMAGESTREAM))
    (PROG ((TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
           (CH#B CH#1)
           (CHNO CH#1)
           (LOOKNO 0)
           (GATHERBLANK T)
           (TLEN 0)
           (INVISIBLERUNS 0)
           (DESCENT 0)
           (ASCENT 0)
           (PREVSP 0)
           (%#BLANKS 0)
           (DEVICE IMAGESTREAM)
           (KERN NIL)
           TX DX TXB CH FORCEEND T1SPACE TXB1 DXB LOOK#B FONT FONTWIDTHS TERMSA CLOOKS TEXTSTREAM 
           CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO CTRL\L\SEEN 
           1STLN FMTSPEC NEWASCENT NEWDESCENT PREVHYPH PREVDHYPH ORIGCHLIST ORIGWLIST)

     (* ;; "Variables:")


     (* ;; "(TLEN = Current character count on the line)")


     (* ;; "(CHNO = Current character # in the Text)")


     (* ;; "(DX = width of current char/object)")


     (* ;; "(TX = current right margin) ")


     (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ")


     (* ;; "(CH#B = The CHNO of most recent space/tab)")


     (* ;; "(TXB = right margin of most recent space/tab)")


     (* ;; "(DXB = width of most recent space/tab)")


     (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)")


     (* ;; "(T1SPACE = a space/CR/TAB has been seen)")


     (* ;; "(#BLANKS = # of spaces/tabs seen) ")


     (* ;; "(LOOKNO = Current index into the LOOKS array.  Updated by \TEDIT.LOOKS.UPDATE as characters are read in)")


     (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)")


     (* ;; "(ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential line break point)")


          [SETQ ORIGCHLIST (SETQ CHLIST (fetch
 (ARRAYP BASE) of
 (fetch
 CHARS of

                                                                                         THISLINE]
                                                             (* ; 

                                                           "Place to put character codes/objects")

          [SETQ ORIGWLIST (SETQ WLIST (fetch
 (ARRAYP BASE) of
 (fetch
 (THISLINE WIDTHS)
                                                                         of
 THISLINE]
                                                             (* ; "Place to put width of each item")

          (SETQ LOOKS (fetch
 LOOKS of
 THISLINE))
          (SETQ TEXTSTREAM (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ))
          (SETQ TERMSA (fetch
 (TEXTOBJ TXTTERMSA) of
 TEXTOBJ))
          (replace
 LOOKSUPDATEFN of
 TEXTSTREAM with
 (FUNCTION \TEDIT.HCPYLOOKS.UPDATE))
                                                             (* ; 

            "This gets called every time we cross a piece boundary, to check for changes in looks.")

          (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE with
 TEXTLEN)
                                                             (* ; 

                                                    "Force each new line to find its true CHARLIM.")

          (freplace
 (LINEDESCRIPTOR CHAR1) of
 LINE with
 CH#1)
          (freplace
 (LINEDESCRIPTOR CR\END) of
 LINE with
 NIL)
                                                             (* ; "Assume we won't see a CR.")

          (replace
 (LINEDESCRIPTOR LHASTABS) of
 LINE with
 NIL)
                                                             (* ; "And has no TABs.")

          (replace
 (LINEDESCRIPTOR LSTLN) of
 LINE with
 NIL)
                                                             (* ; 

                        "And assume it isn't the last line in a paragraph until we find otherwise.")

          (replace
 (THISLINE TLFIRSTSPACE) of
 THISLINE with
 0)
                                                             (* ; 

                                   "Start out assuming that all spaces on the line will be scaled.")

          (COND
             [(COND
                 ((AND (ILEQ CH#1 TEXTLEN)
                       (NOT (ZEROP TEXTLEN)))                (* ; 

                                              "Only continue if there's really text we can format.")

                  (\SETUPGETCH CH#1 TEXTOBJ)                 (* ; "Starting place")

                                                             (* ; "And starting character looks")

                  (SETQ CLOOKS (fetch
 (TEXTSTREAM CURRENTLOOKS) of
 TEXTSTREAM))
                  [COND
                     ((fetch
 (CHARLOOKS CLINVISIBLE) of
 CLOOKS)
                                                             (* ; 

       "We've hit a run of invisible characters.  Skip them, and insert a marker in the line cache")

                      (add
 LOOKNO 1)                     (* ; 

                                                           "Fix the counter of charlooks changes")

                      (SETQ PC (fetch
 (TEXTSTREAM PIECE) of
 TEXTSTREAM))
                      (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch
 (PIECE PLEN)
                                                                     of
 PC)))
                      (\RPLPTR CHLIST 0 401)
                      (\RPLPTR WLIST 0 0)
                      (add
 TLEN 1)
                      (SETQ CHLIST (\ADDBASE CHLIST 2))
                      (SETQ WLIST (\ADDBASE WLIST 2))
                      (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC))
                      (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch
 (PIECE PLOOKS)
                                                                   of
 PC)
                                                  PC TEXTOBJ)))
                      [while
 (AND PC (fetch
 (CHARLOOKS CLINVISIBLE) of
 CLOOKS))
                         do
 (\EDITSETA LOOKS LOOKNO (add
 INVISIBLERUNS (fetch

                                                                                (PIECE PLEN)
                                                                                  of
 PC)))
                               (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC))
                               (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch
 (PIECE PLOOKS)
                                                                            of
 PC)
                                                           PC TEXTOBJ]
                      (add
 CHNO (\EDITELT LOOKS LOOKNO))
                      (COND
                         (PC                                 (* ; 

                                                         "Move us to the right place in the stream")

                             (\SETUPGETCH (create
 EDITMARK
                                                 PC _ PC
                                                 PCOFF _ 0
                                                 PCNO _ NIL)
                                    TEXTOBJ))
                         (T                                  (* ; 

            "We've walked off the end of the document.  Just note that we're not at any piece now.")

                            (replace
 (TEXTSTREAM PIECE) of
 TEXTSTREAM with
 NIL]
                  (ILEQ CHNO TEXTLEN)))
              (\TEDIT.HCPYLOOKS.UPDATE
 TEXTSTREAM (fetch
 (TEXTSTREAM PIECE) of
 TEXTSTREAM
                                                             )
                     CLOOKS)
              (SETQ ASCENTB ASCENT)
              (SETQ DESCENTB DESCENT)
              (\EDITSETA LOOKS 0 CLOOKS)                     (* ; "Save looks in the line cache")

              (SETQ FONT (fetch
 (CHARLOOKS CLFONT) of
 CLOOKS))
              [SETQ FONT (COND
                            ((AND (type?
 FONTCLASS FONT)
                                  (FONTCLASSCOMPONENT FONT DEVICE)))
                            (T (FONTCOPY FONT 'DEVICE DEVICE](* ; 

                                                           "Keep the font around for char widths.")

              (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC
 (\TEDIT.APPLY.PARASTYLES
                                                     (OR (fetch
 (TEXTSTREAM CURRENTPARALOOKS)
                                                            of
 TEXTSTREAM)
                                                         (fetch
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ)
                                                         )
                                                     PC TEXTOBJ)
                                   IMAGESTREAM))             (* ; "Paragraph formatting info")

              (COND
                 ((AND (NEQ FMTSPEC *TEDIT-CACHED-FMTSPEC*)
                       (fetch
 (FMTSPEC FMTCHARSTYLES) of
 FMTSPEC))

                  (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.")


                  (SETQ *TEDIT-CURRENTPARA-CACHE* NIL)
                  (SETQ *TEDIT-CACHED-FMTSPEC* FMTSPEC)))
              [SETQ 1STLN (OR (IEQP CH#1 1)
                              (AND (fetch
 (TEXTSTREAM PIECE) of
 TEXTSTREAM)
                                   (fetch
 (PIECE PREVPIECE) of
 (fetch
 (TEXTSTREAM PIECE)
                                                                          of
 TEXTSTREAM))
                                   (fetch
 (PIECE PPARALAST) of
 (fetch
 (PIECE PREVPIECE)
                                                                          of
 (fetch

                                                                                  (TEXTSTREAM PIECE)
                                                                                    of
 TEXTSTREAM
                                                                                  )))
                                   (IEQP (fetch
 (TEXTSTREAM PCSTARTCH) of
 TEXTSTREAM)
                                         (fetch
 (STREAM COFFSET) of
 TEXTSTREAM))
                                   (IEQP (fetch
 (TEXTSTREAM PCSTARTPG) of
 TEXTSTREAM)
                                         (fetch
 (STREAM CPAGE) of
 TEXTSTREAM]
                                                             (* ; 

                                                         "Are we on the first line of a paragraph?")

              (replace
 (LINEDESCRIPTOR 1STLN) of
 LINE with
 1STLN)
              (COND
                 ((AND 1STLN (NOT DOINGHEADING?))            (* ; 

        "This is a new paragraph.  Check for special paragraph types, and handle them accordingly.")

                  (SELECTQ (fetch
 (FMTSPEC FMTPARATYPE) of
 FMTSPEC)
                      (PAGEHEADING                           (* ; "This paragraph is the content for a page heading.  Handle it, then don't bother formatting further.")

                                   (TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO 
                                          IMAGESTREAM)

                                   (* ;; "This will capture the text, and set LINE:CHARLIM to the LAST char# in the page heading.  That lets formatting continue apace.")


                                   (RETURN NIL))
                      (EVEN                                  (* ; "This paragraph may or may not belong here.  If this is an odd page, we don't want to format this paragraph.")

                            (COND
                               ((ODDP (fetch
 (PAGEFORMATTINGSTATE PAGE#) of
 FORMATTINGSTATE))
                                (TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO 
                                       IMAGESTREAM)
                                (RETURN NIL))))
                      (ODD                                   (* ; "This paragraph may or may not belong here.  If this is an even page, we don't want to format this paragraph.")

                           (COND
                              ((EVENP (fetch
 (PAGEFORMATTINGSTATE PAGE#) of
 FORMATTINGSTATE))
                               (TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO 
                                      IMAGESTREAM)
                               (RETURN NIL))))
                      NIL)))
              [SETQ TX (replace
 (LINEDESCRIPTOR LEFTMARGIN) of
 LINE
                          with
 (COND
                                      (1STLN (fetch
 (FMTSPEC 1STLEFTMAR) of
 FMTSPEC))
                                      (T (fetch
 (FMTSPEC LEFTMAR) of
 FMTSPEC]
                                                             (* ; "Set the left margin accordingly")

              [replace
 (LINEDESCRIPTOR RIGHTMARGIN) of
 LINE
                 with
 (SETQ WIDTH (COND
                                         ((NOT (ZEROP (fetch
 (FMTSPEC RIGHTMAR) of
 FMTSPEC)))
                                          (fetch
 (FMTSPEC RIGHTMAR) of
 FMTSPEC))
                                         (T WIDTH]           (* ; 

                                                       "RIGHTMAR = 0 => follow the window's width.")

              (SETQ TXB1 WIDTH)
              (for
 old
 TLEN from
 TLEN to
 511 as
 old
 CHNO from
 CHNO
                 while
 (ILEQ CHNO TEXTLEN) when
 (SETQ CH (\BIN TEXTSTREAM))
                 do
                                      (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)")


                 (* ;; "The character loop")


                 (* ;; "Get the next character for the line.")


                 [SETQ DX (COND
                             ((SMALLP CH)                    (* ; "CH is really a character")

                              (\FGETCHARWIDTH FONT CH))
                             (T                              (* ; "CH is an object")

                                (SETQ BOX (\TEDIT.INTEGER.IMAGEBOX
 (APPLY* (IMAGEOBJPROP
                                                                                CH
                                                                                'IMAGEBOXFN)
                                                                              CH IMAGESTREAM TX WIDTH
                                                                              )))
                                                             (* ; "Get its size")

                                [SETQ ASCENT (IMAX ASCENT (IDIFFERENCE (fetch
 YSIZE of
 BOX)
                                                                 (fetch
 YDESC of
 BOX]
                                (SETQ DESCENT (IMAX DESCENT (fetch
 YDESC of
 BOX)))
                                (IMAGEOBJPROP CH 'BOUNDBOX BOX)
                                (fetch
 XSIZE of
 BOX]
                 (AND KERN (SETQ DX (IPLUS DX KERN)))        (* ; "Get CH's X width.")

                 [SELCHARQ CH
                      (SPACE                                 (* ; 

                                "CH is a <Space>.  Remember it, in case we need to break the line.")

                             (COND
                                (GATHERBLANK (SETQ TXB1 TX)
                                       (SETQ GATHERBLANK NIL)))
                             (SETQ CH#B CHNO)                (* ; 

  "put the location # of the previous space/tab in the character array instead of the space itself")

                             (COND
                                (NEWASCENT 

                                       (* ;; "The ascent/descent changed.  Update the real values, now that we have a character to actually take effect on it")


                                       (SETQ ASCENT (IMAX ASCENT NEWASCENT))
                                       (SETQ DESCENT (IMAX DESCENT NEWDESCENT))
                                       (SETQ NEWASCENT NIL)))
                             (\RPLPTR CHLIST 0 PREVSP)
                             (\RPLPTR WLIST 0 DX)
                             (SETQ PREVSP (ADD1 TLEN))
                             (SETQ PREVHYPH NIL)
                             (SETQ PREVDHYPH NIL)            (* ; 

            "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")

                             (SETQ T1SPACE T)
                             (add
 TX DX)
                             (SETQ TXB TX)
                             (SETQ DXB DX)
                             (SETQ LOOK#B LOOKNO)
                             (SETQ ASCENTB ASCENT)
                             (SETQ DESCENTB DESCENT)
                             (SETQ INVISIBLERUNSB INVISIBLERUNS)
                             (add
 %#BLANKS 1))
                      (CR                                    (* ; 

                                                     "Ch is a <Return>.  Force an end to the line.")

                          (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE with
 CHNO)
                          (COND
                             ((AND NEWASCENT (ZEROP ASCENT)
                                   (ZEROP DESCENT))          (* ; 

                                                           "The ascent has changed;  catch it")

                              (SETQ ASCENT NEWASCENT)
                              (SETQ DESCENT NEWDESCENT)))
                          (SETQ FORCEEND T)
                          (\RPLPTR CHLIST 0 (CHARCODE CR))
                          (\RPLPTR WLIST 0 (SETQ DX 0))
                          (COND
                             (GATHERBLANK (SETQ TXB1 TX)
                                    (SETQ GATHERBLANK NIL)))
                          (SETQ T1SPACE T)
                          (freplace
 (LINEDESCRIPTOR CR\END) of
 LINE with
 T)
                          (SETQ TX (IPLUS TX DX))
                          (replace
 (LINEDESCRIPTOR LSTLN) of
 LINE
                             with
 (fetch
 (PIECE PPARALAST) of
 (fetch
 PIECE
                                                                             of
 TEXTSTREAM)))
                          (SETQ PREVDHYPH NIL)
                          (SETQ PREVHYPH NIL)                (* ; 

            "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")

                          (RETURN))
                      (^L                                    (* ; 

                      "Ch is a <Form Feed> Force an end to the line.  Immediately--just like a CR.")

                          (SETQ CTRL\L\SEEN T)
                          (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE with
 CHNO)
                          (SETQ FORCEEND T)
                          (\RPLPTR CHLIST 0 (CHARCODE CR))
                          (\RPLPTR WLIST 0 (SETQ DX (IMAX DX 6)))
                          (COND
                             (GATHERBLANK (SETQ TXB1 TX)
                                    (SETQ GATHERBLANK NIL)))
                          (SETQ T1SPACE T)
                          (freplace
 (LINEDESCRIPTOR CR\END) of
 LINE with
 T)
                          (SETQ TX (IPLUS TX DX))
                          (replace
 (LINEDESCRIPTOR LSTLN) of
 LINE with
 T)
                          (SETQ PREVDHYPH NIL)
                          (SETQ PREVHYPH NIL)                (* ; 

            "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")

                          (RETURN))
                      (TAB 
                           (* ;; "Try to be reasonable with tabs.  This will create trouble when doing fast-case insert/delete, but Pah! for now.")


                           (\RPLPTR CHLIST 0 CH)             (* ; "TABs are 0 wide to start with.")

                           (replace
 (THISLINE TLFIRSTSPACE) of
 THISLINE with
 TLEN)
                           (COND
                              (NEWASCENT 

                                     (* ;; "The ascent/descent changed.  Update the real values, now that we have a character to actually take effect on it")


                                     (SETQ ASCENT (IMAX ASCENT NEWASCENT))
                                     (SETQ DESCENT (IMAX DESCENT NEWDESCENT))
                                     (SETQ NEWASCENT NIL)))
                           (SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch
 (FMTSPEC TABSPEC)
                                                                          of
 FMTSPEC)
                                                   THISLINE CHLIST WLIST TX
                                                   (FIXR (FTIMES 36.0 (DSPSCALE NIL IMAGESTREAM)))
                                                   0 TABPENDING (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM
                                                                                   ))
                                                                      1)
                                                   NIL))     (* ; 

                           "Figure out which tab stop to use, and what we need to do to get there.")

                           [COND
                              ((FIXP TABPENDING)             (* ; 

                          "If it returns a number, that is the new TX, adjusted for any prior tabs")

                               (SETQ TX TABPENDING)
                               (SETQ TABPENDING NIL))
                              (TABPENDING                    (* ; 

                                                 "Otherwise, look in the PENDINGTAB for the new TX")

                                     (SETQ TX (fetch
 PTNEWTX of
 TABPENDING]
                           (COND
                              (GATHERBLANK (SETQ TXB1 TX)
                                     (SETQ GATHERBLANK NIL)))
                           (SETQ CH#B CHNO)
                           (SETQ DX (\GETBASEPTR WLIST 0))
                           (\TEDIT.PURGE.SPACES (fetch
 CHARS of
 THISLINE)
                                  PREVSP)                    (* ; 

                       "All the spaces before a tab don't take part in justification from here on.")

                           (SETQ %#BLANKS 0)                 (* ; 

 "So we can allocate extra space among the right number of blanks to justify things after the tab.")

                           (SETQ PREVSP 0)
                           (SETQ PREVDHYPH NIL)
                           (SETQ PREVHYPH NIL)               (* ; 

            "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")

                           (SETQ T1SPACE T)
                           (SETQ TX (IPLUS TX DX))
                           (SETQ TXB TX)                     (* ; 

                            "Remember the world in case this is the 'space' before the line breaks")

                           (SETQ DXB DX)
                           (SETQ LOOK#B LOOKNO)
                           (SETQ ASCENTB ASCENT)
                           (SETQ DESCENTB DESCENT)
                           (SETQ INVISIBLERUNSB INVISIBLERUNS))
                      (PROGN (COND
                                ((AND (EQ CH (CHARCODE "0,377"))
                                      (NOT (ffetch
 (TEXTOBJ TXTNONSCHARS) of
 TEXTOBJ)))

                                 (* ;; 

                         "Character-set change character.  This suggests undetected NS characters.")


                                 (\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM)
                                                             (* ; 

                                                  "Leaves us ready to BIN again at the same place.")


                                 (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.")


                                 (SETQ CHLIST (\ADDBASE CHLIST -2))
                                 (SETQ WLIST (\ADDBASE WLIST -2))
                                 (add
 CHNO -1)
                                 (add
 TLEN -1)
                                 (SETQ TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                                                             (* ; 

                             "Because moving to NS characters changes the TEXTLEN for the shorter.")

                                 )
                                (T 
                                   (* ;; "This character isn't special.  Just space over for it.")


                                   (SETQ GATHERBLANK T)
                                   (COND
                                      ((IGREATERP (SETQ TX (IPLUS TX DX))
                                              WIDTH)         (* ; 

                                 "We're past the right margin;  stop formatting at the last blank.")

                                       (SETQ FORCEEND T)
                                       (COND
                                          (PREVDHYPH         (* ; 

                             "There's a hyphen we can break at.  Go back there and break the line.")

                                                 (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE
                                                    with
 CH#B)
                                                 (\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH)
                                                                           1)
                                                        (CHARCODE "-"))
                                                 (\RPLPTR ORIGWLIST (LLSH (SUB1 PREVDHYPH)
                                                                          1)
                                                        (\FGETCHARWIDTH FONT (CHARCODE "-")))
                                                 (SETQ TX TXB)
                                                 (SETQ DX DXB)
                                                 (SETQ ASCENT ASCENTB)
                                                 (SETQ DESCENT DESCENTB)
                                                 (SETQ LOOKNO LOOK#B)
                                                 (SETQ INVISIBLERUNS INVISIBLERUNSB))
                                          (PREVHYPH          (* ; 

                             "There's a hyphen we can break at.  Go back there and break the line.")

                                                 (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE
                                                    with
 CH#B)
                                                 (SETQ TX TXB)
                                                 (SETQ DX DXB)
                                                 (SETQ ASCENT ASCENTB)
                                                 (SETQ DESCENT DESCENTB)
                                                 (SETQ LOOKNO LOOK#B)
                                                 (SETQ INVISIBLERUNS INVISIBLERUNSB))
                                          (T1SPACE           (* ; 

                        "There's a breaking point on this line.  Go back there and break the line.")

                                                 (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE
                                                    with
 CH#B)
                                                 (SETQ TX TXB)
                                                 (SETQ DX DXB)
                                                 (SETQ ASCENT ASCENTB)
                                                 (SETQ DESCENT DESCENTB)
                                                 (SETQ LOOKNO LOOK#B)
                                                 (SETQ INVISIBLERUNS INVISIBLERUNSB))
                                          ((IGREATERP TLEN 0)
                                           (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE
                                              with
 (IMAX CH#1 (SUB1 CHNO)))
                                           (SETQ TX (IDIFFERENCE TX DX))
                                                             (* ; 

                                         "No spaces on this line;  break it before this character.")


                                           (* ;; "Check line break character.")


                                           (while
 (OR (MEMBER (\GETBASEPTR CHLIST -2)
                                                                 TEDIT.DONT.LAST.CHARS)
                                                          (MEMBER CH TEDIT.DONT.BREAK.CHARS))
                                              do
 

                                                    (* ;; 

                                           "This character ch doesn't appear at first of lines. or")


                                                    (* ;; 

                                           "Previous character doesn't appear at the end of lines.")


                                                    (* ;; 

                                                  "So,move previous character to next line.")


                                                    (SETQ CHLIST (\ADDBASE CHLIST -2))
                                                    (SETQ WLIST (\ADDBASE WLIST -2))
                                                    (add
 TLEN -1)
                                                    (add
 CHNO -1)
                                                    (SETQ CH (\GETBASEPTR CHLIST 0)))
                                           (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE
                                              with
 (IMAX (SUB1 CHNO)
                                                             CH#1)))
                                          (T                 (* ; 

                                                  "Can't split BEFORE the first thing on the line!")

                                             (freplace
 (LINEDESCRIPTOR CHARLIM) of
 LINE
                                                with
 CHNO)
                                             (\RPLPTR CHLIST 0 CH)
                                             (\RPLPTR WLIST 0 DX)))
                                       (RETURN))
                                      (T                     (* ; "Not past the rightmargin yet...")

                                         (COND
                                            ((AND NEWASCENT (SMALLP CH))

                                           (* ;; "The ascent/descent changed.  Update the real values, now that we have a character to actually take effect on it")


                                             (SETQ ASCENT (IMAX ASCENT NEWASCENT))
                                             (SETQ DESCENT (IMAX DESCENT NEWDESCENT))
                                             (SETQ NEWASCENT NIL)))
                                         (\RPLPTR CHLIST 0 CH)
                                         (\RPLPTR WLIST 0 DX)(* ; "Check for decimal tabs")

                                         (SELCHARQ CH
                                              (%. (COND
                                                     ((AND TABPENDING (NOT (FIXP TABPENDING))
                                                           (EQ (fetch
 PTTYPE of
 TABPENDING)
                                                               'DECIMAL))
                                                      (add
 (fetch
 (PENDINGTAB PTTABX)
                                                                  of
 TABPENDING)
                                                             DX)
                                                             (* ; 

          "Adjust the pending tab so that the LEFT side of the decimal point goes at the tab stop.")

                                                      (SETQ TABPENDING
                                                       (\TEDIT.FORMATTABS TEXTOBJ (fetch

                                                                                   (FMTSPEC TABSPEC)
                                                                                     of
 FMTSPEC)
                                                              THISLINE CHLIST WLIST TX
                                                              (FIXR (FTIMES 36.0 (DSPSCALE NIL 
                                                                                        IMAGESTREAM))
                                                                    )
                                                              0 TABPENDING
                                                              (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM))
                                                                    1)
                                                              T))
                                                             (* ; 

                           "Figure out which tab stop to use, and what we need to do to get there.")

                                                      [COND
                                                         ((FIXP TABPENDING)
                                                             (* ; 

                          "If it returns a number, that is the new TX, adjusted for any prior tabs")

                                                          (SETQ TX TABPENDING)
                                                          (SETQ TABPENDING NIL))
                                                         (TABPENDING 
                                                             (* ; 

                                                 "Otherwise, look in the PENDINGTAB for the new TX")

                                                                (SETQ TX (fetch
 PTNEWTX
                                                                            of
 TABPENDING]
                                                      (COND
                                                         (GATHERBLANK (SETQ TXB1 TX)
                                                                (SETQ GATHERBLANK NIL)))
                                                      (SETQ CH#B CHNO)
                                                             (* ; "SETQ DX (\GETBASE WLIST 0)")

                                                      (\TEDIT.PURGE.SPACES (fetch
 CHARS
                                                                              of
 THISLINE)
                                                             PREVSP)
                                                             (* ; 

                       "All the spaces before a tab don't take part in justification from here on.")

                                                      (SETQ %#BLANKS 0)
                                                             (* ; 

 "So we can allocate extra space among the right number of blanks to justify things after the tab.")

                                                      (SETQ PREVSP 0)
                                                      (SETQ T1SPACE T)
                                                      (SETQ TXB TX)
                                                             (* ; 

                            "Remember the world in case this is the 'space' before the line breaks")

                                                      (SETQ DXB DX)
                                                      (SETQ LOOK#B LOOKNO)
                                                      (SETQ ASCENTB ASCENT)
                                                      (SETQ DESCENTB DESCENT)
                                                      (SETQ INVISIBLERUNSB INVISIBLERUNS))))
                                              ((- "357,045") (* ; "Hyphen, M-dash")

                                                   (SETQ PREVHYPH (ADD1 TLEN))
                                                   (SETQ PREVDHYPH NIL)
                                                   (SETQ TXB1 (SETQ TXB TX))
                                                   (SETQ DXB DX)
                                                   (SETQ LOOK#B LOOKNO)
                                                   (SETQ CH#B CHNO)
                                                   (SETQ ASCENTB ASCENT)
                                                   (SETQ DESCENTB DESCENT)
                                                   (SETQ INVISIBLERUNSB INVISIBLERUNS))
                                              ("357,042"     (* ; "non-breaking hyphen")

                                                         (\RPLPTR CHLIST 0 (CHARCODE "-")))
                                              ("357,043"     (* ; "Discretionary hyphen")

                                                             (* ; "And isn't actually displayed.")

                                                         (SETQ PREVDHYPH (ADD1 TLEN))
                                                         (SETQ PREVHYPH NIL)
                                                         (SETQ LOOK#B LOOKNO)
                                                         (SETQ CH#B CHNO)
                                                         (SETQ ASCENTB ASCENT)
                                                         (SETQ DESCENTB DESCENT)
                                                         (\RPLPTR WLIST 0 0)
                                                             (* ; 

                                                        "Unless we use it, the prevhyph is 0 wide.")

                                                         (\RPLPTR CHLIST 0 NIL)
                                                         (SETQ TX (IDIFFERENCE TX DX))
                                                         (SETQ DX (\FGETCHARWIDTH FONT (CHARCODE
                                                                                        "-")))
                                                         (SETQ TXB1 (SETQ TXB (IPLUS TX DX)))
                                                         (SETQ DXB DX)
                                                         (SETQ INVISIBLERUNSB INVISIBLERUNS))
                                              ("357,041"     (* ; "non-breaking space.")

                                                         (\RPLPTR CHLIST 0 (CHARCODE SPACE)))
                                              (COND
                                                 ((AND (SMALLP CH)
                                                       (IGEQ CH 192)
                                                       (ILEQ CH 207))
                                                             (* ; "This is an NS accent character.  Space it 0.0 -- SO back TX down by the width of the accent, so it doesn't add to the line width.")

                                                  (SETQ TX (- TX DX]
                 (SETQ CHLIST (\ADDBASE CHLIST 2))           (* ; 

                                                "Move the pointers forward for the next character.")

                 (SETQ WLIST (\ADDBASE WLIST 2)))

(* ;;; "Done processing characters;  the line is now filled.")


              (COND
                 ((AND (IEQP TLEN 255)
                       (ILESSP CHNO TEXTLEN))                (* ; 

                                                         "This line is too long for us to format??")

                  (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T)))
              (COND
                 (TABPENDING                                 (* ; 

                                                       "There is a TAB outstanding.  Go handle it.")

                        (add
 (fetch
 (PENDINGTAB PTTABX) of
 TABPENDING)
                               DX)                           (* ; 

                       "Modify the pending tab so that the LEFT side of the CR is at the tab stop.")

                        (SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch
 (FMTSPEC TABSPEC)
                                                                       of
 FMTSPEC)
                                                THISLINE CHLIST WLIST TX
                                                (FIXR (FTIMES 36.0 (DSPSCALE NIL IMAGESTREAM)))
                                                0 TABPENDING (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM))
                                                                   1)
                                                T))
                        (SETQ TX TABPENDING)
                        (SETQ TABPENDING NIL)
                        (\TEDIT.PURGE.SPACES (fetch
 CHARS of
 THISLINE)
                               PREVSP)
                        (SETQ PREVSP 0]
             (T                                              (* ; 

             "No text to go in this line;  set Ascent/Descent to the default font from the window.")

                (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC
 (fetch
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ)))
                (\EDITSETA LOOKS 0 CLOOKS)
                [SETQ 1STLN (AND (fetch
 (STREAM F5) of
 TEXTSTREAM)
                                 (fetch
 (PIECE PREVPIECE) of
 (fetch
 (STREAM F5)
                                                                        of
 TEXTSTREAM))
                                 (fetch
 (PIECE PPARALAST) of
 (fetch
 (PIECE PREVPIECE)
                                                                        of
 (fetch

                                                                                (STREAM F5)
                                                                                  of
 TEXTSTREAM))
                                        )
                                 (IEQP (fetch
 (STREAM FW6) of
 TEXTSTREAM)
                                       (fetch
 (STREAM CPAGE) of
 TEXTSTREAM))
                                 (IEQP (fetch
 (STREAM FW7) of
 TEXTSTREAM)
                                       (fetch
 (STREAM COFFSET) of
 TEXTSTREAM]
                (replace
 (LINEDESCRIPTOR 1STLN) of
 LINE with
 1STLN)
                [SETQ TX (SETQ TXB (replace
 (LINEDESCRIPTOR LEFTMARGIN) of
 LINE
                                      with
 (COND
                                                  (1STLN (fetch
 (FMTSPEC 1STLEFTMAR) of

                                                                                         FMTSPEC))
                                                  (T (fetch
 (FMTSPEC LEFTMAR) of
 FMTSPEC]
                [replace
 (LINEDESCRIPTOR RIGHTMARGIN) of
 LINE
                   with
 (SETQ WIDTH (COND
                                           ((NOT (ZEROP (fetch
 (FMTSPEC RIGHTMAR) of
 FMTSPEC)
                                                        ))
                                            (fetch
 (FMTSPEC RIGHTMAR) of
 FMTSPEC))
                                           (T WIDTH]
                (SETQ TXB1 WIDTH)))
          [COND
             ((ZEROP (freplace
 (LINEDESCRIPTOR LHEIGHT) of
 LINE with
 (IPLUS ASCENT 
                                                                                        DESCENT)))
              (replace
 (LINEDESCRIPTOR LHEIGHT) of
 LINE
                 with
 (FONTPROP (OR (AND (fetch
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ)
                                             (fetch
 (CHARLOOKS CLFONT) of
 (fetch

                                                                                   (TEXTOBJ 
                                                                                     DEFAULTCHARLOOKS
                                                                                          )
                                                                                     of
 TEXTOBJ))
                                             )
                                        DEFAULTFONT)
                                 'HEIGHT]                    (* ; 

                                                          "Line's height (or 12 for an empty line)")

          (replace
 (LINEDESCRIPTOR ASCENT) of
 LINE with
 ASCENT)
          (replace
 (LINEDESCRIPTOR DESCENT) of
 LINE with
 DESCENT)
          (freplace
 (LINEDESCRIPTOR CHARTOP) of
 LINE with
 CHNO)
          (COND
             (FORCEEND NIL)
             (T (SETQ CHNO (SUB1 CHNO))
                (SETQ TLEN (SUB1 TLEN))
                (SETQ TXB1 TX)))                             (* ; 

                        "If we ran off the end of the text, then keep true space left on the line.")

          (freplace
 (LINEDESCRIPTOR LXLIM) of
 LINE with
 TX)
          (freplace
 DESC of
 THISLINE with
 LINE)
          [freplace
 (THISLINE LEN) of
 THISLINE
             with
 (IMIN 254 (COND
                                   ((ILESSP TEXTLEN CH#1)
                                    -1)
                                   (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch
 (LINEDESCRIPTOR
                                                                                   CHARLIM)
                                                                          of
 LINE)
                                                                       TEXTLEN)
                                                           (IPLUS INVISIBLERUNS (fetch

                                                                                 (LINEDESCRIPTOR
                                                                                  CHAR1) of

                                                                                         LINE]
          (freplace
 (LINEDESCRIPTOR SPACELEFT) of
 LINE with
 (IDIFFERENCE WIDTH TXB1))
          (\DOFORMATTING.HARDCOPY
 TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN)
          (replace
 (LINEDESCRIPTOR LFMTSPEC) of
 LINE with
 FMTSPEC)
          (replace
 LOOKSUPDATEFN of
 TEXTSTREAM with
 NIL)
          (RETURN CTRL\L\SEEN])

(\DOFORMATTING.HARDCOPY

  [LAMBDA (TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN)

                                                             (* ; "Edited 29-Mar-94 16:30 by jds")

                                                             (* ; 

                                      "Do the formatting work for justified, centered, etc.  lines")

    (PROG ((QUAD (fetch
 QUAD of
 FMTSPEC))
           (SPACELEFT (fetch
 (LINEDESCRIPTOR SPACELEFT) of
 LINE))
           (EXISTINGSPACE 0)
           (CHLIST (fetch
 (THISLINE CHARS) of
 THISLINE))
           (WLIST (fetch
 (THISLINE WIDTHS) of
 THISLINE))
           (SPACEOFLOW 0)
           EXTRASP OPREVSP LINELEAD)                         (* ; 

                  "NB that SPACELEFT, OFLOW, etc.  are kept in 32 x value form, for rounding ease.")

          (replace
 (LINEDESCRIPTOR LTRUEDESCENT) of
 LINE with
 (fetch
 (LINEDESCRIPTOR
                                                                                      DESCENT)
                                                                             of
 LINE))
          (replace
 (LINEDESCRIPTOR LTRUEASCENT) of
 LINE with
 (fetch
 (LINEDESCRIPTOR
                                                                                     ASCENT)
                                                                            of
 LINE))
                                                             (* ; 

                                                  "Save the true ascent value for display purposes")

          (replace
 (THISLINE TLSPACEFACTOR) of
 THISLINE with
 1)
                                                             (* ; 

                                             "Start by assuming that we want a space factor of 1.0")

          [COND
             ((SETQ LINELEAD (fetch
 LINELEAD of
 FMTSPEC))
                                                             (* ; 

                                                           "If line leading was specified, set it")

              (COND
                 (T (add
 (fetch
 (LINEDESCRIPTOR LHEIGHT) of
 LINE)
                           (fetch
 LINELEAD of
 FMTSPEC))
                                                             (* ; 

                                                        "And adjust the line's descent accordingly")

                    (add
 (fetch
 (LINEDESCRIPTOR DESCENT) of
 LINE)
                           (fetch
 LINELEAD of
 FMTSPEC]
          [COND
             ((AND 1STLN (fetch
 LEADBEFORE of
 FMTSPEC))
                                                             (* ; 

                                                   "If paragraph pre-leading was specified, set it")

              (add
 (fetch
 (LINEDESCRIPTOR LHEIGHT) of
 LINE)
                     (fetch
 LEADBEFORE of
 FMTSPEC))  (* ; 

                                                        "And adjust the line's ascent accordingly.")

              (add
 (fetch
 (LINEDESCRIPTOR ASCENT) of
 LINE)
                     (fetch
 LEADBEFORE of
 FMTSPEC]
          [COND
             ((AND (fetch
 (LINEDESCRIPTOR LSTLN) of
 LINE)
                   (fetch
 LEADAFTER of
 FMTSPEC))     (* ; 

                                                   "If paragraph pre-leading was specified, set it")

              (add
 (fetch
 (LINEDESCRIPTOR LHEIGHT) of
 LINE)
                     (fetch
 LEADAFTER of
 FMTSPEC))   (* ; 

                                                        "And adjust the line's ascent accordingly.")

              (add
 (fetch
 (LINEDESCRIPTOR DESCENT) of
 LINE)
                     (fetch
 LEADAFTER of
 FMTSPEC]
          (SELECTQ QUAD
              (LEFT                                          (* ; 

                           "Do nothing for left-justified lines except replace the character codes")
)
              (RIGHT                                         (* ; "Just move the right margin over")

                     (replace
 (LINEDESCRIPTOR LEFTMARGIN) of
 LINE
                        with
 (IPLUS (fetch
 (LINEDESCRIPTOR LEFTMARGIN) of
 LINE)
                                        (fetch
 (LINEDESCRIPTOR SPACELEFT) of
 LINE)))
                     (replace
 (LINEDESCRIPTOR LXLIM) of
 LINE with
 (fetch
 (
                                                                                       LINEDESCRIPTOR
                                                                                          RIGHTMARGIN
                                                                                          )
                                                                                 of
 LINE))
                     (COND
                        ((OR (ILESSP (fetch
 (THISLINE LEN) of
 THISLINE)
                                    0)
                             (ZEROP %#BLANKS)
                             (ZEROP PREVSP))                 (* ; 

                     "For empty lines, and lines with no spaces, don't bother fixing blank widths.")

                         (RETURN))))
              (CENTERED                                      (* ; 

                                                           "Split the difference for centering")

                        (add
 (fetch
 (LINEDESCRIPTOR LEFTMARGIN) of
 LINE)
                               (LRSH SPACELEFT 1))
                        (add
 (fetch
 (LINEDESCRIPTOR LXLIM) of
 LINE)
                               (LRSH SPACELEFT 1))
                        (COND
                           ((OR (ILESSP (fetch
 (THISLINE LEN) of
 THISLINE)
                                       0)
                                (ZEROP %#BLANKS)
                                (ZEROP PREVSP))              (* ; 

                     "For empty lines, and lines with no spaces, don't bother fixing blank widths.")

                            (RETURN))))
              (JUSTIFIED                                     (* ; 

                         "For justified lines, stretch each space so line reaches the right margin")

                         (COND
                            ((OR (ILESSP (fetch
 (THISLINE LEN) of
 THISLINE)
                                        0)
                                 (ZEROP %#BLANKS)
                                 (ZEROP PREVSP))             (* ; 

                     "For empty lines, and lines with no spaces, don't bother fixing blank widths.")

                             (RETURN)))
                         (COND
                            ((OR (fetch
 (LINEDESCRIPTOR CR\END) of
 LINE)
                                 (IGEQ (fetch
 (LINEDESCRIPTOR CHARLIM) of
 LINE)
                                       (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)))
                                                             (* ; 

                                   "This is the last line in the paragraph;  don't stretch it out.")

                             (SETQ EXTRASP 0))
                            ((IEQP PREVSP (ADD1 (fetch
 (THISLINE LEN) of
 THISLINE)))
                                                             (* ; 

 "Only if the last character on the line is a space should we remove trailing spaces from the list")

                             (bind
 (OPREVSP _ (SUB1 PREVSP)) while
 (AND (IGREATERP PREVSP 0)
                                                                                (ILEQ OPREVSP PREVSP)
                                                                                )
                                do
 

                                 (* ;; "Back up over all trailing white space on the line.  So that those blanks don't get counted when computing the space to be added to each REAL space on the line, when it is justified.")


                                      (SETQ OPREVSP (SUB1 PREVSP))
                                      (SETQ PREVSP (\EDITELT CHLIST OPREVSP))
                                      (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE)))
                                      (add
 %#BLANKS -1))
                             (COND
                                ((ZEROP %#BLANKS)            (* ; 

                    "If there aren't any blanks except at end-of-line, don't bother going further.")

                                 (RETURN)))
                             (replace
 (LINEDESCRIPTOR LXLIM) of
 LINE
                                with
 (fetch
 (LINEDESCRIPTOR RIGHTMARGIN) of
 LINE))
                                                             (* ; 

                                                   "Fix the right margin for showing selections &c")

                             (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS))
                                                             (* ; 

                                               "Now apportion the extra space evenly among blanks.")

                             )
                            (T 
                               (* ;; 

        "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.")


                               (COND
                                  ((ZEROP %#BLANKS)          (* ; 

                    "If there aren't any blanks except at end-of-line, don't bother going further.")

                                   (RETURN)))
                               (replace
 (LINEDESCRIPTOR LXLIM) of
 LINE
                                  with
 (fetch
 (LINEDESCRIPTOR RIGHTMARGIN) of
 LINE))
                                                             (* ; 

                                                   "Fix the right margin for showing selections &c")

                               (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS))
                                                             (* ; 

                                               "Now apportion the extra space evenly among blanks.")

                               ))
                         (bind
 (SP _ PREVSP) while
 (IGREATERP SP 0)
                            do
                           (* ; 

                                                          "Fix up the widths of spaces in the line")

                                  (SETQ OPREVSP (SUB1 SP))
                                  (SETQ SP (\EDITELT CHLIST OPREVSP))
                                  (add
 EXISTINGSPACE (\EDITELT WLIST OPREVSP)))
                         [while
 (IGREATERP PREVSP 0)
                            do
                           (* ; 

                                                          "Fix up the widths of spaces in the line")

                                  (SETQ OPREVSP (SUB1 PREVSP))
                                  (SETQ PREVSP (\EDITELT CHLIST OPREVSP))
                                  (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE)))
                                  (OR (fetch
 (LINEDESCRIPTOR CR\END) of
 LINE)
                                      (\EDITSETA WLIST OPREVSP (FIXR (FTIMES (\EDITELT WLIST OPREVSP)
                                                                            (FPLUS 1.0
                                                                                   (FQUOTIENT 
                                                                                          SPACELEFT 
                                                                                        EXISTINGSPACE
                                                                                          ]
                         (COND
                            ((AND (NOT (ZEROP EXISTINGSPACE))
                                  (NOT (ZEROP EXTRASP)))     (* ; "Only if we really expanded the line -- and there are spaces to expand (or else EXISTINGSPACE is 0).")

                             (replace
 (THISLINE TLSPACEFACTOR) of
 THISLINE
                                with
 (FQUOTIENT (IPLUS EXISTINGSPACE (fetch
 (LINEDESCRIPTOR
                                                                                     SPACELEFT)
                                                                            of
 LINE))
                                                EXISTINGSPACE))
                                                             (* ; 

                                                           "And set the space factor for display")

                             )
                            (T                               (* ; "Pathological cases ")

                               (replace
 (THISLINE TLSPACEFACTOR) of
 THISLINE with
 1)))
                         (RETURN))
              NIL)
          (\TEDIT.PURGE.SPACES CHLIST PREVSP)                (* ; 

"Change all the spaces--chained for justification--back into regular spaces, for the display code.")

      ])

(\TEDIT.HARDCOPY.MODIFYLOOKS

  [LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM)
         (* ; "Edited 30-May-91 21:17 by jds")


    (* ;; "Do underlining, overlining, etc.  for hardcopy files")


    [PROG ((STREAMSCALE (DSPSCALE NIL PRSTREAM))
           [RULEWIDTH (FIXR (FTIMES 0.75 (DSPSCALE NIL PRSTREAM]
           (ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM)))
           YOFFSET)
          (COND
             ((fetch
 (CHARLOOKS CLULINE) of
 LOOKS)   (* ; "It's underlined.")

              (DRAWLINE STARTX (IDIFFERENCE (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                                      (fetch
 (LINEDESCRIPTOR LTRUEDESCENT) of
 LINE))
                     CURX
                     (IDIFFERENCE (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                            (fetch
 (LINEDESCRIPTOR LTRUEDESCENT) of
 LINE))
                     RULEWIDTH
                     'PAINT PRSTREAM)                        (* ; "A 1/2-pt underline")

              ))
          (COND
             ((fetch
 (CHARLOOKS CLOLINE) of
 LOOKS)   (* ; "Over-line")

              (DRAWLINE STARTX (IPLUS (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                                      (fetch
 (LINEDESCRIPTOR LTRUEASCENT) of
 LINE))
                     CURX
                     (IPLUS (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                            (fetch
 (LINEDESCRIPTOR LTRUEASCENT) of
 LINE))
                     RULEWIDTH
                     'PAINT PRSTREAM)))
          (COND
             ((fetch
 (CHARLOOKS CLSTRIKE) of
 LOOKS)  (* ; "Struch-thru")

              (DRAWLINE STARTX (SETQ YOFFSET (IPLUS (fetch
 (LINEDESCRIPTOR YBASE) of
 LINE)
                                                    (IQUOTIENT
                                                     [FIXR (FTIMES STREAMSCALE
                                                                  (FONTPROP (fetch
 (CHARLOOKS
                                                                                        CLFONT)
                                                                               of
 LOOKS)
                                                                         'ASCENT]
                                                     3)))
                     CURX YOFFSET RULEWIDTH 'PAINT PRSTREAM]
    (MOVETO CURX CURY PRSTREAM])

(\TEDIT.HCPYLOOKS.UPDATE

  [LAMBDA (STREAM PC NLOOKS)
                  (* ; 

                                                "Edited  3-Jul-93 20:12 by sybalskY:MV:ENVOS")


    (* ;; "At a piece boundary, update the line formatting fields ASCENT, DESCENT, and FONTWIDTHS")


    (* ;; "Also, KERN, if USERPROPS has a KERN entry.")


    (DECLARE
 (USEDFREE LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST
                        WLIST DEVICE NEWASCENT NEWDESCENT KERN IMAGESTREAM))
    (COND
       (PC (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
                  TLOOKS TEMP NEWPC OFFSET PARALOOKS PREVPC NEWKERN)
                 [COND
                    ([OR (NOT (fetch
 (PIECE PREVPIECE) of
 PC))
                         (NEQ (fetch
 (PIECE PPARALOOKS) of
 PC)
                              (fetch
 (PIECE PPARALOOKS) of
 (fetch
 (PIECE PREVPIECE)
                                                                      of
 PC]
                                                             (* ; 

"The paragraph looks have changed between the last piece and this one.  Take account of the change")

                     (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch
 (PIECE PPARALOOKS)
                                                                 of
 PC)
                                            PC TEXTOBJ))
                     (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with
 PARALOOKS))
                    (T (SETQ PARALOOKS (fetch
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM]
                 (SETQ TLOOKS (OR NLOOKS (\TEDIT.APPLY.STYLES (ffetch
 (PIECE PLOOKS) of

                                                                                         PC)
                                                PC TEXTOBJ)))
                 (COND
                    ((fetch
 (CHARLOOKS CLINVISIBLE) of
 TLOOKS)
                                                             (* ; 

       "We've hit a run of invisible characters.  Skip them, and insert a marker in the line cache")

                     (add
 LOOKNO 1)                      (* ; 

                                                           "Fix the counter of charlooks changes")

                     (\EDITSETA LOOKS LOOKNO (fetch
 (PIECE PLEN) of
 PC))
                     (\RPLPTR CHLIST 0 LMInvisibleRun)
                     (\RPLPTR WLIST 0 0)
                     (add
 TLEN 1)
                     (SETQ CHLIST (\ADDBASE CHLIST 2))
                     (SETQ WLIST (\ADDBASE WLIST 2))
                     (SETQ PREVPC PC)
                     (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC))
                     (COND
                        ((NEQ (fetch
 (PIECE PPARALOOKS) of
 PC)
                              (fetch
 (PIECE PPARALOOKS) of
 PREVPC))
                         (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch
 (PIECE PPARALOOKS)
                                                                     of
 PC)
                                                PC TEXTOBJ))
                         (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with
 PARALOOKS)
                         ))
                     (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch
 (PIECE PLOOKS)
                                                                  of
 PC)
                                                 PC TEXTOBJ)))
                     [while
 (AND PC (OR (ZEROP (fetch
 (PIECE PLEN) of
 PC))
                                            (fetch
 (CHARLOOKS CLINVISIBLE) of
 TLOOKS)))
                        do
 (\EDITSETA LOOKS LOOKNO (IPLUS (fetch
 (PIECE PLEN) of
 PC)
                                                              (\EDITELT LOOKS LOOKNO)))
                              (SETQ PREVPC PC)
                              (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC))
                              (COND
                                 ((AND PC (NEQ (fetch
 (PIECE PPARALOOKS) of
 PC)
                                               (fetch
 (PIECE PPARALOOKS) of
 PREVPC)))
                                                             (* ; 

   "If there IS new text, and the paragraph looks have changed, update the streams notion of them.")

                                  (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch
 (PIECE 
                                                                                           PPARALOOKS
                                                                                             )
                                                                              of
 PC)
                                                         PC TEXTOBJ))
                                                             (* ; 

                                                        "And take care of style sheets on the way.")

                                  (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM
                                     with
 PARALOOKS)))
                              (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch
 (PIECE PLOOKS)
                                                                           of
 PC)
                                                          PC TEXTOBJ]
                     (add
 CHNO (\EDITELT LOOKS LOOKNO))
                     (add
 INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
                     (SETQ NEWPC PC)))
                 (COND
                    ([AND PC (OR NLOOKS (NOT (EQCLOOKS TLOOKS (fetch
 (TEXTSTREAM CURRENTLOOKS)
                                                                 of
 STREAM]
                     (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM with
 TLOOKS)
                     (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with
 PARALOOKS)
                     (SETQ FONT (fetch
 (CHARLOOKS CLFONT) of
 TLOOKS))
                     [SETQ FONT (COND
                                   ((AND (type?
 FONTCLASS FONT)
                                         (FONTCLASSCOMPONENT FONT DEVICE)))
                                   (T (FONTCOPY FONT 'DEVICE DEVICE]
                     (SETQ OFFSET (OR [AND (fetch
 (CHARLOOKS CLOFFSET) of
 TLOOKS)
                                           (FIXR (FTIMES (DSPSCALE NIL DEVICE)
                                                        (fetch
 (CHARLOOKS CLOFFSET) of
 TLOOKS
                                                               ]
                                      0))
                     (SETQ NEWASCENT (IMAX ASCENT (IPLUS (fetch
 \SFAscent of
 FONT)
                                                         OFFSET)))
                     (SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (fetch
 \SFDescent of
 FONT)
                                                           OFFSET)))
                     (SETQ NEWKERN (LISTGET (fetch
 (CHARLOOKS CLUSERINFO) of
 TLOOKS)
                                          'KERN))
                     (COND
                        [NEWKERN (SETQ KERN (FIXR (FTIMES (DSPSCALE NIL DEVICE)
                                                         NEWKERN]
                        (T (SETQ KERN NIL)))
                     (COND
                        ((NOT NLOOKS)

                         (* ;; "If we're calling this to initialize values, don't go and update the running cache.  However, since NLOOKS is NIL, we're not initializing, so go to it!")


                         (add
 LOOKNO 1)                  (* ; 

                                                           "Fix the counter of charlooks changes")

                         (\EDITSETA LOOKS LOOKNO TLOOKS)     (* ; 

                                                         "Save the new looks for selection/display")

                         (\RPLPTR CHLIST 0 LMLooksChange)    (* ; 

                                      "Put a marker in the character list to denote a looks change")

                         (\RPLPTR WLIST 0 0)                 (* ; "Font changes have no width")

                         (add
 TLEN 1)
                         (SETQ CHLIST (\ADDBASE CHLIST 2))
                         (SETQ WLIST (\ADDBASE WLIST 2))     (* ; 

                                                       "Account for the dummy marker/looks in TLEN")

                         ))
                     (SETQ NEWPC PC))
                    ((NOT (OR PC NLOOKS))                    (* ; 

"We have run off the end of the document.  Bail out so that \TEDIT.HARDCOPY.FORMATLINE doesn't die")

                     (RETFROM '\BIN NIL)))
                 (OR NEWPC (SETQ NEWPC PC))
                 [COND
                    ((AND (fetch
 (PIECE POBJ) of
 NEWPC)
                          (NEQ (fetch
 (PIECE PLEN) of
 NEWPC)
                               1))                           (* ; 

                                      "If this piece is for an object, check for a length mismatch")

                     (COND
                        ((IMAGEOBJPROP (fetch
 (PIECE POBJ) of
 NEWPC)
                                'SUBSTREAM))
                        (T 
                           (* ;; "The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from.  Build an invisible run to fill the space.")


                           (add
 LOOKNO 1)                (* ; 

                                                           "Fix the counter of charlooks changes")

                           (\EDITSETA LOOKS LOOKNO (SUB1 (fetch
 (PIECE PLEN) of
 PC)))
                           (\RPLPTR CHLIST 0 LMInvisibleRun) (* ; 

                                       "Note the existence of an invisible run of characters here.")

                           (\RPLPTR WLIST 0 0)
                           (add
 TLEN 1)
                           (SETQ CHLIST (\ADDBASE CHLIST 2))
                           (SETQ WLIST (\ADDBASE WLIST 2))
                           (add
 CHNO (\EDITELT LOOKS LOOKNO))
                           (add
 INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
                                                             (* ; 

                                              "Keep track of how much invisible text we cross over")

                           ]
                 (RETURN NEWPC])

(\TEDIT.HCPYFMTSPEC

  [LAMBDA (SPEC IMAGESTREAM)
                             (* ; "Edited 30-May-91 21:18 by jds")


    (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent.  (Special positions are made paper-relative first.)")


    (PROG ((SCALEFACTOR (DSPSCALE NIL IMAGESTREAM)))
          (RETURN (create
 FMTSPEC using

                                      SPEC 1STLEFTMAR _ (FIXR (FTIMES (fetch
 (FMTSPEC 1STLEFTMAR)
                                                                         of
 SPEC)
                                                                     SCALEFACTOR))
                                      LEFTMAR _ (FIXR (FTIMES (fetch
 (FMTSPEC LEFTMAR)
                                                                 of
 SPEC)
                                                             SCALEFACTOR))
                                      RIGHTMAR _ (FIXR (FTIMES (fetch
 (FMTSPEC RIGHTMAR)
                                                                  of
 SPEC)
                                                              SCALEFACTOR))
                                      LEADBEFORE _ (FIXR (FTIMES (fetch
 (FMTSPEC LEADBEFORE)
                                                                    of
 SPEC)
                                                                SCALEFACTOR))
                                      LEADAFTER _ (FIXR (FTIMES (fetch
 (FMTSPEC LEADAFTER)
                                                                   of
 SPEC)
                                                               SCALEFACTOR))
                                      LINELEAD _ (FIXR (FTIMES (fetch
 (FMTSPEC LINELEAD)
                                                                  of
 SPEC)
                                                              SCALEFACTOR))
                                      FMTBASETOBASE _ (AND (fetch
 (FMTSPEC FMTBASETOBASE)
                                                              of
 SPEC)
                                                           (FIXR (FTIMES (fetch
 (FMTSPEC 
                                                                                        FMTBASETOBASE
                                                                                           )
                                                                            of
 SPEC)
                                                                        SCALEFACTOR)))
                                      QUAD _ (fetch
 (FMTSPEC QUAD) of
 SPEC)
                                      TABSPEC _
                                      [CONS (AND (CAR (fetch
 (FMTSPEC TABSPEC) of
 SPEC))
                                                 (FIXR (FTIMES (CAR (fetch
 (FMTSPEC TABSPEC)
                                                                       of
 SPEC))
                                                              SCALEFACTOR)))
                                            (for
 TAB in
 (CDR (fetch
 (FMTSPEC TABSPEC)
                                                                        of
 SPEC))
                                               collect
 (CONS (FIXR (FTIMES SCALEFACTOR
                                                                              (CAR TAB)))
                                                                 (CDR TAB]
                                      FMTSPECIALX _ (AND (fetch
 (FMTSPEC FMTSPECIALX)
                                                            of
 SPEC)
                                                         (FIXR (FTIMES (SCALEPAGEUNITS
                                                                        (fetch
 (FMTSPEC 
                                                                                          FMTSPECIALX
                                                                                          )
                                                                           of
 SPEC)
                                                                        1.0 NIL)
                                                                      SCALEFACTOR)))
                                      FMTSPECIALY _ (AND (fetch
 (FMTSPEC FMTSPECIALY)
                                                            of
 SPEC)
                                                         (FIXR (FTIMES (SCALEPAGEUNITS
                                                                        (fetch
 (FMTSPEC 
                                                                                          FMTSPECIALY
                                                                                          )
                                                                           of
 SPEC)
                                                                        1.0 NIL)
                                                                      SCALEFACTOR])

(\TEDIT.INTEGER.IMAGEBOX

  (LAMBDA (OLDBOX)
                                           (* jds "23-Oct-84 13:52")

          
          (* Take an IMAGEBOX, and assure that its contents are integers)


    (replace
 XKERN of
 OLDBOX with
 (FIXR (fetch
 XKERN of
 OLDBOX)))
    (replace
 YDESC of
 OLDBOX with
 (FIXR (fetch
 YDESC of
 OLDBOX)))
    (replace
 YSIZE of
 OLDBOX with
 (FIXR (fetch
 YSIZE of
 OLDBOX)))
    (replace
 XSIZE of
 OLDBOX with
 (FIXR (fetch
 XSIZE of
 OLDBOX)))
    OLDBOX))
)



(* ;; "Functions for scaling distances and regions as needed during hardcopy.")


(DEFINEQ

(\TEDIT.SCALE

  [LAMBDA (VALUE SCALEFACTOR)
                                (* ; "Edited  2-Jan-87 12:11 by jds")


(* ;;; "Scale VALUE by SCALEFACTOR, and round it to the nearest integer.  Used for scaling distances, etc. during hardcopy.")


    (FIXR (FTIMES VALUE SCALEFACTOR])

(\TEDIT.SCALEREGION

  [LAMBDA (REGION SCALEFACTOR)
                               (* ; "Edited  2-Jan-87 12:13 by jds")


(* ;;; "Scale the region REGION by SCALEFACTOR, rounding all the dimensions to integers.  Used to scale page-boundary regions during hardcopy.")


    (create
 REGION
           LEFT _ (\TEDIT.SCALE
 (fetch
 (REGION LEFT) of
 REGION)
                         SCALEFACTOR)
           BOTTOM _ (\TEDIT.SCALE
 (fetch
 (REGION BOTTOM) of
 REGION)
                           SCALEFACTOR)
           WIDTH _ (\TEDIT.SCALE
 (fetch
 (REGION WIDTH) of
 REGION)
                          SCALEFACTOR)
           HEIGHT _ (\TEDIT.SCALE
 (fetch
 (REGION HEIGHT) of
 REGION)
                           SCALEFACTOR])
)



(* ;; "PRESS-specific code")



(RPAQ TEDIT.DEFAULTPAGEREGION
 (CREATEREGION 2794 1905 16256 23495))



(* ; "0.75 inches from bottom, 1 from top")





(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")


(DEFINEQ

(TEDIT.HARDCOPYFN

  [LAMBDA (WINDOW IMAGESTREAM)
                          (* ; "Edited 12-Jun-90 18:35 by mitani")


    (* ;; 

 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")


    (PROG ((TEXTOBJ (TEXTOBJ WINDOW))
           (TEXTSTREAM (TEXTSTREAM WINDOW)))

     (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it.  Please don't remove this binding!")


          (RESETLST
              [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
                     '(AND (\TEDIT.MARKINACTIVE OLDVALUE]
              (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 'Hardcopy)
              (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM)))  (* ; "Build the hardcopy")

    ])

(\TEDIT.HARDCOPY

  [LAMBDA (FILE PFILE)
                                  (* ; "Edited 12-Jun-90 18:35 by mitani")


    (* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).")


    (CL:WITH-OPEN-STREAM [TEXT-STREAM (OPENTEXTSTREAM (COND
                                                         ((STRINGP FILE)
                                                          (MKATOM FILE))
                                                         (T FILE]
           (RESETLST
               [RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ TEXT-STREAM))
                      '(AND (\TEDIT.MARKINACTIVE OLDVALUE]
               [RESETSAVE NIL `(AND (CLOSEF? ',PFILE]
               (replace
 (TEXTOBJ EDITOPACTIVE) of
 (TEXTOBJ TEXT-STREAM) with
 'Hardcopy)
               (TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'INTERPRESS)
               PFILE)])

(\TEDIT.PRESS.HARDCOPY

  [LAMBDA (FILE PFILE)
                                  (* ; "Edited 12-Jun-90 18:36 by mitani")

                                                             (* Send the text to the printer.)

    [SETQ FILE (OPENTEXTSTREAM (COND
                                  ((STRINGP FILE)
                                   (MKATOM FILE))
                                  (T FILE]
    (RESETLST
        [RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ FILE))
               '(AND (\TEDIT.MARKINACTIVE OLDVALUE]
        (replace
 (TEXTOBJ EDITOPACTIVE) of
 (TEXTOBJ FILE) with
 'Hardcopy)
        (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'PRESS)
        (CLOSEF? PFILE)
        PFILE)])
)

(LISTPUT (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE INTERPRESS) PRINTFILETYPES)) (QUOTE TEDIT) (FUNCTION \TEDIT.HARDCOPY))

(LET ((PRESSVALUES (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE PRESS) PRINTFILETYPES)))) (COND (PRESSVALUES (* ; "Only install PRESS printing if PRESS is loaded.") (LISTPUT PRESSVALUES (QUOTE TEDIT) (FUNCTION \TEDIT.PRESS.HARDCOPY)))))



(* ;; "vars for Japanese Line Break")



(RPAQQ TEDIT.DONT.BREAK.CHARS
 (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539 9571 9573 9575 9582)
)

(RPAQQ TEDIT.DONT.LAST.CHARS
 (8524 8538 8536 8534))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
)



(* ;; "Support for hardcopying several files as one document")


(DEFINEQ

(TEDIT-BOOK

  [LAMBDA (FILES DIRECTORY PRINT-FILE DONT-SEND)
         (* ; "Edited 22-Mar-93 23:55 by jds")

    (LET ((DOC (OPENTEXTSTREAM (MKATOM (CAR FILES))
                      NIL)))

         (* ;; "Gather all the files into one document:")


         (for
 FILE in
 (CDR FILES) do
 (TEDIT.SETSEL DOC 1 (fetch
 (TEXTOBJ TEXTLEN)
                                                                        of
 (TEXTOBJ DOC))
                                                        'RIGHT NIL NIL)
                                                (TEDIT.INCLUDE DOC (PACK* (OR DIRECTORY "")
                                                                          FILE)))
                                                             (* ; "Set page layout")

         (TEDIT.FORMAT.HARDCOPY DOC PRINT-FILE DONT-SEND NIL NIL NIL NIL NIL)
         (CLOSEF DOC])
)
(PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
1991 1992 1993 1994))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2353 99050 (TEDIT.HARDCOPY 2363 . 3614) (TEDIT.HCPYFILE 3616 . 5690) (
\TEDIT.HARDCOPY.DISPLAYLINE 5692 . 19837) (\TEDIT.HARDCOPY.FORMATLINE 19839 . 67140) (
\DOFORMATTING.HARDCOPY 67142 . 80435) (\TEDIT.HARDCOPY.MODIFYLOOKS 80437 . 82844) (
\TEDIT.HCPYLOOKS.UPDATE 82846 . 93454) (\TEDIT.HCPYFMTSPEC 93456 . 98476) (\TEDIT.INTEGER.IMAGEBOX 
98478 . 99048)) (99139 100223 (\TEDIT.SCALE 99149 . 99443) (\TEDIT.SCALEREGION 99445 . 100221)) (
100466 102963 (TEDIT.HARDCOPYFN 100476 . 101327) (\TEDIT.HARDCOPY 101329 . 102238) (
\TEDIT.PRESS.HARDCOPY 102240 . 102961)) (103772 104675 (TEDIT-BOOK 103782 . 104673)))))
STOP