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

(FILECREATED "29-Jan-99 17:33:35" {DSK}<tilde>sybalsky>lispcore3.0>library>TEDITLOOKS.;2
 173603 

      changes to%:  (FNS TEDIT.LOOKS \TEDIT.CHANGE.LOOKS)

      previous date%: "25-Aug-94 10:54:30" {DSK}<tilde>sybalsky>lispcore3.0>library>TEDITLOOKS.;1)


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

(PRETTYCOMPRINT TEDITLOOKSCOMS)

(RPAQQ TEDITLOOKSCOMS

       [
        (* ;; "Support for Character looks (font, italic/bold, sub/superscripting, etc) and paragraph looks (margins, centered/justified, tabs, etc.)")


        (FILES TEDITDCL)
        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
               (FILES (LOADCOMP)
                      TEDITDCL))
        [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.TERMSA.FONTS NIL)
                                              (TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT 
                                                                              DEFAULTFONT))
                                              (TEDIT.DEFAULT.FMTSPEC (\CREATE.TEDIT.DEFAULT.FMTSPEC))
                                                             (* ; "Original was (create FMTSPEC QUAD _ 'LEFT 1STLEFTMAR _ 0 LEFTMAR _ 0 RIGHTMAR _ 0 LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0 TABSPEC _ (CONS NIL NIL)).")

                                                             (* ; 

                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

                                              (TEDIT.TERMSA.FONTS NIL)
                                              (TEDIT.KNOWN.FONTS '((Classic 'CLASSIC)
                                                                   (Modern 'MODERN)
                                                                   (Terminal 'TERMINAL)
                                                                   (Titan 'TITAN)
                                                                   (Gacha 'GACHA)
                                                                   (Helvetica 'HELVETICA)
                                                                   (Times% Roman 'TIMESROMAN]
        (VARS (TEDIT.CHARLOOKS.FEATURES '(SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY 
                                                OVERLINE STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT))
              (TEDIT.FACE.MENU (\CREATE.TEDIT.FACE.MENU))
                                                             (* ; "Original was (create MENU ITEMS _ '(Bold Italic Bold%% Italic Regular) CENTERFLG _ T TITLE _ %"Face:%").")

                                                             (* ; 

                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

              (TEDIT.SIZE.MENU (\CREATE.TEDIT.SIZE.MENU))
                                                             (* ; "Original was (create MENU ITEMS _ '(6 7 8 9 10 11 12 14 18 24 30 36) CENTERFLG _ T MENUROWS _ 4 TITLE _ %"Type Size:%").")

                                                             (* ; 

                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

              )
        (GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS 
               TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT 
               TEDIT.DEFAULT.CHARLOOKS TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS)
        (ADDVARS (FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT)
                        (TEDIT.ICON.FONT MENUFONT)))
        (COMS                                                (* ; "Character looks functions")

              (FNS CHARLOOKS.FROM.FONT EQCLOOKS SAMECLOOKS \TEDIT.UNIQUIFY.CHARLOOKS TEDIT.CARETLOOKS
                   TEDIT.COPY.LOOKS \TEDIT.GET.CHARLOOKS \TEDIT.UNPARSE.CHARLOOKS.LIST 
                   TEDIT.MODIFYLOOKS TEDIT.NEW.FONT \TEDIT.PUT.CHARLOOKS \TEDIT.CARETLOOKS.VERIFY 
                   \TEDIT.GET.INSERT.CHARLOOKS \TEDIT.GET.TERMSA.WIDTHS \TEDIT.LOOKS.UPDATE 
                   \TEDIT.PARSE.CHARLOOKS.LIST \TEDIT.FLUSH.UNUSED.LOOKS)
              
              (* ;; "For making font substitutions")


              (FNS TEDIT.SUBLOOKS)
              (FNS \TEDIT.CHANGE.LOOKS TEDIT.LOOKS \TEDIT.LOOKS \TEDIT.FONTCOPY TEDIT.GET.LOOKS))
        (COMS                                                (* ; "Paragraph looks functions")

              (FNS \TEDIT.GET.PARALOOKS EQFMTSPEC \TEDIT.UNIQUIFY.PARALOOKS TEDIT.GET.PARALOOKS 
                   \TEDIT.UNPARSE.PARALOOKS.LIST \TEDIT.PARSE.PARALOOKS.LIST TEDIT.PARALOOKS 
                   TEDIT.COPY.PARALOOKS \TEDIT.PUT.PARALOOKS \TEDIT.CONVERT.TO.FORMATTED 
                   \TEDIT.PARABOUNDS \TEDIT.FORMATTABS)
              
              (* ;; "For making paragraph-looks substitutions.")


              (FNS TEDIT.SUBPARALOOKS SAMEPARALOOKS))
        (COMS                                                (* ; "UNDO & History List stuff")

              (FNS TEDIT.REDO.LOOKS TEDIT.REDO.PARALOOKS TEDIT.UNDO.LOOKS TEDIT.UNDO.PARALOOKS))
        (COMS                                                (* ; "Revision-mark support")

              (FNS \TEDIT.MARK.REVISION))
        (COMS                                                (* ; 

                                                     "Added by yabu.fx, for SUNLOADUP without DWIM")

              (FNS \CREATE.TEDIT.DEFAULT.FMTSPEC \CREATE.TEDIT.FACE.MENU \CREATE.TEDIT.SIZE.MENU))
        (COMS                                                (* ; "Style-sheet support")

              (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET
                   TEDIT.PUSH.STYLESHEET TEDIT.ADD.STYLESHEET)
              
              (* ;; "*TEDIT-PARASTYLE-CACHE* is an ALIST of  original char/para looks to styled char/para looks.  It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles.")


              
              (* ;; "*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the FMTSPEC (styled!) for that para, if we are.  Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries.  Mostly, this'll be NIL and not interesting.")


              
              (* ;; "*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly.  This is the push-stack, in effect.  Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET")


              (INITVARS (*TEDIT-PARASTYLE-CACHE*)
                     (*TEDIT-CURRENTPARA-CACHE*)
                     (*TEDIT-STYLESHEET-SAVE-LIST*])



(* ;; 
"Support for Character looks (font, italic/bold, sub/superscripting, etc) and paragraph looks (margins, centered/justified, tabs, etc.)"
)



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

(RPAQQ \SCRATCHLEN
 64)


(CONSTANTS (\SCRATCHLEN 64))
)


(FILESLOAD (LOADCOMP)
       TEDITDCL)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(RPAQQ TEDIT.TERMSA.FONTS
 NIL)

(RPAQ TEDIT.DEFAULT.CHARLOOKS
 (CHARLOOKS.FROM.FONT DEFAULTFONT))

(RPAQ TEDIT.DEFAULT.FMTSPEC
 (\CREATE.TEDIT.DEFAULT.FMTSPEC))

(RPAQQ TEDIT.TERMSA.FONTS
 NIL)

(RPAQQ TEDIT.KNOWN.FONTS

       ((Classic 'CLASSIC)
        (Modern 'MODERN)
        (Terminal 'TERMINAL)
        (Titan 'TITAN)
        (Gacha 'GACHA)
        (Helvetica 'HELVETICA)
        (Times% Roman 'TIMESROMAN)))
)

(RPAQQ TEDIT.CHARLOOKS.FEATURES
 (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY OVERLINE
                                           STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT))

(RPAQ TEDIT.FACE.MENU
 (\CREATE.TEDIT.FACE.MENU))

(RPAQ TEDIT.SIZE.MENU
 (\CREATE.TEDIT.SIZE.MENU))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS TEDIT.KNOWN.FONTS 
       TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT TEDIT.DEFAULT.CHARLOOKS 
       TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS)
)

(ADDTOVAR FONTVARS
 (TEDIT.PROMPT.FONT DEFAULTFONT)
                       (TEDIT.ICON.FONT MENUFONT))



(* ; "Character looks functions")


(DEFINEQ

(CHARLOOKS.FROM.FONT

  [LAMBDA (FONT)
                                         (* ; "Edited 30-May-91 21:45 by jds")


         (* Create a CHARLOOKS from a font, filling in such fields as can be inferred 

       from the font descriptor.)


    (PROG ((LOOKS (create
 CHARLOOKS
                         CLFONT _ FONT)))
          (OR (FONTP FONT)
              (\ILLEGAL.ARG FONT))                           (* It HAS to be a font, first off.)

          (SELECTQ (CAR (FONTPROP FONT 'FACE))
              (BOLD (replace
 (CHARLOOKS CLBOLD) of
 LOOKS with
 T)
                    (replace
 (CHARLOOKS CLITAL) of
 LOOKS with
 NIL))
              (replace
 (CHARLOOKS CLBOLD) of
 LOOKS with
 NIL))
                                                             (* Set the boldness bit, if it's a 

                                                           bold font.)

          (SELECTQ (CADR (FONTPROP FONT 'FACE))
              (ITALIC (replace
 (CHARLOOKS CLITAL) of
 LOOKS with
 T))
              (replace
 (CHARLOOKS CLITAL) of
 LOOKS with
 NIL))
                                                             (* Set the italic bit, if it's 

                                                           italic)

          (with
 CHARLOOKS LOOKS (SETQ CLSIZE (FONTPROP FONT 'SIZE))
                                                             (* Grab the size from the font)

                 (SETQ CLOFFSET 0)                           (* And let it be neither super-

                                                           nor subscripted.)

                 )
          (RETURN LOOKS])

(EQCLOOKS

  [LAMBDA (CLOOK1 CLOOK2)
                     (* ; 

                                                "Edited  1-Jun-93 11:49 by sybalsky:mv:envos")


    (* ;; "Given two sets of CHARLOOKS, are they effectively the same?")


    (OR (EQ CLOOK1 CLOOK2)
        (AND [OR (EQ (fetch
 (CHARLOOKS CLFONT) of
 CLOOK1)
                     (fetch
 (CHARLOOKS CLFONT) of
 CLOOK2))
                 (AND (type?
 FONTCLASS (ffetch
 (CHARLOOKS CLFONT) of
 CLOOK1))
                      (type?
 FONTCLASS (ffetch
 (CHARLOOKS CLFONT) of
 CLOOK2))
                      (EQ (ffetch
 FONTCLASSNAME of
 (ffetch
 (CHARLOOKS CLFONT)
                                                              of
 CLOOK1))
                          (ffetch
 FONTCLASSNAME of
 (ffetch
 (CHARLOOKS CLFONT)
                                                              of
 CLOOK2]
             (EQ (ffetch
 (CHARLOOKS CLPROTECTED) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLPROTECTED) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLINVISIBLE) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLINVISIBLE) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLSELHERE) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLSELHERE) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLCANCOPY) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLCANCOPY) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLULINE) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLULINE) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLOLINE) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLOLINE) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLINVERTED) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLINVERTED) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLSTRIKE) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLSTRIKE) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLOFFSET) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLOFFSET) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLSMALLCAP) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLSMALLCAP) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLSTYLE) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLSTYLE) of
 CLOOK2))
             (EQ (ffetch
 (CHARLOOKS CLUSERINFO) of
 CLOOK1)
                 (ffetch
 (CHARLOOKS CLUSERINFO) of
 CLOOK2])

(SAMECLOOKS

  [LAMBDA (CLOOK1 CLOOK2 FEATURES)
                       (* ; "Edited 30-May-91 21:45 by jds")


    (* ;; "Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES")


    (for
 F in
 FEATURES always
 (SELECTQ F
                                              (FAMILY (EQ (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                       of
 CLOOK1)
                                                                 'FAMILY)
                                                          (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                       of
 CLOOK2)
                                                                 'FAMILY)))
                                              (SIZE (EQ (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                     of
 CLOOK1)
                                                               'SIZE)
                                                        (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                     of
 CLOOK2)
                                                               'SIZE)))
                                              (EXPANSION (EQ (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                          of
 CLOOK1)
                                                                    'EXPANSION)
                                                             (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                          of
 CLOOK2)
                                                                    'EXPANSION)))
                                              (SLOPE (EQ (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                      of
 CLOOK1)
                                                                'SLOPE)
                                                         (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                      of
 CLOOK2)
                                                                'SLOPE)))
                                              (WEIGHT (EQ (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                       of
 CLOOK1)
                                                                 'WEIGHT)
                                                          (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                       of
 CLOOK2)
                                                                 'WEIGHT)))
                                              (SUPERSCRIPT (EQ (fetch
 (CHARLOOKS CLOFFSET)
                                                                  of
 CLOOK1)
                                                               (fetch
 (CHARLOOKS CLOFFSET)
                                                                  of
 CLOOK2)))
                                              (INVISIBLE (EQ (fetch
 (CHARLOOKS CLINVISIBLE)
                                                                of
 CLOOK1)
                                                             (fetch
 (CHARLOOKS CLINVISIBLE)
                                                                of
 CLOOK2)))
                                              (SELECTPOINT (EQ (fetch
 (CHARLOOKS CLSELHERE)
                                                                  of
 CLOOK1)
                                                               (fetch
 (CHARLOOKS CLSELHERE)
                                                                  of
 CLOOK2)))
                                              (PROTECTED (EQ (fetch
 (CHARLOOKS CLPROTECTED)
                                                                of
 CLOOK1)
                                                             (fetch
 (CHARLOOKS CLPROTECTED)
                                                                of
 CLOOK2)))
                                              (OVERLINE (EQ (fetch
 (CHARLOOKS CLOLINE)
                                                               of
 CLOOK1)
                                                            (fetch
 (CHARLOOKS CLOLINE)
                                                               of
 CLOOK2)))
                                              (STRIKEOUT (EQ (fetch
 (CHARLOOKS CLSTRIKE)
                                                                of
 CLOOK1)
                                                             (fetch
 (CHARLOOKS CLSTRIKE)
                                                                of
 CLOOK2)))
                                              (UNDERLINE (EQ (fetch
 (CHARLOOKS CLULINE)
                                                                of
 CLOOK1)
                                                             (fetch
 (CHARLOOKS CLULINE)
                                                                of
 CLOOK2)))
                                              (FACE (EQUAL (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                        of
 CLOOK1)
                                                                  'FACE)
                                                           (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                        of
 CLOOK2)
                                                                  'FACE)))
                                              (ERROR (CONCAT F 
                                 " is an unknown feature of character looks.  Detected in SAMECLOOKS"
                                                            ])

(\TEDIT.UNIQUIFY.CHARLOOKS

  [LAMBDA (NEWLOOKS TEXTOBJ)
                             (* ; "Edited 30-May-91 21:40 by jds")


         (* Assure that there is only ONE of a given CHARLOOKS in the document--so that 

       all instances of that set of looks share structure.)


    (COND
       ((for
 LOOK in
 (fetch
 (TEXTOBJ TXTCHARLOOKSLIST) of
 TEXTOBJ)
           thereis
 (EQCLOOKS
 NEWLOOKS LOOK)))
       (T (push
 (fetch
 (TEXTOBJ TXTCHARLOOKSLIST) of
 TEXTOBJ)
                 NEWLOOKS)
          NEWLOOKS])

(TEDIT.CARETLOOKS

  [LAMBDA (STREAM LOOKS)
                                 (* ; "Edited 30-May-91 21:40 by jds")


    (* ;; "Set the 'Caret looks' for a TEdit document, i.e., the looks that will be applied to newly-typed characters from here on.")


    (PROG ((TEXTOBJ (TEXTOBJ STREAM))
           CHARLOOKS)
          (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
 (\TEDIT.CARETLOOKS.VERIFY

                                                          TEXTOBJ
                                                          (\TEDIT.PARSE.CHARLOOKS.LIST

                                                           LOOKS
                                                           (fetch
 (TEXTOBJ CARETLOOKS)
                                                              of
 TEXTOBJ)
                                                           TEXTOBJ))
                                 TEXTOBJ))                   (* ; 

                            "Parse up the looks he gave us, to make sure they're a valid CHARLOOKS")

          (COND
             ((NEQ CHARLOOKS (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ))
                                                             (* ; 

                                               "Only change the caret looks if they really changed")

              (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
                                                             (* ; "Changing the caret's looks means we can't type into the same piece any more.  Force the next insert to create a new one.")

              (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ with
 CHARLOOKS])

(TEDIT.COPY.LOOKS

  [LAMBDA (STREAM SOURCE DEST)
                           (* ; "Edited 30-May-91 21:43 by jds")


    (* ;; "Copy the CHARACTER LOOKS of one piece of text (actually, the first selected character) to another piece of text")


    (PROG ((TEXTOBJ (TEXTOBJ STREAM))
           LOOKS LEN)                                        (* ; 

                                         "get the character looks of the first character of SOURCE")

          [SETQ LOOKS (fetch
 (PIECE PLOOKS)
                         of
 (CL:TYPECASE SOURCE
                                    ((SMALLP FIXP) (\CHTOPC SOURCE (fetch
 (TEXTOBJ PCTB)
                                                                      of
 TEXTOBJ)))
                                    (SELECTION 
                                       (\SHOWSEL SOURCE NIL NIL)
                                                             (* ; 

                         "Turn off the source selection, so it doesn't hang around after the copy.")

                                       (\CHTOPC (fetch
 (SELECTION CH#) of
 SOURCE)
                                              (fetch
 (TEXTOBJ PCTB) of
 (fetch

                                                                                (SELECTION \TEXTOBJ)
                                                                                  of
 SOURCE))))
                                    (T (\ILLEGAL.ARG SOURCE)))]
          (COND
             [(type?
 SELECTION DEST)                     (* ; 

                                     "make sure that the destination selection is in this document")

              (COND
                 ((NEQ TEXTOBJ (fetch
 (SELECTION \TEXTOBJ) of
 DEST))
                  (\LISPERROR "Destination selection is not in stream " STREAM]
             (T                                              (* ; 

                           "set the LEN arg for TEDIT.LOOKS to be 1 since we just have a char pos.")

                (SETQ LEN 1)))
          (TEDIT.LOOKS
 TEXTOBJ LOOKS DEST LEN])

(\TEDIT.GET.CHARLOOKS

  [LAMBDA (PC FILE LOOKSARRAY PREVPC)
                    (* ; "Edited 30-May-91 21:43 by jds")


(* ;;; "Set the PLOOKS for the current piece, PC, according to what the file says")


(* ;;; "The PLEN field of this piece is the number of FILE BYTES taken to describe the piece.  This may need to be adjusted for fat pieces, and at fat/thin boundaries.  PREVPC is the previous piece, if any, so we can detect such boundaries.")


    (PROG ((FLAGS (\BIN FILE)))
          (COND
             ((NOT (ZEROP (LOGAND FLAGS 1)))                 (* ; "This text is NEW.  Mark it so.")

              (replace
 (PIECE PNEW) of
 PC with
 T)))
          (COND
             ((NOT (ZEROP (LOGAND FLAGS 2)))                 (* ; 

                                                           "This text is FAT--16 bit characters.")

              (replace
 (PIECE PFATP) of
 PC with
 T)))
          (replace
 (PIECE PLOOKS) of
 PC with
 (ELT LOOKSARRAY (\SMALLPIN FILE)))
                                                             (* ; 

                               "Look the looks up in the array we built according to specs earlier")

          (COND
             [(fetch
 (PIECE PFATP) of
 PC)            (* ; 

                                                     "For a fat piece, convert bytes to characters")

              (COND
                 ((AND PREVPC (fetch
 (PIECE PFATP) of
 PREVPC))
                  (replace
 (PIECE PLEN) of
 PC with
 (FOLDHI (FETCH
 (PIECE PLEN)
                                                                          OF
 PC)
                                                                      2)))
                 (T                                          (* ; 

         "The prior piece wasn't fat and this one is.  Take account of the 255-255-0 in the length")

                    (replace
 (PIECE PLEN) of
 PC with
 (FOLDHI (IDIFFERENCE
                                                                          (fetch
 (PIECE PLEN)
                                                                             of
 PC)
                                                                          3)
                                                                        2))
                    (add
 (fetch
 (PIECE PFPOS) of
 PC)
                           3]
             ((AND PREVPC (fetch
 (PIECE PFATP) of
 PREVPC))

              (* ;; "The prior piece was fat and this one isn't.  Take account of the 255-0 on the front of this piece's chars.")


              (replace
 (PIECE PLEN) of
 PC with
 (IDIFFERENCE (fetch
 (PIECE PLEN)
                                                                           of
 PC)
                                                                  2))
              (add
 (fetch
 (PIECE PFPOS) of
 PC)
                     2])

(\TEDIT.UNPARSE.CHARLOOKS.LIST

  [LAMBDA (LOOKS)
                                        (* ; "Edited 30-May-91 21:45 by jds")

                                                             (* Convert a CHARLOOKS into an 

                                                           equivalent PList-form for external 

                                                           consumption)

    (PROG ((NEWLOOKS NIL)
           OFFSET)
          (for
 PROP in
 (LIST (fetch
 (CHARLOOKS CLSTYLE) of
 LOOKS)
                                     (fetch
 (CHARLOOKS CLUSERINFO) of
 LOOKS)
                                     (ONOFF (fetch
 (CHARLOOKS CLINVERTED) of
 LOOKS))
                                     (FONTPROP (fetch
 (CHARLOOKS CLFONT) of
 LOOKS)
                                            'WEIGHT)
                                     (FONTPROP (fetch
 (CHARLOOKS CLFONT) of
 LOOKS)
                                            'SLOPE)
                                     (FONTPROP (fetch
 (CHARLOOKS CLFONT) of
 LOOKS)
                                            'EXPANSION)
                                     (ONOFF (fetch
 (CHARLOOKS CLULINE) of
 LOOKS))
                                     (ONOFF (fetch
 (CHARLOOKS CLSTRIKE) of
 LOOKS))
                                     (ONOFF (fetch
 (CHARLOOKS CLOLINE) of
 LOOKS))
                                     (FONTPROP (fetch
 (CHARLOOKS CLFONT) of
 LOOKS)
                                            'FAMILY)
                                     (FONTPROP (fetch
 (CHARLOOKS CLFONT) of
 LOOKS)
                                            'SIZE)
                                     (ONOFF (fetch
 (CHARLOOKS CLPROTECTED) of
 LOOKS))
                                     (ONOFF (fetch
 (CHARLOOKS CLSELHERE) of
 LOOKS))
                                     (ONOFF (fetch
 (CHARLOOKS CLINVISIBLE) of
 LOOKS)))
             as
 PROPNAME
             in
 '(STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE 
                            FAMILY SIZE PROTECTED SELECTPOINT INVISIBLE)
             do
 (push
 NEWLOOKS PROP)
                   (push
 NEWLOOKS PROPNAME))
          (push
 NEWLOOKS (IABS (OR (fetch
 (CHARLOOKS CLOFFSET) of
 LOOKS)
                                       0)))
          [push
 NEWLOOKS (COND
                                ((IGREATERP (fetch
 (CHARLOOKS CLOFFSET) of
 LOOKS)
                                        0)
                                 'SUPERSCRIPT)
                                ((ILESSP (fetch
 (CHARLOOKS CLOFFSET) of
 LOOKS)
                                        0)
                                 'SUBSCRIPT)
                                (T 'SUPERSCRIPT]
          (RETURN NEWLOOKS])

(TEDIT.MODIFYLOOKS

  [LAMBDA (LINE STARTX DS LOOKS LINEBASEY)
               (* ; "Edited 30-May-91 21:45 by jds")


         (* Modify the screen to allow for underlining, etc.

       Also, restore the vertical offset to the baseline.)


    (PROG ((CURX (DSPXPOSITION NIL DS))
           (CURY (DSPYPOSITION NIL DS))
           (FONT (fetch
 (CHARLOOKS CLFONT) of
 LOOKS)))
          (COND
             ((fetch
 (CHARLOOKS CLULINE) of
 LOOKS)   (* It's underlined.)

              (MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY)
                                          (fetch
 (LINEDESCRIPTOR LTRUEDESCENT) of
 LINE)))
                     DS)
              (RELDRAWTO (IDIFFERENCE CURX STARTX)
                     0 1 'PAINT DS)))
          (COND
             ((fetch
 (CHARLOOKS CLOLINE) of
 LOOKS)   (* Over-line)

              (MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT 'ASCENT]
                     DS)
              (RELDRAWTO (IDIFFERENCE CURX STARTX)
                     0 1 'PAINT DS)))
          (COND
             ((fetch
 (CHARLOOKS CLSTRIKE) of
 LOOKS)  (* Struck-thru)

              (MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT 'ASCENT)
                                                3))
                     DS)
              (RELDRAWTO (IDIFFERENCE CURX STARTX)
                     0 1 'PAINT DS)))
          (COND
             ((fetch
 (CHARLOOKS CLINVERTED) of
 LOOKS)(* Inverse video)

              (BITBLT NIL NIL NIL DS STARTX (IDIFFERENCE CURY (FONTPROP FONT 'DESCENT))
                     (IDIFFERENCE CURX STARTX)
                     (FONTPROP FONT 'HEIGHT)
                     'TEXTURE
                     'INVERT BLACKSHADE)))
          (MOVETO CURX LINEBASEY DS])

(TEDIT.NEW.FONT

  (LAMBDA (TEXTOBJ)
                                          (* jds " 8-Feb-85 11:27")

    (PROG ((NAME (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Name of font:  "))))
          (AND NAME (SETQ TEDIT.KNOWN.FONTS (NCONC1 TEDIT.KNOWN.FONTS (LIST NAME (KWOTE (U-CASE
                                                                                         NAME)))))
               (RETURN (U-CASE NAME))))))

(\TEDIT.PUT.CHARLOOKS

  [LAMBDA (FILE CH1 CHLIM LOOKS OLDPC EDITSTENTATIVE LOOKSHARRAY PREVFATP)

                                                             (* ; "Edited 30-May-91 21:45 by jds")


    (* ;; "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")


    (PROG ((FONT (fetch
 (CHARLOOKS CLFONT) of
 LOOKS))
           STR)
          (\DWOUT FILE (IDIFFERENCE CHLIM CH1))              (* ; "The length of this run of looks")

          (\SMALLPOUT FILE \PieceDescriptorLOOKS)            (* ; 

                                                           "Mark this as setting the piece's looks")

          [\BOUT FILE (LOGOR (COND
                                ((AND EDITSTENTATIVE OLDPC (fetch
 (PIECE PNEW) of
 OLDPC))
                                                             (* ; 

                                               "If this is a tentative edit, save the newness flag")

                                 1)
                                (T                           (* ; "Otherwise, don't bother")

                                   0))
                             (COND
                                ((AND OLDPC (fetch
 (PIECE PFATP) of
 OLDPC))
                                                             (* ; 

                                       "If this piece contains fat characters, remember that fact.")

                                 2)
                                (T                           (* ; "Otherwise, don't bother")

                                   0]
          (\SMALLPOUT FILE (GETHASH LOOKS LOOKSHARRAY))      (* ; 

                                                           "The index into the list of fonts")

      ])

(\TEDIT.CARETLOOKS.VERIFY

  [LAMBDA (TEXTOBJ NEWLOOKS)
                             (* ; "Edited 30-May-91 21:41 by jds")

                                                             (* Check with the user's 

                                                           CARETLOOKSFN to see if he wants to 

                                                           make changes)

    (PROG ((CARETFN (TEXTPROP TEXTOBJ 'CARETLOOKSFN))
           LOOKS)
          (SETQ LOOKS (AND CARETFN (APPLY* CARETFN NEWLOOKS TEXTOBJ)))
          (RETURN (COND
                     ((EQ LOOKS 'DON'T)                      (* He said not to change the looks.)

                      (OR (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
                          (fetch
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ)))
                     (LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
 LOOKS TEXTOBJ))
                     (T                                      (* He didn't give us any guidance, 

                                                           so return the looks unmodified.)

                        NEWLOOKS])

(\TEDIT.GET.INSERT.CHARLOOKS

  [LAMBDA (TEXTOBJ SEL)
                                  (* ; "Edited 30-May-91 21:45 by jds")


         (* Given a default source of charlooks, set us up some good ones.

       IN particular, reset CLPROTECTED if need be.)


    (PROG ((PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           [CH# (IMAX 1 (IMIN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)
                              (SELECTQ (fetch
 (SELECTION POINT) of
 SEL)
                                  (LEFT (fetch
 (SELECTION CH#) of
 SEL))
                                  (RIGHT (SUB1 (fetch
 (SELECTION CHLIM) of
 SEL)))
                                  (SHOULDNT]
           PCNO PIECE LOOKS)
          (SETQ PIECE (\CHTOPC CH# PCTB))
          [COND
             [(NULL PIECE)                                   (* No piece to take looks from;

                                                           use the default)

              (SETQ LOOKS (OR (fetch
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ)
                              (\TEDIT.UNIQUIFY.CHARLOOKS
 (CHARLOOKS.FROM.FONT
 DEFAULTFONT)
                                     TEXTOBJ]
             ((ATOM PIECE)                                   (* Trying to take from the 

                                                           pseudo-piece at the end.)

              (COND
                 [(ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                                                             (* No characters to steal from.

                                                           Use the defaults)

                  (SETQ LOOKS (OR (fetch
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ)
                                  (\TEDIT.UNIQUIFY.CHARLOOKS
 (CHARLOOKS.FROM.FONT
 DEFAULTFONT
                                                                        )
                                         TEXTOBJ]
                 (T                                          (* Otherwise, steal the looks of the 

                                                           last character)

                    (SETQ PIECE (fetch
 (PCTNODE PCE)
                                   of
 (FINDNODE-INDEX PCTB (SUB1 (INDEX (fetch
 (PCTNODE
                                                                                        CHNUM)
                                                                               of
 (\LASTNODE
                                                                                       PCTB))
                                                                            PCTB]
          [COND
             (LOOKS)
             ((fetch
 (CHARLOOKS CLPROTECTED) of
 (fetch
 (PIECE PLOOKS) of
 PIECE))
                                                             (* His looks are protected;

                                                           we have to copy to a new CHARLOOKS.)

              (SETQ LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
 (create
 CHARLOOKS
                                                            using
 (fetch
 (PIECE PLOOKS)
                                                                         of
 PIECE)
                                                                  CLPROTECTED _ NIL CLSELHERE _ NIL)
                                 TEXTOBJ)))
             (T                                              (* No protection, just reuse his 

                                                           looks)

                (SETQ LOOKS (fetch
 (PIECE PLOOKS) of
 PIECE]
          (RETURN (\TEDIT.UNIQUIFY.CHARLOOKS
 (\TEDIT.CARETLOOKS.VERIFY
 TEXTOBJ LOOKS)
                         TEXTOBJ])

(\TEDIT.GET.TERMSA.WIDTHS

  (LAMBDA (TERMSA FONT)
                                      (* jds "22-OCT-83 21:36")

          
          (* If the guy is using a terminal table, get an updated set of widths to 

          reflect that.)


    (PROG ((NWIDTHS (ARRAY 256 'SMALLP 0 0)))
          (for
 I from
 0 to
 255 do
 (\WORDSETA NWIDTHS I (TEDIT.CHARWIDTH I FONT TERMSA)))
          (RETURN NWIDTHS))))

(\TEDIT.LOOKS.UPDATE

  [LAMBDA (STREAM PC)
                                    (* ; "Edited 30-May-91 21:47 by jds")


(* ;;; "Called under \FORMATLINE, on which it depends.  At a piece boundary, update the line formatting fields such as ASCENT, DESCENT, etc.  Also, skip over invisible characters")


    (DECLARE
 (USEDFREE LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT 
                        INVISIBLERUNS NEWASCENT NEWDESCENT))
    (COND
       (PC (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
                  (ORIGPC PC)
                  TLOOKS TEMP NEWPC PARALOOKS PREVPC)
                 [COND
                    ([OR (NOT (fetch
 (PIECE PREVPIECE) of
 ORIGPC))
                         (NEQ (fetch
 (PIECE PPARALOOKS) of
 ORIGPC)
                              (fetch
 (PIECE PPARALOOKS) of
 (fetch
 (PIECE PREVPIECE)
                                                                      of
 ORIGPC]
                     (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES
 (fetch
 (PIECE PPARALOOKS)
                                                                     of
 ORIGPC)
                                            ORIGPC TEXTOBJ))
                     (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with
 PARALOOKS))
                    (T (SETQ PARALOOKS (fetch
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM]
                 (SETQ TLOOKS (\TEDIT.APPLY.STYLES
 (ffetch
 (PIECE PLOOKS) of
 ORIGPC)
                                     ORIGPC 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
 ORIGPC))
                     (\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))
                     (SETQ PREVPC ORIGPC)
                     (SETQ ORIGPC (fetch
 (PIECE NEXTPIECE) of
 ORIGPC))
                     (COND
                        ((AND ORIGPC (NEQ (fetch
 (PIECE PPARALOOKS) of
 ORIGPC)
                                          (fetch
 (PIECE PPARALOOKS) of
 PREVPC)))
                         (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES
 (fetch
 (PIECE PPARALOOKS)
                                                                         of
 ORIGPC)
                                                ORIGPC TEXTOBJ))
                         (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with
 PARALOOKS)
                         ))
                     (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES
 (ffetch
 (PIECE PLOOKS)
                                                                          of
 ORIGPC)
                                                     ORIGPC TEXTOBJ)))
                     [while
 (AND ORIGPC (OR (ZEROP (fetch
 (PIECE PLEN) of
 ORIGPC))
                                                (fetch
 (CHARLOOKS CLINVISIBLE) of
 TLOOKS)))
                        do
                               (* ; 

                "Skip over this run of invisible characters --and any trailing run of empty pieces")

                              (\EDITSETA LOOKS LOOKNO (IPLUS (fetch
 (PIECE PLEN) of
 ORIGPC)
                                                             (\EDITELT LOOKS LOOKNO))) 
                                                             (* ; 

                                             "Note the invisible run length for the line displayer")

                              (SETQ PREVPC ORIGPC)
                              (SETQ ORIGPC (fetch
 (PIECE NEXTPIECE) of
 ORIGPC))
                              (COND
                                 ((NOT ORIGPC)               (* ; 

                        "We ran off the end of the document.  Don't try to update paragraph looks.")

                                  )
                                 ((NEQ (fetch
 (PIECE PPARALOOKS) of
 ORIGPC)
                                       (fetch
 (PIECE PPARALOOKS) of
 PREVPC))
                                                             (* ; 

                                  "Paragraph looks changed in the course of the invisible section.")

                                  (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES
 (fetch

                                                                                (PIECE PPARALOOKS)
                                                                                  of
 ORIGPC)
                                                         ORIGPC TEXTOBJ))
                                  (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM
                                     with
 PARALOOKS)))
                              (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES
 (ffetch

                                                                                 (PIECE PLOOKS)
                                                                                   of
 ORIGPC)
                                                              ORIGPC TEXTOBJ]
                     (while
 (AND ORIGPC (ZEROP (fetch
 (PIECE PLEN) of
 ORIGPC)))
                        do
                               (* ; 

                                                 "Skip over any trailing pieces that are zero long")

                              (SETQ PREVPC ORIGPC)
                              (SETQ ORIGPC (fetch
 (PIECE NEXTPIECE) of
 ORIGPC)))
                     (add
 CHNO (\EDITELT LOOKS LOOKNO))
                     (add
 INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
                                                             (* ; 

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

                     (SETQ NEWPC ORIGPC)))
                 (COND
                    ([AND ORIGPC (NOT (EQCLOOKS
 TLOOKS (fetch
 (TEXTSTREAM CURRENTLOOKS)
                                                              of
 STREAM]

                     (* ;; "Only update looks if there's really a new piece to update them from, and the looks have really changed")


                     (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM with
 TLOOKS)
                     (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with
 PARALOOKS)
                     [COND
                        [(type?
 FONTCLASS (fetch
 (CHARLOOKS CLFONT) of
 TLOOKS))
                                                             (* ; 

                                                    "For FONTCLASSes, we have to get the real font")

                         (SETQ FONT (FONTCOPY (fetch
 (CHARLOOKS CLFONT) of
 TLOOKS)
                                           'DEVICE
                                           'DISPLAY]
                        (T                                   (* ; 

                                                        "It's a font already, so no work is needed")

                           (SETQ FONT (fetch
 (CHARLOOKS CLFONT) of
 TLOOKS]
                     [SETQ NEWASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT 'ASCENT)
                                                         (OR (ffetch
 (CHARLOOKS CLOFFSET)
                                                                of
 TLOOKS)
                                                             0]
                     [SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (FONTPROP FONT 'DESCENT)
                                                           (OR (ffetch
 (CHARLOOKS CLOFFSET)
                                                                  of
 TLOOKS)
                                                               0]
                     [COND
                        ((fetch
 (FMTSPEC FMTHARDCOPY) of
 PARALOOKS)
                                                             (* ; 

                                        "If it's a hardcopy-format line, grab the hardcopy widths.")

                         (SETQ FONT (FONTCOPY (fetch
 (CHARLOOKS CLFONT) of
 TLOOKS)
                                           'DEVICE DEVICE]
                     (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")

                     (COND
                        ((ffetch
 (CHARLOOKS CLPROTECTED) of
 TLOOKS)
                                                             (* ; 

                        "If this line contains protected text, mark the linedescriptor accordingly")

                         (freplace
 (LINEDESCRIPTOR LHASPROT) of
 LINE with
 T)))
                     (SETQ NEWPC ORIGPC))
                    [(AND ORIGPC (fetch
 (PIECE PREVPIECE) of
 ORIGPC)
                          (fetch
 (PIECE POBJ) of
 (fetch
 (PIECE PREVPIECE) of
 ORIGPC))
                          )

                     (* ;; "After passing over an image object, always update the ascent and descent.  This avoids losing that info if an image object is first on the line;  we used to forget the starting font's data, which left following characters at the mercy of the imageobj.")


                     [SETQ NEWASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT 'ASCENT)
                                                         (OR (ffetch
 (CHARLOOKS CLOFFSET)
                                                                of
 TLOOKS)
                                                             0]
                     (SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (FONTPROP FONT 'DESCENT)
                                                           (OR (ffetch
 (CHARLOOKS CLOFFSET)
                                                                  of
 TLOOKS)
                                                               0]
                    ((NOT ORIGPC)

                     (* ;; "No more pieces in this document (we ran off the end skipping invisible text!) Return a NIL from the BIN, so that \FORMATLINE will not die.")


                     (RETFROM '\BIN NIL)))
                 (RETURN NEWPC])

(\TEDIT.PARSE.CHARLOOKS.LIST

  [LAMBDA (NLOOKS OLOOKS TEXTOBJ)
                        (* ; "Edited 30-May-91 21:46 by jds")


    (* ;; "Takes a CHARLOOKS, a FONTDESCRIPTOR, or an ALST-format looks spec and parses it into a new CHARLOOKS.  If OLOOKS is given, it will be used as the base for modifications;  otherwise, TEDIT.DEFAULT.CHARLOOKS will be.")


    (PROG ((FAMILY NIL)
           (FONT NIL)
           (FACE NIL)
           (SIZE NIL)
           (SIZEINC NIL)
           (PROT NIL)
           (SELHERE NIL)
           (ULINE NIL)
           (OLINE NIL)
           (STRIKE NIL)
           (SUPER NIL)
           (OFFSETINC NIL)
           (WEIGHT NIL)
           (SLOPE NIL)
           (EXPANSION NIL)
           (SUB NIL)
           (INVISIBLE NIL)
           STYLE STYLESET UISET USERINFO NEWLOOKS NEWFONT NEWPCLOOKS INVERSEVIDEO)
                                                             (* ; 

                                                         "Construct the set of new looks to apply:")

          (COND
             ((type?
 CHARLOOKS NLOOKS)                   (* ; 

                                    "We've already got a made-up set of looks;  we'll just use it.")

              (RETURN NLOOKS))
             ((FONTP NLOOKS)                                 (* ; 

                          "It was a font spec.  Make the looks be that font, otherwise unmodified.")

              (RETURN (CHARLOOKS.FROM.FONT
 NLOOKS)))
             (T                                              (* ; 

                                            "We got an AList -- prepare looks changes in that form")

                (SETQ FONT (LISTGET NLOOKS 'FONT))
                (SETQ FAMILY (LISTGET NLOOKS 'FAMILY))
                (SETQ FACE (LISTGET NLOOKS 'FACE))
                (SETQ SIZE (LISTGET NLOOKS 'SIZE))
                (SETQ PROT (LISTGET NLOOKS 'PROTECTED))
                (SETQ SELHERE (LISTGET NLOOKS 'SELECTPOINT))
                (SETQ ULINE (LISTGET NLOOKS 'UNDERLINE))
                (SETQ OLINE (LISTGET NLOOKS 'OVERLINE))
                (SETQ INVERSEVIDEO (LISTGET NEWLOOKS 'INVERTED))
                (SETQ STRIKE (LISTGET NLOOKS 'STRIKEOUT))
                (SETQ INVISIBLE (LISTGET NLOOKS 'INVISIBLE))
                (SETQ SUPER (LISTGET NLOOKS 'SUPERSCRIPT))
                (SETQ SUB (LISTGET NLOOKS 'SUBSCRIPT))
                (SETQ WEIGHT (LISTGET NLOOKS 'WEIGHT))
                (SETQ SLOPE (LISTGET NLOOKS 'SLOPE))
                (SETQ EXPANSION (LISTGET NLOOKS 'EXPANSION))
                (SETQ OFFSETINC (LISTGET NLOOKS 'OFFSETINCREMENT))
                (SETQ SIZEINC (LISTGET NLOOKS 'SIZEINCREMENT))
                (SETQ STYLE (LISTGET NLOOKS 'STYLE))
                (SETQ STYLESET (FMEMB 'STYLE NLOOKS))
                (SETQ USERINFO (LISTGET NLOOKS 'USERINFO))
                (SETQ UISET (FMEMB 'USERINFO NLOOKS))
                (SETQ NLOOKS NIL)                            (* ; 

                                                           "Tell later code to use NEWLOOKS.")

                (SETQ NEWLOOKS NIL)
                [COND
                   (FAMILY (SETQ NEWLOOKS (CONS 'FAMILY (CONS FAMILY NEWLOOKS]
                [COND
                   (FONT (SETQ FONT (CAR (NLSETQ (\DTEST FONT 'FONTDESCRIPTOR]
                [COND
                   [(OR WEIGHT SLOPE EXPANSION)              (* ; 

                                                 "Setting one of these inhibits the FACE parameter")

                    [AND WEIGHT (SETQ NEWLOOKS (CONS 'WEIGHT (CONS WEIGHT NEWLOOKS]
                    [AND SLOPE (SETQ NEWLOOKS (CONS 'SLOPE (CONS SLOPE NEWLOOKS]
                    (AND EXPANSION (SETQ NEWLOOKS (CONS 'EXPANSION (CONS EXPANSION NEWLOOKS]
                   (FACE (SETQ NEWLOOKS (CONS 'FACE (CONS FACE NEWLOOKS]
                [COND
                   (SIZE (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS]
                [SETQ NEWPCLOOKS
                 (COND
                    [OLOOKS (create
 CHARLOOKS using
 OLOOKS CLFONT _
                                                        (SETQ NEWFONT
                                                         (OR FONT (\TEDIT.FONTCOPY

                                                                   (fetch
 (CHARLOOKS CLFONT)
                                                                      of
 OLOOKS)
                                                                   NEWLOOKS TEXTOBJ]
                    (T (create
 CHARLOOKS
                          using
 TEDIT.DEFAULT.CHARLOOKS CLFONT _
                                (SETQ NEWFONT
                                 (OR FONT (\TEDIT.FONTCOPY

                                           (fetch
 (CHARLOOKS CLFONT) of
 
                                                                              TEDIT.DEFAULT.CHARLOOKS
                                                  )
                                           (COND
                                              (SIZEINC       (* ; 

                                   "There's a size change requested.  Fix up the size of the font.")

                                                     (LISTPUT NEWLOOKS 'SIZE
                                                            (IPLUS (FONTPROP (fetch
 (CHARLOOKS
                                                                                         CLFONT)
                                                                                of
 
                                                                              TEDIT.DEFAULT.CHARLOOKS
                                                                                    )
                                                                          'SIZE)
                                                                   SIZEINC))
                                                     NEWLOOKS)
                                              (T NEWLOOKS))
                                           TEXTOBJ]          (* ; "Give this piece its new looks")

                [replace
 (CHARLOOKS CLBOLD) of
 NEWPCLOOKS with
 (EQ 'BOLD
                                                                               (FONTPROP NEWFONT
                                                                                      'WEIGHT]
                [replace
 (CHARLOOKS CLITAL) of
 NEWPCLOOKS with
 (EQ 'ITALIC
                                                                               (FONTPROP NEWFONT
                                                                                      'SLOPE]
                [AND PROT (replace
 (CHARLOOKS CLPROTECTED) of
 NEWPCLOOKS
                             with
 (EQ PROT 'ON]
                [AND SELHERE (replace
 (CHARLOOKS CLSELHERE) of
 NEWPCLOOKS
                                with
 (EQ SELHERE 'ON]
                [AND ULINE (replace
 (CHARLOOKS CLULINE) of
 NEWPCLOOKS
                              with
 (EQ ULINE 'ON]
                [AND OLINE (replace
 (CHARLOOKS CLOLINE) of
 NEWPCLOOKS
                              with
 (EQ OLINE 'ON]
                [AND STRIKE (replace
 (CHARLOOKS CLSTRIKE) of
 NEWPCLOOKS
                               with
 (EQ STRIKE 'ON]
                [AND INVISIBLE (replace
 (CHARLOOKS CLINVISIBLE) of
 NEWPCLOOKS
                                  with
 (EQ INVISIBLE 'ON]
                [AND INVERSEVIDEO (replace
 (CHARLOOKS CLINVERTED) of
 NEWPCLOOKS
                                     with
 (EQ INVERSEVIDEO 'ON]
                (AND SUPER (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS with
 SUPER))
                (AND SUB (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS with
 (IMINUS SUB)))
                (AND STYLESET (replace
 (CHARLOOKS CLSTYLE) of
 NEWPCLOOKS with
 STYLE))
                (AND UISET (replace
 (CHARLOOKS CLUSERINFO) of
 NEWPCLOOKS with
 USERINFO))
                (AND OFFSETINC (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS
                                  with
 (IPLUS (OR (fetch
 (CHARLOOKS CLOFFSET) of
 
                                                                                           NEWPCLOOKS
                                                             )
                                                      0)
                                                  OFFSETINC)))
                (replace
 (CHARLOOKS CLSIZE) of
 NEWPCLOOKS with
 (FONTPROP NEWFONT
                                                                                  'SIZE))
                (RETURN NEWPCLOOKS])

(\TEDIT.FLUSH.UNUSED.LOOKS

  [LAMBDA (TEXTOBJ FIRSTPC)
                              (* ; "Edited 30-May-91 21:47 by jds")


    (* ;; "Run thru the CHARLOOKS and PARALOOKS lists for this document, and flush any looks that aren't being used in the document itself.")


    (PROG ((CHARLOOKS (fetch
 (TEXTOBJ TXTCHARLOOKSLIST) of
 TEXTOBJ))
           (PARALOOKS (fetch
 (TEXTOBJ TXTPARALOOKSLIST) of
 TEXTOBJ)))
          (for
 LOOKS in
 CHARLOOKS do
             (* ; 

                                                          "Reset the in-use mark in all CHARLOOKSs")

                                                (replace
 (CHARLOOKS CLMARK) of
 LOOKS
                                                   with
 NIL))
          (for
 LOOKS in
 PARALOOKS do
             (* ; 

                                                           "Reset the in-use mark in all FMTSPECs")

                                                (replace
 (FMTSPEC FMTMARK) of
 LOOKS
                                                   with
 NIL))
          (while
 FIRSTPC do
                          (* ; 

               "Now run thru the pieces in the document, marking the looks that are really in use.")

                                   (replace
 (CHARLOOKS CLMARK) of
 (fetch
 (PIECE PLOOKS)
                                                                             of
 FIRSTPC)
                                      with
 T)
                                   (replace
 (FMTSPEC FMTMARK) of
 (fetch
 (PIECE PPARALOOKS
                                                                                           )
                                                                            of
 FIRSTPC)
                                      with
 T)
                                   (SETQ FIRSTPC (fetch
 (PIECE NEXTPIECE) of
 FIRSTPC)))
          (replace
 (TEXTOBJ TXTCHARLOOKSLIST) of
 TEXTOBJ
             with
 (for
 LOOKS in
 CHARLOOKS when
 (fetch
 (CHARLOOKS CLMARK)
                                                                  of
 LOOKS) collect
 LOOKS))
                                                             (* ; 

                                                  "Keep only those CHARLOOKSs that ARE being used.")

          (replace
 (TEXTOBJ TXTPARALOOKSLIST) of
 TEXTOBJ
             with
 (for
 LOOKS in
 PARALOOKS when
 (fetch
 (FMTSPEC FMTMARK)
                                                                  of
 LOOKS) collect
 LOOKS))
                                                             (* ; 

                                                   "And only those PARALOOKSs that ARE being used.")

      ])
)



(* ;; "For making font substitutions")


(DEFINEQ

(TEDIT.SUBLOOKS

  [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST)
         (* ; "Edited 26-Apr-93 14:53 by jds")


(* ;;; "User entry to substitute one set of looks for another.  Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.")


    (LET* ((OLDLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST
 OLDLOOKSLIST))
           (NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST
 NEWLOOKSLIST))
           (TEXTOBJ (TEXTOBJ TEXTSTREAM))
           (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           (FIRSTPC (\CHTOPC 1 PCTB))
           (FEATURELIST (for
 A on
 OLDLOOKSLIST by
 (CDDR A) collect
 (CAR A)))
           CHANGEMADE)
          (\SHOWSEL SEL NIL NIL)                             (* ; "Turn off the selection, first.")

          [OR (ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
              (bind
 (CH# _ 1) for
 (PC _ FIRSTPC) while
 PC
                 by
 (fetch
 (PIECE NEXTPIECE) of
 PC)
                 do
 (COND
                           ((SAMECLOOKS
 OLDLOOKS (fetch
 (PIECE PLOOKS) of
 PC)
                                   FEATURELIST)
                            (replace
 (TEXTOBJ \DIRTY) of
 (TEXTOBJ TEXTSTREAM) with
 T)
                            (freplace
 (PIECE PLOOKS) of
 PC
                               with
 (\TEDIT.UNIQUIFY.CHARLOOKS
 (\TEDIT.PARSE.CHARLOOKS.LIST

                                                                        NEWLOOKSLIST
                                                                        (fetch
 (PIECE PLOOKS)
                                                                           of
 PC))
                                               (TEXTOBJ TEXTSTREAM)))
                            (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch
 (PIECE PLEN)
                                                                           of
 PC)))
                            (SETQ CHANGEMADE T)))
                       (add
 CH# (fetch
 (PIECE PLEN) of
 PC]
          (COND
             ((fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)
              (TEDIT.UPDATE.SCREEN TEXTOBJ)                  (* ; "Update the screen image")

              (\FIXSEL SEL TEXTOBJ)
              (\SHOWSEL SEL NIL T)))
          (COND
             (CHANGEMADE 'Done)
             (T 'NoChangesMade])
)
(DEFINEQ

(\TEDIT.CHANGE.LOOKS

  [LAMBDA (STREAM NEWLOOKS CH# LEN)
                      (* ; "Edited 19-Apr-93 14:08 by jds")


(* ;;; "Internal programmatic interface to changing character looks.  DOES NOT CHANGE the current selection.")


(* ;;; 

"THIS FUNCTION AND \TEDIT.PARSE.CHARLOOKS.LIST MUST TRACK ONE ANOTHER, FOR THE P-LIST FORMAT..")


    (PROG ((TEXTOBJ (TEXTOBJ STREAM))
           PCTB PC1 PCNO1 PCNON PCN \INPC FAMILY FONT FACE SIZE PROT SELHERE ULINE OLINE STRIKE 
           INVERSEVIDEO (SUPER NIL)
           (WEIGHT NIL)
           (SLOPE NIL)
           (SIZEINC NIL)
           (OFFSETINC NIL)
           (EXPANSION NIL)
           (NEWLOOKS NEWLOOKS)
           (NLOOKSAVE NEWLOOKS)
           (SUB NIL)
           (INVISIBLE NIL)
           FOOLOOKS NEWFONT DY CHLIM (OLDLOOKSLIST NIL)
           STYLE STYLESET UISET USERINFO START-OF-PIECE)
          (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
          (SETQ \INPC (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ))
                                                             (* ; 

                                                         "Construct the set of new looks to apply:")

          (COND
             ((OR (IGREATERP CH# (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                  (ZEROP LEN))                               (* ; 

                                         "There won't be any text changed by this.  Just punt out.")

              (TEDIT.CARETLOOKS
 STREAM NEWLOOKS)         (* ; "After setting the caret looks.")

              (RETURN)))
          [COND
             ((type?
 CHARLOOKS NEWLOOKS)                 (* ; 

                                    "We've already got a made-up set of looks;  we'll just use it.")

              )
             ((FONTP NEWLOOKS)                               (* ; 

                                       "If it's a font descriptor, extract what we need from that.")

              (SETQ FONT NEWLOOKS)
              (SETQ NEWLOOKS NIL))
             (T                                              (* ; 

                                            "We got an AList -- prepare looks changes in that form")

                (SETQ FONT (LISTGET NEWLOOKS 'FONT))
                (SETQ FAMILY (LISTGET NEWLOOKS 'FAMILY))
                (SETQ FACE (LISTGET NEWLOOKS 'FACE))
                (SETQ SIZE (LISTGET NEWLOOKS 'SIZE))
                (SETQ PROT (LISTGET NEWLOOKS 'PROTECTED))
                (SETQ SELHERE (LISTGET NEWLOOKS 'SELECTPOINT))
                (SETQ ULINE (LISTGET NEWLOOKS 'UNDERLINE))
                (SETQ OLINE (LISTGET NEWLOOKS 'OVERLINE))
                (SETQ INVERSEVIDEO (LISTGET NEWLOOKS 'INVERTED))
                (SETQ STRIKE (LISTGET NEWLOOKS 'STRIKEOUT))
                (SETQ INVISIBLE (LISTGET NEWLOOKS 'INVISIBLE))
                (SETQ SUPER (LISTGET NEWLOOKS 'SUPERSCRIPT))
                (SETQ SUB (LISTGET NEWLOOKS 'SUBSCRIPT))
                (SETQ WEIGHT (LISTGET NEWLOOKS 'WEIGHT))
                (SETQ SLOPE (LISTGET NEWLOOKS 'SLOPE))
                (SETQ EXPANSION (LISTGET NEWLOOKS 'EXPANSION))
                (SETQ SIZEINC (LISTGET NEWLOOKS 'SIZEINCREMENT))
                (SETQ OFFSETINC (LISTGET NEWLOOKS 'OFFSETINCREMENT))
                (SETQ STYLE (LISTGET NEWLOOKS 'STYLE))
                (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS))
                (SETQ USERINFO (LISTGET NEWLOOKS 'USERINFO))
                (SETQ UISET (FMEMB 'USERINFO NEWLOOKS))
                (SETQ NEWLOOKS NIL)                          (* ; "Tell later code to use FOOLOOKS")

                (SETQ FOOLOOKS NIL)
                [COND
                   (FAMILY (SETQ FOOLOOKS (CONS 'FAMILY (CONS FAMILY FOOLOOKS]
                [COND
                   (FONT (COND
                            ((type?
 FONTCLASS FONT)      (* ; 

                                                         "Needn't do anything.  It's a font class.")

                             )
                            ([SETQ FONT (CAR (NLSETQ (\DTEST FONT 'FONTDESCRIPTOR]
                                                             (* ; 

                                    "Try converting it to a font--it might be a list or some such.")

                             )
                            (T                               (* ; 

                                    "Nothing doing--it isn't any of the reasonable forms, so punt.")

                               (TEDIT.PROMPTPRINT (CONCAT FONT " isn't a valid font descriptor.")
                                      T)
                               (RETURN]
                [COND
                   [(OR WEIGHT SLOPE EXPANSION)              (* ; 

                                                 "Setting one of these inhibits the FACE parameter")

                    [AND WEIGHT (SETQ FOOLOOKS (CONS 'WEIGHT (CONS WEIGHT FOOLOOKS]
                    [AND SLOPE (SETQ FOOLOOKS (CONS 'SLOPE (CONS SLOPE FOOLOOKS]
                    (AND EXPANSION (SETQ FOOLOOKS (CONS 'EXPANSION (CONS EXPANSION FOOLOOKS]
                   (FACE (SETQ FOOLOOKS (CONS 'FACE (CONS FACE FOOLOOKS]
                (COND
                   [SIZE (SETQ FOOLOOKS (CONS 'SIZE (CONS SIZE FOOLOOKS]
                   (SIZEINC (SETQ FOOLOOKS (CONS 'SIZE (CONS 'BOGUSSIZE FOOLOOKS]
          (replace
 (TEXTOBJ \DIRTY) of
 TEXTOBJ with
 T)
                                                             (* ; "Mark the document changed.")

          (SETQ CHLIM (IMIN (ADD1 (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                            (IPLUS CH# LEN)))                (* ; "last ch to change")

          (SETQ PC1 (\CHTOPC CH# PCTB T))                    (* ; "Piece the first ch is in")

          (COND
             ((IGREATERP CH# START-OF-PIECE)                 (* ; 

                                                       "If CH# is not first ch in piece, split it.")

              (SETQ PC1 (\SPLITPIECE PC1 (- CH# START-OF-PIECE)
                               TEXTOBJ PCNO1))               (* ; 

                                               "Take 2nd half of the split, which starts with CH#.")

              (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
                                                             (* ; 

                                            "NB: \SplitPiece may make a new PCTB, so copy it here.")

              ))
          (SETQ PCN (\CHTOPC CHLIM PCTB T))
          (COND
             ((IEQP CHLIM START-OF-PIECE)                    (* ; 

                                  "CHLIM+1 is the start of a new piece.  just use prevpiece as pcn")

              (SETQ PCN (\CHTOPC (SUB1 CHLIM)
                               PCTB T)))
             (T                                              (* ; 

        "If the last char isn't the last char in the piece, then split it and take the first half.")

                (\SPLITPIECE PCN (- CHLIM START-OF-PIECE)
                       TEXTOBJ PCNON)))
          [COND
             (NEWLOOKS 

                    (* ;; "For the case of a completely specified looks, do the following outside the loop: Make sure that this isn't a duplicate set of looks for this document.")


                    (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
 NEWLOOKS TEXTOBJ]
          [bind
 (PC _ PC1)
                 NEWPCLOOKS while
 (AND PC (NEQ PC PCN))
             do

             (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch
 (PIECE PLOOKS) of
 PC))) 
                                                             (* ; "Save old looks for the Undo.")

             (COND
                (NEWLOOKS                                    (* ; 

                                                           "We got a CHARLOOKS in.  Just use it")

                       (replace
 (PIECE PLOOKS) of
 PC with
 NEWLOOKS))
                (T                                           (* ; 

                                                       "Otherwise, we have to override selectively")

                   [replace
 (PIECE PLOOKS) of
 PC with
 (SETQ NEWPCLOOKS
                                                                   (create
 CHARLOOKS
                                                                      using
 (fetch

                                                                                 (PIECE PLOOKS)
                                                                                   of
 PC]

                   (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font.")


                   [replace
 (CHARLOOKS CLFONT) of
 NEWPCLOOKS
                      with

                      (SETQ NEWFONT
                       (OR FONT (\TEDIT.FONTCOPY

                                 (fetch
 (CHARLOOKS CLFONT) of
 (fetch
 (PIECE PLOOKS)
                                                                         of
 PC))
                                 (COND
                                    (SIZEINC                 (* ; 

                                   "There's a size change requested.  Fix up the size of the font.")

                                           (LISTPUT FOOLOOKS 'SIZE
                                                  (IPLUS (FONTPROP (fetch
 (CHARLOOKS CLFONT)
                                                                      of
 (fetch
 (PIECE PLOOKS
                                                                                               )
                                                                                of
 PC))
                                                                'SIZE)
                                                         SIZEINC))
                                           FOOLOOKS)
                                    (T FOOLOOKS))
                                 TEXTOBJ]                    (* ; "Give this piece its new looks")

                   [replace
 (CHARLOOKS CLBOLD) of
 NEWPCLOOKS
                      with
 (EQ 'BOLD (FONTPROP NEWFONT 'WEIGHT]
                   [replace
 (CHARLOOKS CLITAL) of
 NEWPCLOOKS
                      with
 (EQ 'ITALIC (FONTPROP NEWFONT 'SLOPE]
                   [AND PROT (replace
 (CHARLOOKS CLPROTECTED) of
 NEWPCLOOKS
                                with
 (EQ PROT 'ON]
                   [AND SELHERE (replace
 (CHARLOOKS CLSELHERE) of
 NEWPCLOOKS
                                   with
 (EQ SELHERE 'ON]
                   [AND ULINE (replace
 (CHARLOOKS CLULINE) of
 NEWPCLOOKS
                                 with
 (EQ ULINE 'ON]
                   [AND OLINE (replace
 (CHARLOOKS CLOLINE) of
 NEWPCLOOKS
                                 with
 (EQ OLINE 'ON]
                   [AND STRIKE (replace
 (CHARLOOKS CLSTRIKE) of
 NEWPCLOOKS
                                  with
 (EQ STRIKE 'ON]
                   [AND INVISIBLE (replace
 (CHARLOOKS CLINVISIBLE) of
 NEWPCLOOKS
                                     with
 (EQ INVISIBLE 'ON]
                   (AND SUPER (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS with
 SUPER))
                   (AND SUB (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS with
 (IMINUS
                                                                                          SUB)))
                   (AND STYLESET (replace
 (CHARLOOKS CLSTYLE) of
 NEWPCLOOKS with
 STYLE))
                   (AND UISET (replace
 (CHARLOOKS CLUSERINFO) of
 NEWPCLOOKS with
 USERINFO
                                     ))
                   (AND OFFSETINC (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS
                                     with
 (IPLUS (OR (fetch
 (CHARLOOKS CLOFFSET) of

                                                                                         NEWPCLOOKS)
                                                         0)
                                                     OFFSETINC)))
                   [AND INVERSEVIDEO (replace
 (CHARLOOKS CLINVERTED) of
 NEWPCLOOKS
                                        with
 (EQ INVERSEVIDEO 'ON]
                   (replace
 (CHARLOOKS CLSIZE) of
 NEWPCLOOKS with
 (FONTPROP NEWFONT
                                                                                     'SIZE))
                   (replace
 (PIECE PLOOKS) of
 PC with
 (\TEDIT.UNIQUIFY.CHARLOOKS

                                                                   NEWPCLOOKS TEXTOBJ))
                                                             (* ; 

                                    "Assure that each set of looks appears only once in the world.")

                   ))
             [COND
                ((EQ PC \INPC)
                 (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ with
 (

                                                                          \TEDIT.CARETLOOKS.VERIFY

                                                                            TEXTOBJ
                                                                            (fetch
 (PIECE PLOOKS)
                                                                               of
 PC]
             (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC))
             finally

             (OR PC (RETURN))
             (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch
 (PIECE PLOOKS) of
 PC)))
             (COND
                (NEWLOOKS                                    (* ; 

                                                           "We got a CHARLOOKS in.  Just use it")

                       (replace
 (PIECE PLOOKS) of
 PC with
 NEWLOOKS))
                (T                                           (* ; 

                                                       "Otherwise, we have to override selectively")

                 [replace
 (PIECE PLOOKS) of
 PC with
 (SETQ NEWPCLOOKS
                                                                 (create
 CHARLOOKS
                                                                    using
 (fetch
 (PIECE
                                                                                          PLOOKS)
                                                                                 of
 PC]

                 (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font.")


                 [replace
 (CHARLOOKS CLFONT) of
 NEWPCLOOKS
                    with

                    (SETQ NEWFONT
                     (OR FONT (\TEDIT.FONTCOPY

                               (fetch
 (CHARLOOKS CLFONT) of
 (fetch
 (PIECE PLOOKS)
                                                                       of
 PC))
                               (COND
                                  (SIZEINC (PROGN (LISTPUT FOOLOOKS 'SIZE
                                                         (IPLUS (FONTPROP (fetch
 (CHARLOOKS
                                                                                      CLFONT)
                                                                             of

                                                                             (fetch
 (PIECE PLOOKS
                                                                                               )
                                                                                of
 PC))
                                                                       'SIZE)
                                                                SIZEINC))
                                                  FOOLOOKS))
                                  (T FOOLOOKS))
                               TEXTOBJ]                      (* ; "Give this piece its new looks")

                 [replace
 (CHARLOOKS CLBOLD) of
 NEWPCLOOKS with

                                                                   (EQ 'BOLD (FONTPROP NEWFONT
                                                                                    'WEIGHT]
                 [replace
 (CHARLOOKS CLITAL) of
 NEWPCLOOKS with

                                                                   (EQ 'ITALIC (FONTPROP NEWFONT
                                                                                      'SLOPE]
                 [AND PROT (replace
 (CHARLOOKS CLPROTECTED) of
 NEWPCLOOKS
                              with
 (EQ PROT 'ON]
                 [AND SELHERE (replace
 (CHARLOOKS CLSELHERE) of
 NEWPCLOOKS
                                 with
 (EQ SELHERE 'ON]
                 [AND ULINE (replace
 (CHARLOOKS CLULINE) of
 NEWPCLOOKS
                               with
 (EQ ULINE 'ON]
                 [AND OLINE (replace
 (CHARLOOKS CLOLINE) of
 NEWPCLOOKS
                               with
 (EQ OLINE 'ON]
                 [AND STRIKE (replace
 (CHARLOOKS CLSTRIKE) of
 NEWPCLOOKS
                                with
 (EQ STRIKE 'ON]
                 (AND SUPER (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS with
 SUPER))
                 (AND SUB (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS with
 (IMINUS SUB)))
                 [AND INVISIBLE (replace
 (CHARLOOKS CLINVISIBLE) of
 NEWPCLOOKS
                                   with
 (EQ INVISIBLE 'ON]
                 [AND INVERSEVIDEO (replace
 (CHARLOOKS CLINVERTED) of
 NEWPCLOOKS
                                      with
 (EQ INVERSEVIDEO 'ON]
                 [AND OFFSETINC (replace
 (CHARLOOKS CLOFFSET) of
 NEWPCLOOKS
                                   with
 (IPLUS OFFSETINC (OR (fetch
 (CHARLOOKS CLOFFSET)
                                                                    of
 NEWPCLOOKS)
                                                                 0]
                 (AND STYLESET (replace
 (CHARLOOKS CLSTYLE) of
 NEWPCLOOKS with
 STYLE))
                 (AND UISET (replace
 (CHARLOOKS CLUSERINFO) of
 NEWPCLOOKS with
 USERINFO))
                 (replace
 (CHARLOOKS CLSIZE) of
 NEWPCLOOKS with
 (FONTPROP NEWFONT
                                                                                   'SIZE))
                 (replace
 (PIECE PLOOKS) of
 PC with
 (\TEDIT.UNIQUIFY.CHARLOOKS
 
                                                                       NEWPCLOOKS TEXTOBJ]
          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CHLIM)
          (COND
             ((fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)
              (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
                     NIL NIL)
              (TEDIT.RESET.EXTEND.PENDING.DELETE (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
              (TEDIT.UPDATE.SCREEN TEXTOBJ)                  (* ; "Update the screen image")

              (\FIXSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
                     TEXTOBJ)
              (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
                     NIL T)))
          (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
          (RETURN (LIST OLDLOOKSLIST NLOOKSAVE PC1])

(TEDIT.LOOKS

  [LAMBDA (STREAM NEWLOOKS SELORCH# LEN)
                 (* ; "Edited 30-May-91 21:41 by jds")


    (* ;; "Programmatic interface for character looks in TEdit")


    (PROG ((TEXTOBJ (TEXTOBJ STREAM))
           TSEL CHANGERESULT)
          [SETQ TSEL (COND
                        ((type?
 SELECTION SELORCH#)
                         SELORCH#)
                        (SELORCH# (TEDIT.SETSEL TEXTOBJ SELORCH# LEN 'LEFT))
                        (T (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ]
          (COND
             ((NOT (fetch
 (SELECTION SET) of
 TSEL))  (* ; 

                                         "No selection to change the looks of.  Can't do anything!")

              (RETURN)))
          (COND
             ((SETQ CHANGERESULT (\TEDIT.CHANGE.LOOKS
 STREAM NEWLOOKS (fetch
 (SELECTION
                                                                                      CH#)
                                                                             of
 TSEL)
                                        (fetch
 (SELECTION DCH) of
 TSEL)))
                                                             (* ; "Go actually change the looks")

              (\TEDIT.HISTORYADD TEXTOBJ (create
 TEDITHISTORYEVENT
                                                THACTION _ 'Looks
                                                THLEN _ (fetch
 (SELECTION DCH) of
 TSEL)
                                                THCH# _ (fetch
 (SELECTION CH#) of
 TSEL)
                                                THFIRSTPIECE _ (CADDR CHANGERESULT)
                                                THOLDINFO _ (CAR CHANGERESULT)
                                                THAUXINFO _ (CADR CHANGERESULT)))
                                                             (* ; "Save this action for undo/redo")

              ])

(\TEDIT.LOOKS

  [LAMBDA (TEXTOBJ)
                                      (* ; "Edited 30-May-91 21:41 by jds")


    (* ;; "Handler for the middle-button menu's LOOKS button.  Brings up 3 menus, for font, face, and size.  Then calls TEDIT.LOOKS to make the requested changes.")


    (LET* [(SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (FONT NIL)
           (FACE NIL)
           (SIZE NIL)
           NEWLOOKS
           (REGION (WINDOWPROP (CAR (fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ))
                          'REGION))
           (POS (create
 POSITION
                       XCOORD _ (fetch
 LEFT of
 REGION)
                       YCOORD _ (fetch
 TOP of
 REGION]
          (COND
             ((IGREATERP (fetch
 (SELECTION CH#) of
 SEL)
                     (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                                                             (* ; "Nothing to change, really")

              )
             [(fetch
 (SELECTION SET) of
 SEL)         (* ; "He's got something selected.")

              (CURSORPOSITION (CREATEPOSITION 0 (fetch
 HEIGHT of
 REGION))
                     (CAR (fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)))
              (SETQ FONT (MENU (create
 MENU
                                      TITLE _ "Font:"
                                      ITEMS _ (NCONC1 (COPY TEDIT.KNOWN.FONTS)
                                                     (LIST 'Other (LIST (FUNCTION TEDIT.NEW.FONT)
                                                                        TEXTOBJ)))
                                      CENTERFLG _ T)
                               POS))                         (* ; "Set the font for the new text.")

              (SETQ FACE (SELECTQ (MENU TEDIT.FACE.MENU POS)
                             (Bold 'BOLD)
                             (Italic 'ITALIC)
                             (Bold% Italic 'BOLDITALIC)
                             (Regular 'STANDARD)
                             NIL))                           (* ; "Set the face (bold, etc.)")

              (SETQ SIZE (MENU TEDIT.SIZE.MENU POS))         (* ; "Set the type size")

                                                             (* ; 

                                                         "Construct the set of new looks to apply:")

              (COND
                 (FONT (SETQ NEWLOOKS (LIST 'FAMILY FONT)))
                 (T (SETQ NEWLOOKS NIL)))                    (* ; "The font")

              [COND
                 (FACE (SETQ NEWLOOKS (CONS 'FACE (CONS FACE NEWLOOKS]
                                                             (* ; "The face")

              [COND
                 (SIZE (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS]
                                                             (* ; "The size")

              (COND
                 (NEWLOOKS                                   (* ; 

                                                           "If there's something to do, do it.")

                        (TEDIT.LOOKS
 TEXTOBJ NEWLOOKS SEL]
             (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T])

(\TEDIT.FONTCOPY

  (LAMBDA (FONT NEWSPECS TEXTOBJ)
                            (* jds "26-Dec-84 16:06")

          
          (* Cloak FONTCOPY in protection for the user from an unavailable font.)


    (COND
       ((NULL NEWSPECS)                                      (* No changes specified.

                                                             Punt it.)

        FONT)
       ((CAR (NLSETQ (FONTCOPY FONT NEWSPECS))))
       (T (PROG ((OLDFAMILY (FONTPROP FONT 'FAMILY))
                 (OLDSIZE (FONTPROP FONT 'SIZE)))
                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Can't find font " (OR (LISTGET NEWSPECS
                                                                                 'FAMILY)
                                                                          OLDFAMILY)
                                                  " "
                                                  (OR (LISTGET NEWSPECS 'SIZE)
                                                      OLDSIZE)
                                                  " "
                                                  (OR (LISTGET NEWSPECS 'FACE)
                                                      (FONTPROP FONT 'FACE)))
                       T))
          FONT))))

(TEDIT.GET.LOOKS

  [LAMBDA (TEXTOBJ CH#ORCHARLOOKS)
                       (* ; "Edited 30-May-91 21:44 by jds")

                                                             (* Return a PLIST of character looks)

    (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
           LOOKS FONT NLOOKS)
          [COND
             ((type?
 CHARLOOKS CH#ORCHARLOOKS)           (* He handed us a CHARLOOKS.

                                                           Unparse it for him.)

              (SETQ LOOKS CH#ORCHARLOOKS))
             ((ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                                                             (* There's no text in the document.

                                                           Use the extant caret looks.)

              (SETQ LOOKS (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)))
             [(FIXP CH#ORCHARLOOKS)                          (* He gave us a CH# to geth the 

                                                           looks of. Grab it.)

              (SETQ LOOKS (fetch
 (PIECE PLOOKS) of
 (\CHTOPC (IMIN (fetch
 (TEXTOBJ TEXTLEN
                                                                                            )
                                                                             of
 TEXTOBJ)
                                                                          CH#ORCHARLOOKS)
                                                                  (fetch
 (TEXTOBJ PCTB)
                                                                     of
 TEXTOBJ]
             [(type?
 SELECTION CH#ORCHARLOOKS)           (* Get the looks of the selected 

                                                           text)

              (SETQ LOOKS (fetch
 (PIECE PLOOKS) of
 (\CHTOPC (IMIN (fetch
 (TEXTOBJ TEXTLEN
                                                                                            )
                                                                             of
 TEXTOBJ)
                                                                          (fetch
 (SELECTION
                                                                                      CH#)
                                                                             of
 CH#ORCHARLOOKS))
                                                                  (fetch
 (TEXTOBJ PCTB)
                                                                     of
 TEXTOBJ]
             ((NULL CH#ORCHARLOOKS)                          (* Get the looks of the selected 

                                                           text)

              (SETQ LOOKS (fetch
 (PIECE PLOOKS) of
 (\CHTOPC (IMIN (fetch
 (TEXTOBJ TEXTLEN
                                                                                            )
                                                                             of
 TEXTOBJ)
                                                                          (fetch
 (SELECTION
                                                                                      CH#)
                                                                             of

                                                                             (fetch
 (TEXTOBJ
                                                                                         SEL)
                                                                                of
 TEXTOBJ)))
                                                                  (fetch
 (TEXTOBJ PCTB)
                                                                     of
 TEXTOBJ]

         (* * Now break the looks apart into a PROPLIST)


          (SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST
 LOOKS))
          (RETURN NLOOKS])
)



(* ; "Paragraph looks functions")


(DEFINEQ

(\TEDIT.GET.PARALOOKS

  [LAMBDA (FILE PARAHASH)
                                (* ; "Edited 18-Dec-88 17:47 by jds")


    (* ;; "Read a paragraph format spec from the FILE, and return it for later use.")


    (* ;; "Paragraph format # of 0 indicates an end-of-file dummy, used to preserve the paralooks of EOF para break.")


    (LET ((LOOKS# (\SMALLPIN FILE)))
         (COND
            ((ZEROP LOOKS#)
             NIL)
            (T (ELT PARAHASH LOOKS#])

(EQFMTSPEC

  [LAMBDA (PARALOOK1 PARALOOK2)
               (* ; 

                                                "Edited  2-Jul-93 21:32 by sybalskY:MV:ENVOS")


    (* ;; "Given two sets of FMTSPECS, are they effectively the same?")


    (OR (EQ PARALOOK1 PARALOOK2)
        (AND (EQ (fetch
 (FMTSPEC QUAD) of
 PARALOOK1)
                 (fetch
 (FMTSPEC QUAD) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTNEWPAGEBEFORE) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTNEWPAGEBEFORE) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTNEWPAGEAFTER) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTNEWPAGEAFTER) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTSTYLE) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTSTYLE) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTSPECIALX) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTSPECIALX) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTSPECIALY) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTSPECIALY) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTHEADINGKEEP) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTHEADINGKEEP) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTKEEP) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTKEEP) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTPARATYPE) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTPARATYPE) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTPARASUBTYPE) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTPARASUBTYPE) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTHARDCOPY) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTHARDCOPY) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTREVISED) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTREVISED) of
 PARALOOK2))
             (EQ (ffetch
 (FMTSPEC FMTCOLUMN) of
 PARALOOK1)
                 (ffetch
 (FMTSPEC FMTCOLUMN) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC 1STLEFTMAR) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC 1STLEFTMAR) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC LEFTMAR) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC LEFTMAR) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC RIGHTMAR) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC RIGHTMAR) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC LEADBEFORE) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC LEADBEFORE) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC LEADAFTER) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC LEADAFTER) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC LINELEAD) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC LINELEAD) of
 PARALOOK2))
             (EQP (ffetch
 (FMTSPEC FMTBASETOBASE) of
 PARALOOK1)
                  (ffetch
 (FMTSPEC FMTBASETOBASE) of
 PARALOOK2))
             (EQUAL (ffetch
 (FMTSPEC FMTUSERINFO) of
 PARALOOK1)
                    (ffetch
 (FMTSPEC FMTUSERINFO) of
 PARALOOK2))
             (EQUAL (ffetch
 (FMTSPEC FMTCHARSTYLES) of
 PARALOOK1)
                    (ffetch
 (FMTSPEC FMTCHARSTYLES) of
 PARALOOK2))
             (EQUALALL (ffetch
 (FMTSPEC TABSPEC) of
 PARALOOK1)
                    (ffetch
 (FMTSPEC TABSPEC) of
 PARALOOK2])

(\TEDIT.UNIQUIFY.PARALOOKS

  [LAMBDA (NEWLOOKS TEXTOBJ)
                             (* ; "Edited 30-May-91 21:41 by jds")


         (* Assure that there is only ONE of a given PARALOOKS in the document--so that 

       all instances of that set of looks share structure.)


    (COND
       ((for
 LOOK in
 (fetch
 (TEXTOBJ TXTPARALOOKSLIST) of
 TEXTOBJ)
           thereis
 (EQFMTSPEC
 NEWLOOKS LOOK)))
       (T (push
 (fetch
 (TEXTOBJ TXTPARALOOKSLIST) of
 TEXTOBJ)
                 NEWLOOKS)
          NEWLOOKS])

(TEDIT.GET.PARALOOKS

  [LAMBDA (TEXTSTREAM SELORCH#)
                          (* ; "Edited 30-May-91 21:44 by jds")

                                                             (* ; 

            "Return a proplist of paragraph formatting information about the characters specified.")

    (LET* [(TEXTOBJ (TEXTOBJ TEXTSTREAM))
           (SEL (OR SELORCH# (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ]
          (\TEDIT.UNPARSE.PARALOOKS.LIST
 (fetch
 (PIECE PPARALOOKS)
                                                of

                                                (\CHTOPC (CL:TYPECASE SEL
                                                             (SELECTION (fetch
 (SELECTION CH#)
                                                                           of
 SEL))
                                                             ((OR FIXP SMALLP) 
                                                                (IMAX 1 (IMIN SEL (fetch

                                                                                   (TEXTOBJ TEXTLEN)
                                                                                     of
 TEXTOBJ))
                                                                      ))
                                                             (T (\ILLEGAL.ARG SEL)))
                                                       (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ])

(\TEDIT.UNPARSE.PARALOOKS.LIST

  [LAMBDA (FMTSPEC)
                                      (* ; "Edited 30-May-91 21:48 by jds")

                                                             (* ; 

                         "Convert a FMTSPEC into an equivalent PList-form for external consumption")

    (PROG ((NEWLOOKS NIL))
          (for
 PROP in
 (LIST (fetch
 (FMTSPEC QUAD) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC 1STLEFTMAR) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC LEFTMAR) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC RIGHTMAR) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC LEADBEFORE) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC LEADAFTER) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC LINELEAD) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTBASETOBASE) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC TABSPEC) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTSTYLE) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTCHARSTYLES) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTUSERINFO) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTSPECIALX) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTSPECIALY) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTPARATYPE) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTPARASUBTYPE) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTNEWPAGEBEFORE) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTNEWPAGEAFTER) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTHEADINGKEEP) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTKEEP) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTHARDCOPY) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTREVISED) of
 FMTSPEC)
                                     (fetch
 (FMTSPEC FMTCOLUMN) of
 FMTSPEC)) as
 PROPNAME
             in
 '(QUAD 1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING 
                           LINELEADING BASETOBASE TABS STYLE CHARSTYLES USERINFO SPECIALX SPECIALY 
                           TYPE SUBTYPE NEWPAGEBEFORE NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY REVISED
                           COLUMN) as
 METHOD
             in
 '(VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE 
                            VALUE VALUE VALUE VALUE VALUE ONOFF VALUE VALUE VALUE VALUE)
             do
 (SELECTQ METHOD
                        (VALUE                               (* ; 

                                                       "Give him the value straight from the looks")

                               (push
 NEWLOOKS PROP))
                        (ONOFF                               (* ; "Translate T/NIL into ON/OFF")

                               (push
 NEWLOOKS (ONOFF PROP)))
                        (SHOULDNT))
                   (push
 NEWLOOKS PROPNAME))
          (RETURN NEWLOOKS])

(\TEDIT.PARSE.PARALOOKS.LIST

  [LAMBDA (NEWLOOKS OLDLOOKS)
                 (* ; 

                                                "Edited  3-Jul-93 21:49 by sybalskY:MV:ENVOS")

                                                             (* ; 

                      "Apply a given format spec to the paragraphs which are included in this guy.")

    (PROG (D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC QUADD 
             NLOOKSAVE PC1 TYPE SUBTYPE TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET 
             NEWAFTER KEEP KEEPSET HEADINGKEEP BASETOBASE BASESET REVISED REVISEDSET COLUMN COLUMNSET
             USERINFO USERINFOSET SPECIALX SPECXSET SPECIALY SPECYSET STYLE STYLESET CHARSTYLES 
             CHARSTYLESSET)
          (COND
             ((type?
 FMTSPEC NEWLOOKS)                   (* ; 

                    "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected")

              (RETURN NEWLOOKS))
             (T                                              (* ; 

                                                           "create an FMTSPEC from the Alist")

                (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN))
                (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN))
                (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN))
                (SETQ LEADB (LISTGET NEWLOOKS 'PARALEADING))
                (SETQ LEADA (LISTGET NEWLOOKS 'POSTPARALEADING))
                (SETQ LLEAD (LISTGET NEWLOOKS 'LINELEADING))
                (SETQ TYPESET (FMEMB 'TYPE NEWLOOKS))
                (SETQ TYPE (LISTGET NEWLOOKS 'TYPE))
                (SETQ SUBTYPESET (FMEMB 'SUBTYPE NEWLOOKS))
                (SETQ SUBTYPE (LISTGET NEWLOOKS 'SUBTYPE))
                (SETQ NEWBEFORESET (FMEMB 'NEWPAGEBEFORE NEWLOOKS))
                (SETQ NEWBEFORE (LISTGET NEWLOOKS 'NEWPAGEBEFORE))
                (SETQ NEWAFTERSET (FMEMB 'NEWPAGEAFTER NEWLOOKS))
                (SETQ NEWAFTER (LISTGET NEWLOOKS 'NEWPAGEAFTER))
                (SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP))
                                                             (* ; "Keep for headings")

                (SETQ KEEP (LISTGET NEWLOOKS 'KEEP))         (* ; 

                                     "More general `Keep-together' spec -- undefined as of 5/22/85")

                (SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS))
                (SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE))
                (SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS))
                (SETQ REVISED (LISTGET NEWLOOKS 'REVISED))
                (SETQ REVISEDSET (FMEMB 'REVISED NEWLOOKS))
                (SETQ QUADD (LISTGET NEWLOOKS 'QUAD))
                (SETQ COLUMN (LISTGET NEWLOOKS 'COLUMN))
                (SETQ COLUMNSET (FMEMB 'COLUMN NEWLOOKS))
                (SETQ USERINFO (LISTGET NEWLOOKS 'USERINFO))
                (SETQ USERINFOSET (FMEMB 'USERINFO NEWLOOKS))
                (SETQ SPECIALX (LISTGET NEWLOOKS 'SPECIALY))
                (SETQ SPECXSET (FMEMB 'SPECIALY NEWLOOKS))
                (SETQ SPECIALY (LISTGET NEWLOOKS 'SPECIALY))
                (SETQ SPECYSET (FMEMB 'SPECIALY NEWLOOKS))
                (SETQ STYLE (LISTGET NEWLOOKS 'STYLE))
                (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS))
                (SETQ CHARSTYLES (LISTGET NEWLOOKS 'CHARSTYLES))
                (SETQ CHARSTYLESSET (FMEMB 'CHARSTYLES NEWLOOKS))
                [SELECTQ QUADD
                    ((LEFT RIGHT CENTERED JUSTIFIED NIL)     (* ; 

                                                  "Do nothing -- we got a valid justification spec")

                         )
                    ((JUST J) 
                         (SETQ QUADD 'JUSTIFIED))
                    ((L) 
                         (SETQQ QUADD LEFT))
                    (R (SETQQ QUADD RIGHT))
                    ((C CENTER) 
                         (SETQQ QUADD CENTERED))
                    (PROGN                                   (* ; 

                                                         "We got an illegal QUAD value.  Use LEFT.")

                           (TEDIT.PROMPTPRINT (AND (BOUNDP 'TEXTOBJ)
                                                   TEXTOBJ)
                                  (CONCAT "Illegal paragraph quad " QUADD ", replaced with LEFT.")
                                  T)
                           (SETQ QUADD 'LEFT]
                (SETQ TABSPECC (LISTGET NEWLOOKS 'TABS))

                (* ;; "change from the users list to the real tabspec 

CONS pair of default width and LIST of TAB record instances")


                [COND
                   (TABSPECC (SETQ TABSPECC (CONS [OR (CAR TABSPECC)
                                                      (AND OLDLOOKS (CAR (fetch
 (FMTSPEC TABSPEC)
                                                                            of
 OLDLOOKS]
                                                  (for
 SPEC in
 (CDR TABSPECC)
                                                     collect
 (create
 TAB
                                                                        TABKIND _ (CDR SPEC)
                                                                        TABX _ (CAR SPEC]
                (SETQ NEWLOOKS (create
 FMTSPEC using
 (OR OLDLOOKS TEDIT.DEFAULT.FMTSPEC)))
                (AND 1STLEFT (replace
 (FMTSPEC 1STLEFTMAR) of
 NEWLOOKS with
 1STLEFT))
                (AND LEFT (replace
 (FMTSPEC LEFTMAR) of
 NEWLOOKS with
 LEFT))
                (AND RIGHT (replace
 (FMTSPEC RIGHTMAR) of
 NEWLOOKS with
 RIGHT))
                (AND LEADB (replace
 (FMTSPEC LEADBEFORE) of
 NEWLOOKS with
 LEADB))
                (AND LEADA (replace
 (FMTSPEC LEADAFTER) of
 NEWLOOKS with
 LEADA))
                (AND LLEAD (replace
 (FMTSPEC LINELEAD) of
 NEWLOOKS with
 LLEAD))
                (AND TABSPECC (replace
 (FMTSPEC TABSPEC) of
 NEWLOOKS with
 TABSPECC))
                (AND QUADD (replace
 (FMTSPEC QUAD) of
 NEWLOOKS with
 QUADD))
                (AND TYPESET (replace
 (FMTSPEC FMTPARATYPE) of
 NEWLOOKS with
 TYPE))
                (AND SUBTYPESET (replace
 (FMTSPEC FMTPARASUBTYPE) of
 NEWLOOKS with
 
                                                                                            SUBTYPE))
                (AND NEWBEFORESET (replace
 (FMTSPEC FMTNEWPAGEBEFORE) of
 NEWLOOKS
                                     with
 NEWBEFORE))
                (AND NEWAFTERSET (replace
 (FMTSPEC FMTNEWPAGEAFTER) of
 NEWLOOKS with

                                                                                        NEWAFTER))
                [AND HEADINGKEEP (replace
 (FMTSPEC FMTHEADINGKEEP) of
 NEWLOOKS
                                    with
 (EQ HEADINGKEEP 'ON]
                (AND KEEPSET (replace
 (FMTSPEC FMTKEEP) of
 NEWLOOKS with
 KEEP))
                (AND BASESET (replace
 (FMTSPEC FMTBASETOBASE) of
 NEWLOOKS with
 BASETOBASE
                                    ))
                (AND REVISEDSET (replace
 (FMTSPEC FMTREVISED) of
 NEWLOOKS with
 REVISED))
                (AND COLUMNSET (replace
 (FMTSPEC FMTCOLUMN) of
 NEWLOOKS with
 COLUMN))
                (AND SPECXSET (replace
 (FMTSPEC FMTSPECIALX) of
 NEWLOOKS with
 SPECIALX))
                (AND SPECYSET (replace
 (FMTSPEC FMTSPECIALY) of
 NEWLOOKS with
 SPECIALY))
                (AND STYLESET (replace
 (FMTSPEC FMTSTYLE) of
 NEWLOOKS with
 STYLE))
                (AND CHARSTYLESSET (replace
 (FMTSPEC FMTCHARSTYLES) of
 NEWLOOKS with

                                                                                        CHARSTYLES))
                (AND USERINFOSET (replace
 (FMTSPEC FMTUSERINFO) of
 NEWLOOKS with
 USERINFO
                                        ))
                (RETURN NEWLOOKS])

(TEDIT.PARALOOKS

  [LAMBDA (TEXTOBJ NEWLOOKS SEL LEN)
                     (* ; "Edited 21-Apr-93 18:44 by jds")


    (* ;; "Apply a given format spec to the paragraphs which are included in this guy.")


    (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
    (PROG ([SEL (COND
                   ((type?
 SELECTION SEL)
                    SEL)
                   ((FIXP SEL)
                    (TEDIT.SETSEL TEXTOBJ SEL LEN 'RIGHT))
                   (T (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ]
           CH# CHLIM REPLACEALLFIELDS D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB 
           LEADA BLEAD BLEADSET LLEAD TABSPECC QUADD NLOOKSAVE PC1 OLDLOOKSLIST TYPE SUBTYPE TYPESET
           SUBTYPESET SPECIALX SPECIALY NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET 
           HEADINGKEEP BASETOBASE BASESET HCPYMODE HCPYSET USERINFO USERSET REVISED REVISEDSET STYLE
           STYLESET CHARSTYLES CHARSTYLESSET COLUMN COLUMNSET STYLE STYLESET START-OF-PIECE OLDSTART)
          (SETQ CH# (fetch
 (SELECTION CH#) of
 SEL))  (* ; "First affected character")

          (SETQ CHLIM (IMIN (IMAX CH# (SUB1 (fetch
 (SELECTION CHLIM) of
 SEL)))
                            (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)))
                                                             (* ; "Last affected character.")

          (COND
             ((IGREATERP CH# (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                                                             (* ; 

                                     "Can't change the para looks of something beyond end of text.")

              (RETURN))
             ((NOT (fetch
 (SELECTION SET) of
 SEL))   (* ; 

                              "Can't do anything if there is no selection set in the main document")

              (RETURN)))
          (COND
             ((NOT (fetch
 (TEXTOBJ FORMATTEDP) of
 TEXTOBJ))
              (\TEDIT.CONVERT.TO.FORMATTED
 TEXTOBJ)))
          (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
                                                             (* ; 

                                          "Because it may grow during the conversion to formatted.")

          (SETQ PC (\CHTOPC CH# PCTB T))
          (SETQ OLDSTART START-OF-PIECE)
          (SETQ PC1 PC)
          (SETQ NLOOKSAVE NEWLOOKS)
          [COND
             ((type?
 FMTSPEC NEWLOOKS)                   (* ; 

                    "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected")

              (SETQ D (create
 FMTSPEC copying
 NEWLOOKS))
                                                             (* ; 

                                                           "Create the universal replacement looks")

              (SETQ REPLACEALLFIELDS T)                      (* ; 

                                                           "And set the replace-everything flag.")

              )
             (T                                              (* ; 

                                                           "create an FMTSPEC from the Alist")

                (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN))
                (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN))
                (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN))
                (SETQ LEADB (LISTGET NEWLOOKS 'PARALEADING))
                (SETQ LEADA (LISTGET NEWLOOKS 'POSTPARALEADING))
                (SETQ LLEAD (LISTGET NEWLOOKS 'LINELEADING))
                (SETQ BLEAD (LISTGET NEWLOOKS 'BASETOBASE))
                (SETQ BLEADSET (FMEMB 'BASETOBASE NEWLOOKS))
                (SETQ QUADD (LISTGET NEWLOOKS 'QUAD))
                (SETQ TYPESET (FMEMB 'TYPE NEWLOOKS))
                (SETQ TYPE (LISTGET NEWLOOKS 'TYPE))
                (SETQ SUBTYPESET (FMEMB 'SUBTYPE NEWLOOKS))
                (SETQ SUBTYPE (LISTGET NEWLOOKS 'SUBTYPE))
                (SETQ SPECIALX (LISTGET NEWLOOKS 'SPECIALX))
                (SETQ SPECIALY (LISTGET NEWLOOKS 'SPECIALY))
                (SETQ NEWBEFORESET (FMEMB 'NEWPAGEBEFORE NEWLOOKS))
                (SETQ NEWBEFORE (LISTGET NEWLOOKS 'NEWPAGEBEFORE))
                (SETQ NEWAFTERSET (FMEMB 'NEWPAGEAFTER NEWLOOKS))
                (SETQ NEWAFTER (LISTGET NEWLOOKS 'NEWPAGEAFTER))
                (SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP))
                                                             (* ; "Keep for headings")

                (SETQ KEEP (LISTGET NEWLOOKS 'KEEP))         (* ; 

                                     "More general 'Keep-together' spec -- undefined as of 5/22/85")

                (SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS))
                (SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE))
                (SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS))
                (SETQ HCPYMODE (LISTGET NEWLOOKS 'HARDCOPY))
                (SETQ HCPYSET (FMEMB 'HARDCOPY NEWLOOKS))
                (SETQ USERINFO (LISTGET NEWLOOKS 'USERINFO))
                (SETQ USERSET (FMEMB 'USERINFO NEWLOOKS))
                (SETQ REVISED (LISTGET NEWLOOKS 'REVISED))
                (SETQ REVISEDSET (FMEMB 'REVISED NEWLOOKS))
                (SETQ TABSPECC (LISTGET NEWLOOKS 'TABS))
                (SETQ STYLE (LISTGET NEWLOOKS 'STYLE))
                (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS))
                (SETQ CHARSTYLES (LISTGET NEWLOOKS 'CHARSTYLES))
                (SETQ CHARSTYLESSET (FMEMB 'CHARSTYLES NEWLOOKS))
                (SETQ COLUMN (LISTGET NEWLOOKS 'COLUMN))
                (SETQ COLUMNSET (FMEMB 'COLUMN NEWLOOKS))
                (SETQ STYLE (LISTGET NEWLOOKS 'STYLE))
                (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS))

                (* ;; "change from the users list to the real tabspec --- CONS pair of default width and LIST of TAB record instances")


                (COND
                   (TABSPECC (SETQ TABSPECC (CONS [OR (COND
                                                         ((AND (CAR TABSPECC)
                                                               (ZEROP (CAR TABSPECC)))
                                                          1)
                                                         (T (CAR TABSPECC)))
                                                      (CAR (fetch
 (FMTSPEC TABSPEC)
                                                              of
 (fetch
 (PIECE PPARALOOKS)
                                                                        of
 PC]
                                                  (for
 SPEC in
 (CDR TABSPECC)
                                                     collect
 (create
 TAB
                                                                        TABKIND _ (CDR SPEC)
                                                                        TABX _ (CAR SPEC]
          [COND
             (REPLACEALLFIELDS 

                    (* ;; "Given that we're replacing the FMTSPEC wholesale, let's uniquify it within this document OUTSIDE the loop.")


                    (SETQ D (\TEDIT.UNIQUIFY.PARALOOKS
 D TEXTOBJ]
          (bind
 (NPC _ PC) while
 NPC
             do
 (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch
 (PIECE PPARALOOKS)
                                                               of
 NPC)))
                   [COND
                      (REPLACEALLFIELDS 

                             (* ;; "We're replacing the whole paragraph format.  Just smash the new one it;  it has been uniquified (and recorded in the master list) already.")


                             (replace
 (PIECE PPARALOOKS) of
 NPC with
 D))
                      (T                                     (* ; 

                               "Only replacing part of the looks;  create a new one, and smash it.")

                         (COND
                            [(NEQ (fetch
 (PIECE PPARALOOKS) of
 NPC)
                                  LASTLOOKS)                 (* ; 

                                                 "only build a new FMTSPEC when they are different")

                             (SETQ LASTLOOKS (ffetch
 (PIECE PPARALOOKS) of
 NPC))
                             (SETQ NEWLOOKS (create
 FMTSPEC using
 LASTLOOKS))
                             (AND 1STLEFT (freplace
 (FMTSPEC 1STLEFTMAR) of
 NEWLOOKS
                                             with
 1STLEFT))
                             (AND LEFT (freplace
 (FMTSPEC LEFTMAR) of
 NEWLOOKS with

                                                                                       LEFT))
                             (AND RIGHT (freplace
 (FMTSPEC RIGHTMAR) of
 NEWLOOKS with

                                                                                         RIGHT))
                             (AND LEADB (freplace
 (FMTSPEC LEADBEFORE) of
 NEWLOOKS
                                           with
 LEADB))
                             (AND LEADA (freplace
 (FMTSPEC LEADAFTER) of
 NEWLOOKS
                                           with
 LEADA))
                             (AND BLEADSET (freplace
 (FMTSPEC FMTBASETOBASE) of
 NEWLOOKS
                                              with
 BLEAD))
                             (AND LLEAD (freplace
 (FMTSPEC LINELEAD) of
 NEWLOOKS with

                                                                                         LLEAD))
                             (AND TABSPECC (freplace
 (FMTSPEC TABSPEC) of
 NEWLOOKS
                                              with
 TABSPECC))
                             (AND QUADD (freplace
 (FMTSPEC QUAD) of
 NEWLOOKS with
 QUADD))
                             (AND TYPESET (freplace
 (FMTSPEC FMTPARATYPE) of
 NEWLOOKS
                                             with
 TYPE))
                             (AND SUBTYPESET (freplace
 (FMTSPEC FMTPARASUBTYPE) of
 NEWLOOKS
                                                with
 SUBTYPE))
                             (AND SPECIALX (freplace
 (FMTSPEC FMTSPECIALX) of
 NEWLOOKS
                                              with
 SPECIALX))
                             (AND SPECIALY (freplace
 (FMTSPEC FMTSPECIALY) of
 NEWLOOKS
                                              with
 SPECIALY))
                             (AND NEWBEFORESET (freplace
 (FMTSPEC FMTNEWPAGEBEFORE) of
 
                                                                                             NEWLOOKS
                                                  with
 NEWBEFORE))
                             (AND NEWAFTERSET (freplace
 (FMTSPEC FMTNEWPAGEAFTER) of
 NEWLOOKS
                                                 with
 NEWAFTER))
                             [AND HEADINGKEEP (freplace
 (FMTSPEC FMTHEADINGKEEP) of
 NEWLOOKS
                                                 with
 (EQ HEADINGKEEP 'ON]
                             (AND KEEPSET (freplace
 (FMTSPEC FMTKEEP) of
 NEWLOOKS
                                             with
 KEEP))
                             (AND BASESET (freplace
 (FMTSPEC FMTBASETOBASE) of
 NEWLOOKS
                                             with
 BASETOBASE))
                             (AND HCPYSET (freplace
 (FMTSPEC FMTHARDCOPY) of
 NEWLOOKS
                                             with
 HCPYMODE))
                             (AND USERSET (freplace
 (FMTSPEC FMTUSERINFO) of
 NEWLOOKS
                                             with
 USERINFO))
                             (AND REVISEDSET (freplace
 (FMTSPEC FMTREVISED) of
 NEWLOOKS
                                                with
 REVISED))
                             (AND STYLESET (freplace
 (FMTSPEC FMTSTYLE) of
 NEWLOOKS
                                              with
 STYLE))
                             (AND CHARSTYLESSET (freplace
 (FMTSPEC FMTCHARSTYLES) of
 NEWLOOKS
                                                   with
 CHARSTYLES))
                             (AND COLUMNSET (freplace
 (FMTSPEC FMTCOLUMN) of
 NEWLOOKS
                                               with
 COLUMN))
                             (AND STYLESET (replace
 (FMTSPEC FMTSTYLE) of
 NEWLOOKS
                                              with
 STYLE))
                             (freplace
 (PIECE PPARALOOKS) of
 NPC with
 (SETQ NEWLOOKS
                                                                                   (

                                                                          \TEDIT.UNIQUIFY.PARALOOKS

                                                                                    NEWLOOKS TEXTOBJ]
                            (T                               (* ; "Re-use the last set of looks;  they're still what we want (this paragraph looks like the last one.)")

                               (freplace
 (PIECE PPARALOOKS) of
 NPC with
 NEWLOOKS]
                   [SETQ CHLIM (IMAX CHLIM (SETQ NCHLIM (SETQ START-OF-PIECE
                                                         (IPLUS START-OF-PIECE (fetch

                                                                                (PIECE PLEN)
                                                                                  of
 NPC]
                   (COND
                      ((fetch
 (PIECE PPARALAST) of
 NPC)
                                                             (* ; 

                   "We've found the end of a paragraph.  Stop to see if we've run off the end yet.")

                       (COND
                          ((IGEQ NCHLIM (SUB1 (fetch
 (SELECTION CHLIM) of
 SEL)))
                           (RETURN)))                        (* ; "Make a new set of looks.")

                       ))
                   (SETQ NPC (fetch
 (PIECE NEXTPIECE) of
 NPC)))
          (SETQ LASTLOOKS NIL)
          [bind
 (NPC _ (fetch
 (PIECE PREVPIECE) of
 PC))
             while
 (AND NPC (NOT (fetch
 (PIECE PPARALAST) of
 NPC)))
             do
 (SETQ OLDLOOKSLIST (CONS (fetch
 (PIECE PPARALOOKS) of
 NPC)
                                             OLDLOOKSLIST))
                   [COND
                      (REPLACEALLFIELDS 

                             (* ;; "We're replacing the whole paragraph format.  Just smash the new one it;  it has been uniquified (and recorded in the master list) already.")


                             (replace
 (PIECE PPARALOOKS) of
 NPC with
 D))
                      (T                                     (* ; 

                               "Only replacing part of the looks;  create a new one, and smash it.")

                         (COND
                            [(NEQ (fetch
 (PIECE PPARALOOKS) of
 NPC)
                                  LASTLOOKS)                 (* ; 

                                                 "only build a new FMTSPEC when they are different")

                             (SETQ LASTLOOKS (fetch
 (PIECE PPARALOOKS) of
 NPC))
                             (SETQ NEWLOOKS (create
 FMTSPEC using
 LASTLOOKS))
                             (AND 1STLEFT (freplace
 (FMTSPEC 1STLEFTMAR) of
 NEWLOOKS
                                             with
 1STLEFT))
                             (AND LEFT (freplace
 (FMTSPEC LEFTMAR) of
 NEWLOOKS with

                                                                                       LEFT))
                             (AND RIGHT (freplace
 (FMTSPEC RIGHTMAR) of
 NEWLOOKS with

                                                                                         RIGHT))
                             (AND LEADB (freplace
 (FMTSPEC LEADBEFORE) of
 NEWLOOKS
                                           with
 LEADB))
                             (AND LEADA (freplace
 (FMTSPEC LEADAFTER) of
 NEWLOOKS
                                           with
 LEADA))
                             (AND LLEAD (freplace
 (FMTSPEC LINELEAD) of
 NEWLOOKS with

                                                                                         LLEAD))
                             (AND TABSPECC (freplace
 (FMTSPEC TABSPEC) of
 NEWLOOKS
                                              with
 TABSPECC))
                             (AND QUADD (freplace
 (FMTSPEC QUAD) of
 NEWLOOKS with
 QUADD))
                             (AND TYPESET (freplace
 (FMTSPEC FMTPARATYPE) of
 NEWLOOKS
                                             with
 TYPE))
                             (AND SUBTYPESET (freplace
 (FMTSPEC FMTPARASUBTYPE) of
 NEWLOOKS
                                                with
 SUBTYPE))
                             (AND SPECIALX (freplace
 (FMTSPEC FMTSPECIALX) of
 NEWLOOKS
                                              with
 SPECIALX))
                             (AND SPECIALY (freplace
 (FMTSPEC FMTSPECIALY) of
 NEWLOOKS
                                              with
 SPECIALY))
                             (AND NEWBEFORESET (freplace
 (FMTSPEC FMTNEWPAGEBEFORE) of
 
                                                                                             NEWLOOKS
                                                  with
 NEWBEFORE))
                             (AND NEWAFTERSET (freplace
 (FMTSPEC FMTNEWPAGEAFTER) of
 NEWLOOKS
                                                 with
 NEWAFTER))
                             [AND HEADINGKEEP (freplace
 (FMTSPEC FMTHEADINGKEEP) of
 NEWLOOKS
                                                 with
 (EQ HEADINGKEEP 'ON]
                             (AND KEEPSET (freplace
 (FMTSPEC FMTKEEP) of
 NEWLOOKS
                                             with
 KEEP))
                             (AND BASESET (freplace
 (FMTSPEC FMTBASETOBASE) of
 NEWLOOKS
                                             with
 BASETOBASE))
                             (AND HCPYSET (freplace
 (FMTSPEC FMTHARDCOPY) of
 NEWLOOKS
                                             with
 HCPYMODE))
                             (AND USERSET (freplace
 (FMTSPEC FMTUSERINFO) of
 NEWLOOKS
                                             with
 USERINFO))
                             (AND REVISEDSET (freplace
 (FMTSPEC FMTREVISED) of
 NEWLOOKS
                                                with
 REVISED))
                             (AND STYLESET (freplace
 (FMTSPEC FMTSTYLE) of
 NEWLOOKS
                                              with
 STYLE))
                             (AND CHARSTYLESSET (freplace
 (FMTSPEC FMTCHARSTYLES) of
 NEWLOOKS
                                                   with
 CHARSTYLES))
                             (AND COLUMNSET (freplace
 (FMTSPEC FMTCOLUMN) of
 NEWLOOKS
                                               with
 COLUMN))
                             (AND STYLESET (freplace
 (FMTSPEC FMTSTYLE) of
 NEWLOOKS
                                              with
 STYLE))
                             (freplace
 (PIECE PPARALOOKS) of
 NPC with
 (SETQ NEWLOOKS
                                                                                   (

                                                                          \TEDIT.UNIQUIFY.PARALOOKS

                                                                                    NEWLOOKS TEXTOBJ]
                            (T                               (* ; "Re-use the last set of looks;  they're still what we want (this paragraph looks like the last one.)")

                               (freplace
 (PIECE PPARALOOKS) of
 NPC with
 NEWLOOKS]
                   (SETQ PC1 NPC)
                   (SETQ OLDSTART (IDIFFERENCE OLDSTART (fetch
 (PIECE PLEN) of
 PC1)))
                   (SETQ NPC (fetch
 (PIECE PREVPIECE) of
 NPC))
             finally
 (SETQ CH# (IMIN CH# (IMAX 1 OLDSTART]
          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
                 NIL NIL)                                    (* ; 

                                                      "Turn off the sel before updating the screen")

          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 CHLIM))
          (replace
 (TEXTOBJ \DIRTY) of
 TEXTOBJ with
 T)
                                                             (* ; "Mark the document as changed.")

          (\TEDIT.HISTORYADD TEXTOBJ
                 (create
 TEDITHISTORYEVENT
                        THACTION _ 'ParaLooks
                        THLEN _ (IDIFFERENCE CHLIM CH#)
                        THCH# _ CH#
                        THFIRSTPIECE _ PC1
                        THOLDINFO _ OLDLOOKSLIST
                        THAUXINFO _ NLOOKSAVE))              (* ; "Save this action for undo/redo")

          (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
          (COND
             ((fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)
              (TEDIT.UPDATE.SCREEN TEXTOBJ)                  (* ; "Update the screen image")

              (\FIXSEL SEL TEXTOBJ)
              (\SHOWSEL SEL NIL T])

(TEDIT.COPY.PARALOOKS

  [LAMBDA (STREAM SOURCE DEST)
                           (* ; "Edited 30-May-91 21:44 by jds")


    (* ;; "Copy the PARAGRAPH LOOKS from one place to another")


    (PROG ((TEXTOBJ (TEXTOBJ STREAM))
           LOOKS LEN)                                        (* ; 

                                         "get the paragraph looks of the first character of SOURCE")

          [SETQ LOOKS (fetch
 (PIECE PPARALOOKS)
                         of
 (CL:TYPECASE SOURCE
                                    ((SMALLP FIXP) (\CHTOPC SOURCE (fetch
 (TEXTOBJ PCTB)
                                                                      of
 TEXTOBJ)))
                                    (SELECTION 
                                       (\SHOWSEL SOURCE NIL NIL)
                                                             (* ; 

                                                           "Turn off the looks-source selection")

                                       (\CHTOPC (fetch
 (SELECTION CH#) of
 SOURCE)
                                              (fetch
 (TEXTOBJ PCTB) of
 (fetch

                                                                                (SELECTION \TEXTOBJ)
                                                                                  of
 SOURCE))))
                                    (T (\ILLEGAL.ARG SOURCE)))]
          (COND
             [(type?
 SELECTION DEST)                     (* ; 

                                     "make sure that the destination selection is in this document")

              (COND
                 ((NEQ TEXTOBJ (fetch
 (SELECTION \TEXTOBJ) of
 DEST))
                  (\LISPERROR "Destination selection is not in stream " STREAM]
             (T                                              (* ; 

                       "set the LEN arg for TEDIT.PARALOOKS to be 1 since we just have a char pos.")

                (SETQ LEN 1)))
          (TEDIT.PARALOOKS
 TEXTOBJ LOOKS DEST LEN])

(\TEDIT.PUT.PARALOOKS

  [LAMBDA (FILE PC PARAHASH)
                             (* ; "Edited 30-May-91 21:44 by jds")


    (* ;; "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")


    (* ;; "NB: ANY CHANGE TO THE FORMAT THIS PUTS OUT NEEDS TO BE MIRRORED IN TEDIT.PUT.PCTB WHERE IT PUTS OUT THE DUMMY FINAL PARAGRAPH PIECE.")


    (PROG ((LOOKS (fetch
 (PIECE PPARALOOKS) of
 PC))
           DEFAULTTAB TABSPECS OUTPUTFORMAT)
          (\DWOUT FILE 0)                                    (* ; 

           "Place holder for number of characters in the piece -- really taken from the charlooks.")

          (\SMALLPOUT FILE \PieceDescriptorPARA)             (* ; 

                                                         "Identify this as a paragraph looks piece")

          (\SMALLPOUT FILE (GETHASH LOOKS PARAHASH])

(\TEDIT.CONVERT.TO.FORMATTED

  [LAMBDA (TEXTOBJ START END)
                            (* ; "Edited 29-Apr-93 19:47 by jds")

                                                             (* ; 

                                      "Turn an unformatted TEdit file into a formatted TEdit file.")

    (PROG ((NEXTCR (\TEDIT.BASICFIND TEXTOBJ (MKSTRING (CHARACTER (CHARCODE CR)))
                          (OR START 1)))
           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           [CRSTRING (MKSTRING (CHARACTER (CHARCODE CR]
           (TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
           PCNO PC START-OF-PIECE)
          [while
 (AND NEXTCR (ILEQ NEXTCR (OR END TEXTLEN)))
             do
                                          (* ; 

      "Look at each CR in the range given (or whole file) and insert paragraph breaks accordingly.")

                   (SETQ PC (\CHTOPC NEXTCR (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ)
                                   T))
                   [COND
                      ((IEQP (ADD1 NEXTCR)
                             START-OF-PIECE)                 (* ; 

                                                           "This para ends on a piece bound.")

                       )
                      (T                                     (* ; 

                                                    "The CR is in mid-piece.  Split just after it.")

                         (\SPLITPIECE PC (- (ADD1 NEXTCR)
                                            START-OF-PIECE)
                                TEXTOBJ PCNO)
                         (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ]
                   (replace
 (PIECE PPARALAST) of
 PC with
 T)
                   (SETQ NEXTCR (\TEDIT.BASICFIND TEXTOBJ CRSTRING (ADD1 NEXTCR]
          (replace
 (TEXTOBJ FORMATTEDP) of
 TEXTOBJ with
 T)
          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (OR START 1)
                 (OR END TEXTLEN])

(\TEDIT.PARABOUNDS

  [LAMBDA (TEXTOBJ CH#)
                                  (* ; "Edited 21-Apr-93 18:22 by jds")


    (* ;; "returns the first and last chars of the paragraph bracketed by CH#")


    (PROG ((PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           PCNO NPC PC OPC BEGIN END PIECE START-OF-PIECE OLDSTART)
          [COND
             ((ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                                                             (* ; 

                                                           "An empty document has no paragraphs.")

              (RETURN (CONS 1 1]
          (SETQ PC (\CHTOPC CH# PCTB T))
          [COND
             ((ATOM PC)                                      (* ; 

            "OOPS, we found the end-of-doc piece.  Back up to the last real piece in the document.")

              (SETQ PC (\CHTOPC (FETCH
 (TEXTOBJ TEXTLEN) OF
 TEXTOBJ)
                              PCTB T]
          (SETQ PIECE PC)
          (SETQ OPC PIECE)
          (SETQ OLDSTART (IPLUS START-OF-PIECE (fetch
 (PIECE PLEN) of
 PC)))
          (repeatwhile
 (AND PIECE (NOT (fetch
 (PIECE PPARALAST) of
 OPC)))
             do
                                          (* ; 

                                                           "Find the piece that ends the paragraph")

                   (SETQ OPC PIECE)
                   (add
 START-OF-PIECE (fetch
 (PIECE PLEN) of
 PIECE))
                   (SETQ PIECE (fetch
 (PIECE NEXTPIECE) of
 PIECE)))
          [SETQ END (COND
                       (PIECE                                (* ; 

                        "This is the piece that ends the para.  Get the CH# of its final character")

                              (SUB1 START-OF-PIECE))
                       (T                                    (* ; 

                "If PIECE winds up NIL, we walked off the end of the document, so use the textlen.")

                          (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ]
          (bind
 (PIECE _ PC) repeatwhile
 (AND PIECE (NOT (fetch
 (PIECE PPARALAST)
                                                                    of
 PIECE)))
             do
                                          (* ; 

                                              "Now find the piece that ends the previous paragraph")

                   (add
 OLDSTART (IMINUS (fetch
 (PIECE PLEN) of
 PIECE)))
                   (SETQ PIECE (fetch
 (PIECE PREVPIECE) of
 PIECE)))
          (SETQ BEGIN OLDSTART)                              (* ; 

                                    "Actually, NPC is pointing at the piece that starts THIS para.")

          (RETURN (CONS BEGIN END])

(\TEDIT.FORMATTABS

  [LAMBDA (TEXTOBJ TABSPEC THISLINE CHBASE WBASE CURTX DFLTTABX MARGINXOFFSET PRIORTAB GRAIN 
                 CLEANINGUP)
                             (* ; "Edited 13-Nov-90 01:09 by jds")

                                                             (* ; 

                                                           "Do the formatting work for a tab.")


    (* ;; "PRIORTAB is the outstanding tab, if any, that has to be resolved.  This will be a centered or flush right tab.  its format is a PENDINGTAB")


    (* ;; "If CLEANINGUP is non-NIL, then we're at the end of the line, and only need to resolve the outstanding tab.")


    (* ;; "GRAIN is the granularity of the tab spacing; anything within GRAIN will slop over to the next tab.  This is to finesse rounding problems when going among various devices.")


    (PROG (NEXTTAB NEXTTABTYPE NEXTTABX DEFAULTTAB TABWIDTH)
          [COND
             (PRIORTAB 

                    (* ;; "If there is a prior tab to resolve, do that first--it affects the perceived current X value, which affects later tabs")


                    (SELECTQ (fetch
 PTTYPE of
 PRIORTAB)
                        ((CENTERED DOTTEDCENTERED)           (* ; "Centered around the tab X")

                             [SETQ TABWIDTH (IMAX 3 (IDIFFERENCE (IDIFFERENCE
                                                                  (fetch
 PTTABX of
 PRIORTAB)
                                                                  (LRSH (IDIFFERENCE CURTX
                                                                               (fetch
 PTOLDTX
                                                                                  of
 PRIORTAB))
                                                                        1))
                                                           (fetch
 PTOLDTX of
 PRIORTAB]
                             (\RPLPTR (fetch
 PTWBASE of
 PRIORTAB)
                                    0 TABWIDTH)
                             (add
 CURTX TABWIDTH))
                        ((RIGHT DOTTEDRIGHT DECIMAL DOTTEDDECIMAL) 
                                                             (* ; "Snug up against the tab X")

                             [SETQ TABWIDTH (IMAX 3 (IDIFFERENCE (IDIFFERENCE (fetch
 PTTABX
                                                                                 of
 PRIORTAB)
                                                                        (IDIFFERENCE CURTX
                                                                               (fetch
 PTOLDTX
                                                                                  of
 PRIORTAB)))
                                                           (fetch
 PTOLDTX of
 PRIORTAB]
                             (\RPLPTR (fetch
 PTWBASE of
 PRIORTAB)
                                    0 TABWIDTH)              (* ; 

                                                           "Now we can fill in the real width")

                             (add
 CURTX TABWIDTH))
                        (SHOULDNT]
          (SETQ DEFAULTTAB (OR (CAR TABSPEC)
                               DFLTTABX))                    (* ; 

                                          "Default Tab width, if there aren't any real tabs to use")

          (SETQ NEXTTAB (for
 TAB in
 (CDR TABSPEC) when
 (IGREATERP (fetch
 TABX
                                                                                 of
 TAB)
                                                                          (IDIFFERENCE CURTX 
                                                                                 MARGINXOFFSET))
                           do
 (RETURN TAB)))             (* ; 

                                                           "The next tab on this line, if any")

          (SETQ NEXTTABTYPE (OR (AND NEXTTAB (fetch
 TABKIND of
 NEXTTAB))
                                'LEFT))                      (* ; 

                                   "The type of the next tab (LEFT, if we use the default spacing)")

          (SETQ NEXTTABX (IPLUS [COND
                                   (NEXTTAB                  (* ; 

                                                  "There is a real tab to go to; use its location.")

                                          (fetch
 TABX of
 NEXTTAB))
                                   (T                        (* ; 

                                       "No real tab; use the next multiple of the default spacing.")

                                      (ITIMES DEFAULTTAB (IPLUS 1 (IQUOTIENT (IPLUS GRAIN
                                                                                    (IDIFFERENCE
                                                                                     CURTX 
                                                                                     MARGINXOFFSET))
                                                                         DEFAULTTAB]
                                MARGINXOFFSET))              (* ; "The next tab's X value")

          (COND
             (CLEANINGUP                                     (* ; 

                             "We're cleaning up at end of line, so this shouldn't have any effect.")

                    (RETURN CURTX))
             (T (SELECTQ NEXTTABTYPE
                    ((DOTTEDLEFT DOTTEDCENTERED DOTTEDRIGHT DOTTEDDECIMAL) 
                                                             (* ; 

                "This is a dotted-leader tab.  Change it to Meta-TAB, so the line displayer knows.")

                         (\RPLPTR CHBASE 0 (CHARCODE %#^I)))
                    NIL)
                (SELECTQ NEXTTABTYPE
                    ((LEFT DOTTEDLEFT)                       (* ; "Flush LEFT TAB.")

                         (SETQ TABWIDTH (IMAX 1 (IDIFFERENCE NEXTTABX CURTX)))
                         (\RPLPTR WBASE 0 TABWIDTH)
                         (RETURN CURTX))
                    ((CENTERED DOTTEDCENTERED)               (* ; "Centered around the tab X")

                         (\RPLPTR WBASE 0 0)                 (* ; "For now, the TAB is 0 wide")

                         (RETURN (create
 PENDINGTAB
                                        PTNEWTX _ CURTX
                                        PTOLDTAB _ NEXTTAB
                                        PTTYPE _ NEXTTABTYPE
                                        PTTABX _ NEXTTABX
                                        PTWBASE _ WBASE
                                        PTOLDTX _ CURTX)))
                    ((RIGHT DOTTEDRIGHT DECIMAL DOTTEDDECIMAL) 
                                                             (* ; "Snug up against the tab X")

                         (\RPLPTR WBASE 0 0)                 (* ; "For now, the TAB is 0 wide")

                         (RETURN (create
 PENDINGTAB
                                        PTNEWTX _ CURTX
                                        PTOLDTAB _ NEXTTAB
                                        PTTYPE _ NEXTTABTYPE
                                        PTTABX _ NEXTTABX
                                        PTWBASE _ WBASE
                                        PTOLDTX _ CURTX)))
                    (SHOULDNT])
)



(* ;; "For making paragraph-looks substitutions.")


(DEFINEQ

(TEDIT.SUBPARALOOKS

  [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST)
         (* ; "Edited 26-Apr-93 15:13 by jds")


(* ;;; "User entry to substitute one set of looks for another.  Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.")


    (LET* ((OLDLOOKS (\TEDIT.PARSE.PARALOOKS.LIST
 OLDLOOKSLIST))
           (NEWLOOKS (\TEDIT.PARSE.PARALOOKS.LIST
 NEWLOOKSLIST))
           (TEXTOBJ (TEXTOBJ TEXTSTREAM))
           (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           (FIRSTPC (\CHTOPC 1 PCTB))
           (FEATURELIST (for
 A on
 OLDLOOKSLIST by
 (CDDR A) collect
 (CAR A)))
           CHANGEMADE)
          (\SHOWSEL SEL NIL NIL)                             (* ; "Turn off the selection, first.")

          [OR (ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
              (bind
 (CH# _ 1) for
 (PC _ FIRSTPC) while
 PC
                 by
 (fetch
 (PIECE NEXTPIECE) of
 PC)
                 do
 (COND
                           ((SAMEPARALOOKS
 OLDLOOKS (fetch
 (PIECE PPARALOOKS) of
 PC)
                                   FEATURELIST)
                            (replace
 (TEXTOBJ \DIRTY) of
 (TEXTOBJ TEXTSTREAM) with
 T)
                            (freplace
 (PIECE PPARALOOKS) of
 PC
                               with
 (\TEDIT.UNIQUIFY.PARALOOKS
 (\TEDIT.PARSE.PARALOOKS.LIST

                                                                        NEWLOOKSLIST
                                                                        (fetch
 (PIECE PPARALOOKS)
                                                                           of
 PC))
                                               (TEXTOBJ TEXTSTREAM)))
                            (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch
 (PIECE PLEN)
                                                                           of
 PC)))
                            (SETQ CHANGEMADE T)))
                       (add
 CH# (fetch
 (PIECE PLEN) of
 PC]
          (COND
             ((fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)
              (TEDIT.UPDATE.SCREEN TEXTOBJ)                  (* ; "Update the screen image")

              (\FIXSEL SEL TEXTOBJ)
              (\SHOWSEL SEL NIL T)))
          (COND
             (CHANGEMADE 'Done)
             (T 'NoChangesMade])

(SAMEPARALOOKS

  [LAMBDA (PARALOOK1 PARALOOK2 FEATURES)
                 (* ; "Edited  8-Dec-92 00:44 by jds")


    (* ;; "Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES")


    (for
 F in
 FEATURES always
 (SELECTQ F
                                              (STYLE (EQUAL (fetch
 (FMTSPEC FMTSTYLE)
                                                               of
 PARALOOK1)
                                                            (fetch
 (FMTSPEC FMTSTYLE)
                                                               of
 PARALOOK2)))
                                              (LEFTMARGIN (IEQP (fetch
 (FMTSPEC LEFTMAR)
                                                                   of
 PARALOOK1)
                                                                (fetch
 (FMTSPEC LEFTMAR)
                                                                   of
 PARALOOK2)))
                                              (1STLEFTMARGIN (IEQP (fetch
 (FMTSPEC 1STLEFTMAR)
                                                                      of
 PARALOOK1)
                                                                   (fetch
 (FMTSPEC 1STLEFTMAR)
                                                                      of
 PARALOOK2)))
                                              (RIGHTMARGIN (IEQP (fetch
 (FMTSPEC RIGHTMAR)
                                                                    of
 PARALOOK1)
                                                                 (fetch
 (FMTSPEC RIGHTMAR)
                                                                    of
 PARALOOK2)))
                                              (QUAD (EQ (fetch
 (FMTSPEC QUAD) of
 PARALOOK1)
                                                        (fetch
 (FMTSPEC QUAD) of
 PARALOOK2)))
                                              (POSTPARALEADING 
                                                   (IEQP (fetch
 (FMTSPEC LEADBEFORE) of

                                                                                         PARALOOK1)
                                                         (fetch
 (FMTSPEC LEADBEFORE) of

                                                                                         PARALOOK2)))
                                              (PARALEADING (IEQP (fetch
 (FMTSPEC LEADBEFORE)
                                                                    of
 PARALOOK1)
                                                                 (fetch
 (FMTSPEC LEADBEFORE)
                                                                    of
 PARALOOK2)))
                                              (LINELEADING (IEQP (fetch
 (FMTSPEC LINELEAD)
                                                                    of
 PARALOOK1)
                                                                 (fetch
 (FMTSPEC LINELEAD)
                                                                    of
 PARALOOK2)))
                                              (TABS (EQUAL (fetch
 (FMTSPEC TABSPEC) of
 
                                                                                            PARALOOK1
                                                                  )
                                                           (fetch
 (FMTSPEC TABSPEC) of
 
                                                                                            PARALOOK2
                                                                  )))
                                              (NEWPAGEBEFORE (EQ (fetch
 (FMTSPEC FMTNEWPAGEBEFORE
                                                                                   ) of
 PARALOOK1
                                                                        )
                                                                 (fetch
 (FMTSPEC FMTNEWPAGEBEFORE
                                                                                   ) of
 PARALOOK2
                                                                        )))
                                              (NEWPAGEAFTER (EQ (fetch
 (FMTSPEC FMTNEWPAGEAFTER)
                                                                   of
 PARALOOK1)
                                                                (fetch
 (FMTSPEC FMTNEWPAGEAFTER)
                                                                   of
 PARALOOK2)))
                                              (SPECIALX (IEQP (fetch
 (FMTSPEC FMTSPECIALX)
                                                                 of
 PARALOOK1)
                                                              (fetch
 (FMTSPEC FMTSPECIALX)
                                                                 of
 PARALOOK2)))
                                              (SPECIALY (IEQP (fetch
 (FMTSPEC FMTSPECIALY)
                                                                 of
 PARALOOK1)
                                                              (fetch
 (FMTSPEC FMTSPECIALY)
                                                                 of
 PARALOOK2)))
                                              (HEADINGKEEP (EQ (fetch
 (FMTSPEC FMTHEADINGKEEP)
                                                                  of
 PARALOOK1)
                                                               (fetch
 (FMTSPEC FMTHEADINGKEEP)
                                                                  of
 PARALOOK2)))
                                              (ERROR (CONCAT F 
                              " is an unknown feature of paragraph looks.  Detected in SAMEPARALOOKS"
                                                            ])
)



(* ; "UNDO & History List stuff")


(DEFINEQ

(TEDIT.REDO.LOOKS

  [LAMBDA (TEXTOBJ EVENT CH#)
                            (* ; "Edited 30-May-91 21:42 by jds")

                                                             (* Set looks on the current 

                                                           selection from the 

                                                           TEDIT.CHARLOOKS.WINDOW)

    (PROG ((SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (NEWLOOKS (fetch
 THAUXINFO of
 EVENT)))
          (COND
             ((fetch
 (SELECTION SET) of
 SEL)         (* He's got something selected.)

              (TEDIT.LOOKS
 TEXTOBJ NEWLOOKS SEL)         (* Go perform a similar action 

                                                           again.)

              )
             (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T])

(TEDIT.REDO.PARALOOKS

  [LAMBDA (TEXTOBJ EVENT CH#)
                            (* ; "Edited 30-May-91 21:42 by jds")

                                                             (* Re-set the looks on selected 

                                                           paragraphs)

    (PROG ((SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (NEWLOOKS (fetch
 THAUXINFO of
 EVENT)))
          (COND
             ((fetch
 (SELECTION SET) of
 SEL)         (* He's got something selected.)

              (TEDIT.PARALOOKS
 TEXTOBJ NEWLOOKS SEL)     (* Go perform a similar action 

                                                           again.)

              )
             (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T])

(TEDIT.UNDO.LOOKS

  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
             (* ; "Edited 30-May-91 21:44 by jds")

                                                             (* Set looks on the current 

                                                           selection from the 

                                                           TEDIT.CHARLOOKS.WINDOW)

    (PROG ((SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           CHLIM
           (OLDLOOKSLIST (fetch
 THOLDINFO of
 EVENT))
           (NEWLOOKSLIST NIL)
           (\INPC (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ)))
          (bind
 (PC _ (fetch
 THFIRSTPIECE of
 EVENT)) for
 OLDLOOKS in
 OLDLOOKSLIST
             do
 (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch
 (PIECE PLOOKS) of
 PC))) 
                                                             (* Remember this for the undo.)

                   (replace
 (PIECE PLOOKS) of
 PC with
 OLDLOOKS) 
                                                             (* Give this piece its old looks)

                   [COND
                      ((EQ PC \INPC)
                       (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ
                          with
 (\TEDIT.CARETLOOKS.VERIFY
 TEXTOBJ (fetch
 (PIECE PLOOKS)
                                                                            of
 PC]
                   (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC)))
          (replace
 THOLDINFO of
 EVENT with
 NEWLOOKSLIST)
                                                             (* Remember the other looks in case 

                                                           we UNDO the UNDO.)

          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch
 THCH# of
 EVENT)
                                                      (fetch
 THLEN of
 EVENT)
                                                      -1))
          (TEDIT.UPDATE.SCREEN TEXTOBJ)
          (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
          (SETQ TEDIT.PENDINGDEL NIL)
          (\FIXSEL SEL TEXTOBJ)
          (\SHOWSEL SEL NIL T])

(TEDIT.UNDO.PARALOOKS

  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
             (* ; "Edited 30-May-91 21:44 by jds")

                                                             (* Set looks on the current 

                                                           selection from the 

                                                           TEDIT.CHARLOOKS.WINDOW)

    (PROG ((SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           CHLIM
           (OLDLOOKSLIST (fetch
 THOLDINFO of
 EVENT))
           (NEWLOOKSLIST NIL))
          (bind
 (PC _ (fetch
 THFIRSTPIECE of
 EVENT)) for
 OLDLOOKS in
 OLDLOOKSLIST
             do
 (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch
 (PIECE PPARALOOKS)
                                                               of
 PC))) 
                                                             (* Remember this for the undo.)

                   (replace
 (PIECE PPARALOOKS) of
 PC with
 OLDLOOKS) 
                                                             (* Give this piece its old looks)

                   (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC)))
          (replace
 THOLDINFO of
 EVENT with
 NEWLOOKSLIST)
                                                             (* Remember the other looks in case 

                                                           we UNDO the UNDO.)

          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch
 THCH# of
 EVENT)
                                                      (fetch
 THLEN of
 EVENT)
                                                      -1))
          (TEDIT.UPDATE.SCREEN TEXTOBJ)
          (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
          (SETQ TEDIT.PENDINGDEL NIL)
          (\FIXSEL SEL TEXTOBJ)
          (\SHOWSEL SEL NIL T])
)



(* ; "Revision-mark support")


(DEFINEQ

(\TEDIT.MARK.REVISION

  [LAMBDA (TEXTOBJ FMTSPEC IMAGESTREAM LINE)
             (* ; "Edited 30-May-91 21:38 by jds")

    (LET ((SCALE (DSPSCALE NIL IMAGESTREAM)))
         (BLTSHADE BLACKSHADE IMAGESTREAM (+ (fetch
 (LINEDESCRIPTOR RIGHTMARGIN) of
 LINE)
                                             (FIXR (CL:* 12 SCALE)))
                (fetch
 (LINEDESCRIPTOR YBOT) of
 LINE)
                (FIXR SCALE)
                (fetch
 (LINEDESCRIPTOR LHEIGHT) of
 LINE)
                'PAINT])
)



(* ; "Added by yabu.fx, for SUNLOADUP without DWIM")


(DEFINEQ

(\CREATE.TEDIT.DEFAULT.FMTSPEC

  [LAMBDA NIL
    (create
 FMTSPEC
           QUAD _ 'LEFT
           1STLEFTMAR _ 0
           LEFTMAR _ 0
           RIGHTMAR _ 0
           LEADBEFORE _ 0
           LEADAFTER _ 0
           LINELEAD _ 0
           TABSPEC _ (CONS NIL NIL])

(\CREATE.TEDIT.FACE.MENU

  [LAMBDA NIL
    (create
 MENU
           ITEMS _ '(Bold Italic Bold% Italic Regular)
           CENTERFLG _ T
           TITLE _ "Face:"])

(\CREATE.TEDIT.SIZE.MENU

  [LAMBDA NIL
    (create
 MENU
           ITEMS _ '(6 7 8 9 10 11 12 14 18 24 30 36)
           CENTERFLG _ T
           MENUROWS _ 4
           TITLE _ "Type Size:"])
)



(* ; "Style-sheet support")


(DEFINEQ

(\TEDIT.APPLY.STYLES

  [LAMBDA (LOOKS PC TEXTOBJ)
                  (* ; 

                                                "Edited  4-Jul-93 01:02 by sybalskY:MV:ENVOS")


    (* ;; "Given a set of looks, return the looks with the proper styles expanded out.")


    (\TEDIT.CHECK (type?
 CHARLOOKS LOOKS))               (* ; 

                                                           "Incoming thing has to be a LOOKS.")

    (OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*))
        (CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*))
        (LET ((STYLE (fetch
 (CHARLOOKS CLSTYLE) of
 LOOKS))
              (STYLE-SHEET (OR (fetch
 (TEXTOBJ TXTSTYLESHEET) of
 TEXTOBJ)
                               TEDIT.STYLES))
              (NOSTYLE)
              CHARSTYLES CHARSTYLE IN-PARA FMTSPEC)
             (SETQ STYLE (COND
                            ((NULL STYLE)                    (* ; 

                                     "STYLE of NIL means don't bother.  Just use the looks we got.")

                             (SETQ NOSTYLE T)
                             LOOKS)
                            ((AND [SETQ CHARSTYLES (AND (fetch
 (TEXTSTREAM CURRENTPARALOOKS)
                                                           of
 (fetch
 (TEXTOBJ STREAMHINT)
                                                                     of
 TEXTOBJ))
                                                        (fetch
 (FMTSPEC FMTCHARSTYLES)
                                                           of
 (fetch
 (TEXTSTREAM 
                                                                                    CURRENTPARALOOKS)
                                                                     of
 (fetch
 (TEXTOBJ
                                                                                        STREAMHINT)
                                                                               of
 TEXTOBJ]
                                  (SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES)))
                                                             (* ; 

                 "If the paragraph we're in has character styles, and this is one of them, use it.")

                             (SETQ IN-PARA T)
                             CHARSTYLE)
                            ((CDR (SASSOC STYLE STYLE-SHEET)))
                            ((AND (LITATOM STYLE)
                                  (DEFINEDP STYLE))          (* ; 

                                                    "Call the guy's function to find the new looks")

                             (APPLY* STYLE LOOKS PC TEXTOBJ))
                            (T                               (* ; 

                                              "If all else fails, return the original set of looks")

                               (SETQ NOSTYLE T)
                               LOOKS)))
             (SETQ STYLE (COND
                            ((LISTP STYLE)
                             (\TEDIT.PARSE.CHARLOOKS.LIST
 (APPEND STYLE '(STYLE NIL))
                                    LOOKS))
                            (T STYLE)))

             (* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.")


             [OR NOSTYLE (CL:IF IN-PARA
                             (push
 *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE))
                             (push
 *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))]
             STYLE])

(\TEDIT.APPLY.PARASTYLES

  [LAMBDA (PARALOOKS PC TEXTOBJ)
              (* ; 

                                                "Edited  3-Jul-93 23:15 by sybalskY:MV:ENVOS")


    (* ;; "Given a set of looks, return the looks with the proper styles expanded out.")


    (\TEDIT.CHECK (type?
 FMTSPEC PARALOOKS))             (* ; 

                                                           "Incoming thing has to be a LOOKS.")

    (OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*))
        (LET* [(NOSTYLE)
               (STYLE-SHEET (OR (fetch
 (TEXTOBJ TXTSTYLESHEET) of
 TEXTOBJ)
                                TEDIT.STYLES))
               (STYLE (COND
                         ((NULL (fetch
 (FMTSPEC FMTSTYLE) of
 PARALOOKS))
                          (SETQ NOSTYLE T)
                          PARALOOKS)
                         ((CDR (SASSOC (fetch
 (FMTSPEC FMTSTYLE) of
 PARALOOKS)
                                      STYLE-SHEET)))
                         ((AND (LITATOM (fetch
 (FMTSPEC FMTSTYLE) of
 PARALOOKS))
                               (DEFINEDP (fetch
 (FMTSPEC FMTSTYLE) of
 PARALOOKS)))
                                                             (* ; 

                                                    "Call the guy's function to find the new looks")

                          (APPLY* (fetch
 (FMTSPEC FMTSTYLE) of
 PARALOOKS)
                                 PARALOOKS PC TEXTOBJ))
                         (T (SETQ NOSTYLE T)
                            PARALOOKS]
              (SETQ STYLE (COND
                             ((LISTP STYLE)
                              (\TEDIT.PARSE.PARALOOKS.LIST
 (APPEND STYLE '(STYLE NIL))
                                     PARALOOKS))
                             (T STYLE)))
              (OR NOSTYLE (push
 *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE)))
              STYLE])

(TEDIT.STYLESHEET

  [LAMBDA (SHEET TEXTSTREAM)
                  (* ; 

                                                "Edited  3-Jul-93 23:19 by sybalskY:MV:ENVOS")


    (* ;; "Put a new stylesheet into force.  This REPLACES any existing style sheets, and forgets any pushed sheets.")


    (LET [(TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM]
         (COND
            (TEXTOBJ (SETQ *TEDIT-PARASTYLE-CACHE* NIL)      (* ; 

                                                           "Clear the cache, to force reformatting")

                   (replace
 (TEXTOBJ TXTSTYLESHEET) of
 TEXTOBJ with
 SHEET))
            (T 
               (* ;; "No specific document given; change the global style sheet TEDIT.STYLES")


               (SETQ *TEDIT-PARASTYLE-CACHE* NIL)            (* ; 

                                                           "Clear the cache, to force reformatting")

               (SETQ TEDIT.STYLES SHEET)
               (SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])

(TEDIT.POP.STYLESHEET

  [LAMBDA NIL
                                 (* ; 

                                                "Edited  3-Jul-93 17:42 by sybalskY:MV:ENVOS")


    (* ;; "Go back to an earlier stylesheet, by popping the stack of saved sheets.  You can't pop back to no sheet -- you'll always bottom out at the original style sheet.")


    (SETQ *TEDIT-PARASTYLE-CACHE* NIL)                       (* ; 

                                                           "Clear the cache, to force reformatting")

    (SETQ TEDIT.STYLES (OR (CL:POP *TEDIT-STYLESHEET-SAVE-LIST*)
                           TEDIT.STYLES])

(TEDIT.PUSH.STYLESHEET

  [LAMBDA (SHEET)
                             (* ; 

                                                "Edited  3-Jul-93 17:40 by sybalskY:MV:ENVOS")


    (* ;; "Add more style definitions to the current style sheet, and remember how to get back to the old one.  Think of this as PUSHING onto a stack of stylesheets, with the new sheet being a composition of SHEET and the existing styles.  ")


    (SETQ *TEDIT-PARASTYLE-CACHE* NIL)                       (* ; 

                                                           "Clear the cache, to force reformatting")

    (SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
    (CL:PUSH TEDIT.STYLES *TEDIT-STYLESHEET-SAVE-LIST*])

(TEDIT.ADD.STYLESHEET

  [LAMBDA (SHEET)
                             (* ; 

                                                "Edited  3-Jul-93 17:38 by sybalskY:MV:ENVOS")


    (* ;; "Add more style definitions to the current style sheet.  This ADDS entries, without remembering that there was an earlier sheet. ")


    (SETQ *TEDIT-PARASTYLE-CACHE* NIL)                       (* ; 

                                                           "Clear the cache, to force reformatting")

    (SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
    (SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
)



(* ;; 
"*TEDIT-PARASTYLE-CACHE* is an ALIST of  original char/para looks to styled char/para looks.  It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles."
)





(* ;; 
"*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the FMTSPEC (styled!) for that para, if we are.  Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries.  Mostly, this'll be NIL and not interesting."
)





(* ;; 
"*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly.  This is the push-stack, in effect.  Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET"
)



(RPAQ? *TEDIT-PARASTYLE-CACHE*
 )

(RPAQ? *TEDIT-CURRENTPARA-CACHE*
 )

(RPAQ? *TEDIT-STYLESHEET-SAVE-LIST*
 )
(PUTPROPS TEDITLOOKS COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989
 1990 1991 1992 1993 1994 1999))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (8534 61591 (CHARLOOKS.FROM.FONT 8544 . 10228) (EQCLOOKS 10230 . 12750) (SAMECLOOKS 
12752 . 18828) (\TEDIT.UNIQUIFY.CHARLOOKS 18830 . 19391) (TEDIT.CARETLOOKS 19393 . 21069) (
TEDIT.COPY.LOOKS 21071 . 23183) (\TEDIT.GET.CHARLOOKS 23185 . 26163) (\TEDIT.UNPARSE.CHARLOOKS.LIST 
26165 . 29043) (TEDIT.MODIFYLOOKS 29045 . 30827) (TEDIT.NEW.FONT 30829 . 31264) (\TEDIT.PUT.CHARLOOKS 
31266 . 33059) (\TEDIT.CARETLOOKS.VERIFY 33061 . 34192) (\TEDIT.GET.INSERT.CHARLOOKS 34194 . 37958) (
\TEDIT.GET.TERMSA.WIDTHS 37960 . 38394) (\TEDIT.LOOKS.UPDATE 38396 . 50020) (
\TEDIT.PARSE.CHARLOOKS.LIST 50022 . 58755) (\TEDIT.FLUSH.UNUSED.LOOKS 58757 . 61589)) (61639 64190 (
TEDIT.SUBLOOKS 61649 . 64188)) (64191 94025 (\TEDIT.CHANGE.LOOKS 64201 . 83729) (TEDIT.LOOKS 83731 . 
85641) (\TEDIT.LOOKS 85643 . 88868) (\TEDIT.FONTCOPY 88870 . 90144) (TEDIT.GET.LOOKS 90146 . 94023)) (
94068 148145 (\TEDIT.GET.PARALOOKS 94078 . 94558) (EQFMTSPEC 94560 . 98042) (\TEDIT.UNIQUIFY.PARALOOKS
 98044 . 98606) (TEDIT.GET.PARALOOKS 98608 . 100046) (\TEDIT.UNPARSE.PARALOOKS.LIST 100048 . 103449) (
\TEDIT.PARSE.PARALOOKS.LIST 103451 . 111477) (TEDIT.PARALOOKS 111479 . 132937) (TEDIT.COPY.PARALOOKS 
132939 . 134999) (\TEDIT.PUT.PARALOOKS 135001 . 135891) (\TEDIT.CONVERT.TO.FORMATTED 135893 . 137906) 
(\TEDIT.PARABOUNDS 137908 . 140707) (\TEDIT.FORMATTABS 140709 . 148143)) (148205 156686 (
TEDIT.SUBPARALOOKS 148215 . 150773) (SAMEPARALOOKS 150775 . 156684)) (156729 162561 (TEDIT.REDO.LOOKS 
156739 . 157630) (TEDIT.REDO.PARALOOKS 157632 . 158436) (TEDIT.UNDO.LOOKS 158438 . 160653) (
TEDIT.UNDO.PARALOOKS 160655 . 162559)) (162600 163134 (\TEDIT.MARK.REVISION 162610 . 163132)) (163196 
163865 (\CREATE.TEDIT.DEFAULT.FMTSPEC 163206 . 163487) (\CREATE.TEDIT.FACE.MENU 163489 . 163661) (
\CREATE.TEDIT.SIZE.MENU 163663 . 163863)) (163902 172479 (\TEDIT.APPLY.STYLES 163912 . 167502) (
\TEDIT.APPLY.PARASTYLES 167504 . 169439) (TEDIT.STYLESHEET 169441 . 170485) (TEDIT.POP.STYLESHEET 
170487 . 171134) (TEDIT.PUSH.STYLESHEET 171136 . 171855) (TEDIT.ADD.STYLESHEET 171857 . 172477)))))
STOP