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


(FILECREATED "22-Dec-2021 10:29:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;12
 182752 

      :CHANGES-TO (FNS \TEXTBIN \TEXTPEEKBIN)

      :PREVIOUS-DATE "22-Dec-2021 10:01:53" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;11)


(* ; "
Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Corporation.
")

(PRETTYCOMPRINT TEXTOFDCOMS)

(RPAQQ TEXTOFDCOMS

       [(FILES TEDITDCL)
        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
               (FILES (LOADCOMP)
                      TEDITDCL))
        (FNS COPYTEXTSTREAM OPENTEXTSTREAM REOPENTEXTSTREAM TEDIT.STREAMCHANGEDP TEXTSTREAMP TXTFILE
             \DELETECH \SETUPGETCH \TEDIT.REOPEN.STREAM \TEDIT.COPYTEXTSTREAM.PIECEMAPFN \TEXTINIT 
             \TEXTMARK \TEXTTTYBOUT)
        (FNS \INSERTCH \INSERTCR)
        (COMS 

(* ;;; "Functions to manipulate the Piece Table (PCTB)")


              (FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE 
                   \INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE))
        (COMS                                                (* ; 

                                                             "Generic-IO type operations support")

              (FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR 
                   \TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR 
                   \TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION 
                   \TEXTDSPYPOSITION \TEXTLEFTMARGIN \TEXTRIGHTMARGIN \TEXTDSPCHARWIDTH 
                   \TEXTDSPSTRINGWIDTH \TEXTDSPLINEFEED)
              (FNS \TEXTBIN \TEDIT.TEXTBIN.STRINGSETUP \TEDIT.TEXTBIN.FILESETUP 
                   \TEDIT.TEXTBIN.NEW.PAGE)
              (FNS \TEXTPEEKBIN \TEDIT.PEEKBIN.NEW.PAGE))
        (COMS                                                (* ; "Support for TEXTPROP")

              (FNS CGETTEXTPROP CTEXTPROP GETTEXTPROP PUTTEXTPROP TEXTPROP))
        [COMS 
              (* ;; "Support for error handling:  The old error handler for the stream-not-open error.  This is here, because you only want to do this ONCE, even if you load TEXTOFD multiple times (as, e.g., in development)")


              (INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN]
        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT)))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA TEXTPROP])

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

(RPAQQ \SCRATCHLEN
 64)


(CONSTANTS (\SCRATCHLEN 64))
)


(FILESLOAD (LOADCOMP)
       TEDITDCL)
)
(DEFINEQ

(COPYTEXTSTREAM

  [LAMBDA (ORIGINAL
 CROSSCOPY)
            (* ; 

                                                "Edited 24-Apr-95 12:02 by sybalsky:mv:envos")


    (* ;; "Given a stream, textobj or window, returns a new textstream with the same contents.  If CROSSCOPY then strings will really be allocated providing copies of the text else the fileptrs still will be aliases as in the rest of TEDIT.")


    (PROG ((TEXTOBJ (TEXTOBJ ORIGINAL))
           TSEL PCTB PCLST NEWSTREAM NEWTEXTOBJ)
          (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
          (SETQ TSEL (fetch
 (TEXTOBJ SCRATCHSEL) of
 TEXTOBJ))
          (SETQ NEWSTREAM (OPENTEXTSTREAM
 NIL NIL NIL NIL (fetch
 (TEXTOBJ EDITPROPS)
                                                                 of
 TEXTOBJ)))
                                                             (* ; 

                           "First create an empty textstream into which the pieces can be hammered")

          (SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM))
          (replace
 (SELECTION CH#) of
 TSEL with
 1)
                                                             (* ; 

                                                           "Set up to select the whole source text")

          (replace
 (SELECTION CHLIM) of
 TSEL with
 (ADD1 (fetch
 (TEXTOBJ TEXTLEN)
                                                                       of
 TEXTOBJ)))
          (replace
 (SELECTION DCH) of
 TSEL with
 (fetch
 (TEXTOBJ TEXTLEN) of

                                                                                         TEXTOBJ))
          (SETQ PCLST (TEDIT.SELECTED.PIECES TEXTOBJ TSEL CROSSCOPY (FUNCTION 
                                                                     \TEDIT.COPYTEXTSTREAM.PIECEMAPFN
                                                                     )
                             TEXTOBJ NEWTEXTOBJ))            (* ; 

                  "now get a list of copies of the pieces to be inserted into the empty textstream")

          (\TEDIT.INSERT.PIECES NEWTEXTOBJ 1 PCLST (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)
                 NIL NIL CROSSCOPY)                          (* ; 

                                                          "Put the pieces into the copy textstream")

          (replace
 (TEXTOBJ TEXTLEN) of
 NEWTEXTOBJ with
 (fetch
 (TEXTOBJ TEXTLEN)
                                                                       of
 TEXTOBJ))
                                                             (* ; 

                                                      "The copy is the same length as the original")

          (replace
 (TEXTOBJ MENUFLG) of
 NEWTEXTOBJ with
 (fetch
 (TEXTOBJ MENUFLG)
                                                                       of
 TEXTOBJ))
                                                             (* ; 

                                                     "And if the original is a menu, so's the copy")

          (RETURN NEWSTREAM])

(OPENTEXTSTREAM

  [LAMBDA (TEXT WINDOW START END PROPS)
                  (* ; "Edited  4-May-93 14:38 by jds")

                                                             (* ; 

     "Create a text-type STREAM to describe TEXT.  Optionally, connect that to WINDOW for display.")

    (PROG* ([WAS-TEXTSTREAM (AND (type?
 STREAM TEXT)
                                 (type?
 TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT]
            [TEXTOBJ (COND
                        (WAS-TEXTSTREAM                      (* ; 

                               "If the guy gave us a text stream to edit, use its TEXTOBJ as ours.")

                               (create
 TEXTOBJ
                                  reusing
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT)
                                        \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 \INSERTPCVALID _ NIL))
                        ((type?
 TEXTOBJ TEXT)
                         (create
 TEXTOBJ using
 TEXT \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 
                                                   \INSERTPCVALID _ NIL))
                        (T (create
 TEXTOBJ]
            (TEDIT.GET.FINISHEDFORMS NIL)
            [PROPS (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)
                          (COPY (fetch
 (TEXTOBJ EDITPROPS) of
 TEXTOBJ]
            [TEXTOBJ.WINDOW.VALID (AND WINDOW (EQ WINDOW (\TEDIT.PRIMARYW TEXTOBJ))
                                       (EQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ]
            FONT SEL PCTB PC TEXTSTREAM OTEXTOBJ PROP CLEARGET? PARALOOKS PWINDOW)
                                                             (* ; 

                                                    "Remember if the textobj had a window already.")

           (replace
 (TEXTOBJ \WINDOW) of
 TEXTOBJ with
 (AND WINDOW (LIST WINDOW)))
                                                             (* ; 

              "Necessary because some incoming object types depend on knowing where the window is.")

           (replace
 (TEXTOBJ LINES) of
 TEXTOBJ with
 NIL)

     (* ;; "This is here so if we re-OPENTEXTSTREAM an existing stream/window pair we don't get two sets of line descriptors")


           (for
 PROPNAME in
 PROPS by
 (CDDR PROPNAME) as
 PROPVAL
              in
 (CDR PROPS) by
 (CDDR PROPVAL) do
 (TEXTPROP
 TEXTOBJ PROPNAME PROPVAL)
                  )                                          (* ; 

                                          "Save the PROPS for later people who'd like to know them")

           [SETQ FONT (COND
                         ((type?
 CHARLOOKS (LISTGET PROPS 'FONT))
                          (LISTGET PROPS 'FONT))
                         (T (\TEDIT.PARSE.CHARLOOKS.LIST [OR (LISTGET PROPS 'LOOKS)
                                                             (COND
                                                                [(LISTP (LISTGET PROPS 'FONT))
                                                                 (FONTCREATE (LISTGET PROPS
                                                                                    'FONT]
                                                                (T (OR (LISTGET PROPS 'FONT)
                                                                       DEFAULTFONT]
                                   NIL TEXTOBJ]              (* ; 

"Find the default font for this session -- either what the guy tells us, or the global default font")

           (SETQ PARALOOKS (LISTGET PROPS 'PARALOOKS))

     (* ;; "Get the default paragraph looks.  This must come before the first piece is created, so its fields can be filled in right.")


           (replace
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ
              with
 (\TEDIT.UNIQUIFY.PARALOOKS [SETQ PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
                                                                   (OR PARALOOKS
                                                                       (create
 FMTSPEC
                                                                          using
 
                                                                                TEDIT.DEFAULT.FMTSPEC
                                                                              ]
                              TEXTOBJ))
           [COND
              [WAS-TEXTSTREAM                                (* ; 

                                                    "We got a TEXTOFD stream to edit;  just use it")

                     (SETQ OTEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT))
                     (SETQ TEXTSTREAM TEXT)
                     (for
 SELN in
 (LIST (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
                                                (fetch
 (TEXTOBJ SCRATCHSEL) of
 TEXTOBJ)
                                                (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ)
                                                (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ)
                                                (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
                        do
 

                              (* ;; "Make all the selections point to the CURRENT textobj!")


                              (COND
                                 ((EQ OTEXTOBJ (fetch
 (SELECTION \TEXTOBJ) of
 SELN))
                                  (replace
 (SELECTION \TEXTOBJ) of
 SELN with
 TEXTOBJ))
                                 (T (replace
 (SELECTION SET) of
 SELN with
 NIL)))
                              (replace
 (SELECTION ONFLG) of
 SELN with
 NIL))
                     (replace
 (TEXTSTREAM TEXTOBJ) of
 TEXTSTREAM with
 TEXTOBJ)
                     (replace
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ with
 TEXTSTREAM)
                     (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
                     (replace
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ with
 NIL)
                                                             (* ; "Mark the edit incomplete.")

                     (replace
 (TEXTOBJ \DIRTY) of
 TEXTOBJ with
 NIL)
                                                             (* ; "And mark it not changed.")

                     (COND
                        (FONT                                (* ; 

                                                  "If a new default font was specified, set it up.")

                              (replace
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ
                                 with
 (\TEDIT.UNIQUIFY.CHARLOOKS FONT TEXTOBJ]
              ((type?
 TEXTOBJ TEXT)                      (* ; 

                     "We got a TEXTOBJ to edit; fill in the stream, since it might have been GC'd.")

               (SETQ TEXTSTREAM (replace
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ
                                   with
 (create
 TEXTSTREAM
                                                   TEXTOBJ _ TEXTOBJ)))
               (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
               (for
 FORM in
 TEDIT.GET.FINISHEDFORMS do
 (EVAL FORM)))
              (T                                             (* ; 

                                 "Otherwise, create a TEXTOFD to describe the text we're editing.-")

                 (SETQ TEXTSTREAM (replace
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ
                                     with
 (create
 TEXTSTREAM
                                                     TEXTOBJ _ TEXTOBJ)))
                 [replace
 (TEXTOBJ PCTB) of
 TEXTOBJ
                    with
 (SETQ PCTB (TEDIT.BUILD.PCTB TEXT TEXTOBJ START END FONT PARALOOKS
                                               (LISTGET PROPS 'CLEARGET]

                 (* ;; "(setq pc (\\editelt pctb (add1 |\\FirstPieceOffset|)))")


                 (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB)
                                 0))
                 (for
 FORM in
 TEDIT.GET.FINISHEDFORMS do
 (EVAL FORM))
                 (replace
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ with
 (fetch
 (BTREENODE TOTLEN)
                                                                           of
 PCTB]
           (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ
              with
 (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
                                                         (replace
 (TEXTOBJ DEFAULTCHARLOOKS)
                                                            of
 TEXTOBJ with
 (
                                                                            \TEDIT.UNIQUIFY.CHARLOOKS
                                                                                     FONT TEXTOBJ)))
                              TEXTOBJ))
           (replace
 (TEXTOBJ CARET) of
 TEXTOBJ with
 (create

                                                                 TEDITCARET
                                                                 TCCARETDS _
                                                                 (AND WINDOW (WINDOWPROP WINDOW
                                                                                    'DSP))
                                                                 TCFORCEUP _ T))
           (replace
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ with
 (LISTGET PROPS 'READONLY))
           (replace
 (TEXTOBJ TXTTERMSA) of
 TEXTOBJ with
 (AND (SETQ PROP
                                                                          (LISTGET PROPS 'TERMTABLE))
                                                                         (fetch
 TERMSA
                                                                            of
 PROP)))
           (replace
 (TEXTOBJ TXTRTBL) of
 TEXTOBJ with
 (LISTGET PROPS 'READTABLE))
           (replace
 (TEXTOBJ TXTWTBL) of
 TEXTOBJ with
 (LISTGET PROPS 'BOUNDTABLE))
           [COND
              ((LISTGET PROPS 'PAGEFORMAT)                   (* ; 

                              "A default page formatting was supplied.  Impose it on the document.")

               (TEDIT.PAGEFORMAT TEXTOBJ (LISTGET PROPS 'PAGEFORMAT]
           (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
           (SETQ PROP (LISTGET PROPS 'SEL))                  (* ; "Initial Selection, if any.")

           (COND
              ((EQ PROP 'DON'T)                              (* ; 

                                        "A SEL prop of DON'T means don't make an initial selection")

               (replace
 (SELECTION SET) of
 SEL with
 NIL))
              ((type?
 SELECTION PROP)                    (* ; 

                                             "We came in with an explicit initial sel.  Set it up.")

               (\COPYSEL PROP SEL)
               (replace
 (SELECTION SET) of
 SEL with
 T)
               (replace
 (SELECTION \TEXTOBJ) of
 SEL with
 TEXTOBJ))
              ((AND (fetch
 (SELECTION SET) of
 SEL)
                    (NOT PROP))                              (* ; 

                                       "If we came into this with a valid selection, highlight it.")

               (replace
 (SELECTION \TEXTOBJ) of
 SEL with
 TEXTOBJ))
              (T                                             (* ; 

    "Starting without a selection;  let's start with a point selection before the first character.")

                 (replace
 (SELECTION CH#) of
 SEL with
 (COND
                                                                     ((FIXP PROP))
                                                                     (PROP (CAR PROP))
                                                                     (1)))
                 (replace
 (SELECTION CHLIM) of
 SEL with
 (COND
                                                                       ((FIXP PROP))
                                                                       (PROP (IPLUS (CAR PROP)
                                                                                    (CADR PROP)))
                                                                       (1)))
                 (replace
 (SELECTION DCH) of
 SEL with
 (COND
                                                                     ((FIXP PROP)
                                                                      0)
                                                                     (PROP (CADR PROP))
                                                                     (0)))
                 (replace
 (SELECTION DX) of
 SEL with
 0)
                 (replace
 (SELECTION POINT) of
 SEL with
 'LEFT)
                 (replace
 (SELECTION SELKIND) of
 SEL with
 'CHAR)
                 (replace
 (SELECTION SET) of
 SEL with
 (NOT (fetch
 (TEXTOBJ 
                                                                                         TXTREADONLY)
                                                                          of
 TEXTOBJ)))
                 (replace
 (SELECTION \TEXTOBJ) of
 SEL with
 TEXTOBJ)))
           [COND
              ((fetch
 (SELECTION SET) of
 SEL)        (* ; 

                            "If there's an initial selection, it implies initial caret looks, too.")

               (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ with
 (\TEDIT.GET.INSERT.CHARLOOKS
                                                                          TEXTOBJ SEL]
           (COND
              ((AND WINDOW (NOT TEXTOBJ.WINDOW.VALID))       (* ; 

                                                       "Only if there's a window to display it in:")

               (replace
 (TEXTOBJ \WINDOW) of
 TEXTOBJ with
 NIL)
               (\TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS)
                                                             (* ; 

                                                 "Set up the window, and display the initial text.")

               )
              ((SETQ PWINDOW (LISTGET PROPS 'PROMPTWINDOW))

               (* ;; "There is no window for the session, but he has passed in a promptwindow to use, install it in the textobj")


               (replace
 (TEXTOBJ PROMPTWINDOW) of
 TEXTOBJ with
 PWINDOW)))
           (\SETUPGETCH
 (create
 EDITMARK
                                   PC _ (\GETBASEPTR (\FIRSTNODE PCTB)
                                               0)
                                   PCOFF _ 0
                                   PCNO _ 1)
                  TEXTOBJ)                                   (* ; "Set the file ptr to 0")

           (RETURN TEXTSTREAM])

(REOPENTEXTSTREAM

  [LAMBDA (STREAM)
                                       (* ; "Edited 31-May-91 14:18 by jds")

    (replace
 (STREAM ACCESS) of
 STREAM with
 'BOTH)
    (replace
 (STREAM BINABLE) of
 STREAM with
 T)
    (replace
 (STREAM STRMBINFN) of
 STREAM with
 (FUNCTION \TEXTBIN))
    (replace
 (STREAM STRMBOUTFN) of
 STREAM with
 (FUNCTION \TEXTBOUT))
    STREAM])

(TEDIT.STREAMCHANGEDP

  [LAMBDA (STREAM RESET?)
                                (* ; "Edited 31-May-91 13:57 by jds")

    (PROG1 (fetch
 (TEXTOBJ \DIRTY) of
 (TEXTOBJ STREAM))
        (COND
           (RESET? (replace
 (TEXTOBJ \DIRTY) of
 (TEXTOBJ STREAM) with
 NIL))))])

(TEXTSTREAMP

  (LAMBDA (STREAM)
                                           (* jds " 3-Apr-84 14:34")

          
          (* Returns the stream if it is a text stream, else NIL)


    (AND (STREAMP STREAM)
         (type?
 TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
         STREAM)))

(TXTFILE

  [LAMBDA (TEXTOBJ)
                                      (* ; "Edited 31-May-91 13:58 by jds")

                                                             (* This function is for compiled 

                                                           access to the TXTFILE field in 

                                                           RESETSAVE expressions)

    (fetch
 (TEXTOBJ TXTFILE) of
 TEXTOBJ])

(\DELETECH

  [LAMBDA (CH# CHLIM LEN TEXTOBJ DONTDIRTY)
             (* ; "Edited 29-Jan-99 17:28 by kaplan")


    (* ;; "Delete the indicated characters from the text object represented by TEXTOBJ")


    (* ;; 

  "If DONTDIRTY is non-NIL, then don't notice this change for purposes of UNDO or dirtiness.")


    (COND
       ((OR DONTDIRTY (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))

        (* ;; "Only delete characters if changes are permitted, or if it's a TEdit-internal fixup change, e.g., when an NS character 255-x sequence is seen.")


        (LET ((\INFIRSTCH (fetch
 (TEXTOBJ \INSERTFIRSTCH) of
 TEXTOBJ))
              (TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
              (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
              START-OF-PIECE PCLST)
             (\TEDIT.CHECK (IGEQ LEN 0)
                    "LEN of delete must be >0.")
             (\TEDIT.CHECK (IEQP LEN (IDIFFERENCE CHLIM CH#)))
             [COND
                ((AND (fetch
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ)
                      (IEQP CHLIM (fetch
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ))
                      (IGEQ CH# \INFIRSTCH))                 (* ; 

         "The deletion is from the end of the most recent type-in.  Just adjust the buffer string.")

                 (freplace
 (TEXTOBJ \INSERTLEN) of
 TEXTOBJ with

                                                                   (replace
 (PIECE PLEN)
                                                                      of
 (fetch
 (TEXTOBJ
                                                                                         \INSERTPC)
                                                                                of
 TEXTOBJ)
                                                                      with
 (IDIFFERENCE CH# 
                                                                                      \INFIRSTCH)))
                                                             (* ; "Cut back the length")

                 (freplace
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ
                    with
 (IPLUS (fetch
 (TEXTOBJ \INSERTLEN) of
 TEXTOBJ)
                                    \INFIRSTCH))             (* ; 

                        "and ch# of next insertion (i.e., 1 past the top CH# in the insert piece.)")

                 (replace
 THLEN of
 (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ)
                    with
 (IDIFFERENCE (fetch
 THLEN of
 (fetch
 (TEXTOBJ TXTHISTORY)
                                                                     of
 TEXTOBJ))
                                    LEN))                    (* ; 

                                     "Reduce the length of the insertion in the history list, too.")

                 (COND
                    ((ZEROP (fetch
 (TEXTOBJ \INSERTLEN) of
 TEXTOBJ))

                     (* ;; "He's completely emptied the type-in piece.  Remove it and force creation of a fresh one at next type-in.")


                     (\DELETEPIECE
 (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ)
                            PCTB)                            (* UPDATEPCNODES (fetch

                                                           (TEXTOBJ \INSERTPC) of TEXTOBJ)

                                                           (IMINUS LEN) PCTB)

                     (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
                                                             (* ; 

                                                 "Force the next insertion to be in a fresh piece.")

                     )
                    (T (UPDATEPCNODES (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ)
                              (IMINUS LEN)
                              PCTB)))                        (* ; "Adjust CH#s in the Piece Table.")

                 )
                ((ILEQ CH# TEXTLEN)                          (* ; 

                                      "General case of deletion: Remove pieces as needed to do it.")

                 (PROG (PCN PC1 PCNON PCSOUT (HIPC NIL)
                            HI LO)
                       (SETQ PC1 (\CHTOPC
 CH# PCTB T))   (* ; 

                                                "Piece # of piece containing start of deleted text")

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

                              "Split the piece, so the deleted text now starts on a piece boundary")

                           (\SPLITPIECE
 PC1 (- CH# START-OF-PIECE)
                                  TEXTOBJ))
                          (T (SETQ PC1 (fetch
 (PIECE PREVPIECE) of
 PC1))
                                                             (* ; 

                                                "PC1 _ piece before the first piee to be deleted.-")

                             ))
                       (COND
                          ((ILEQ CHLIM TEXTLEN)              (* ; 

                                      "Find the peice that contains the END of the deleted section")

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

 "Deleting past end, so n+1-th piece is the symbol LASTPIECE, which starts 1 past end of all text.")


                             (SETQ START-OF-PIECE (ADD1 TEXTLEN))
                             (SETQ PCN 'LASTPIECE)
                             (SETQ HIPC NIL)))
                       [COND
                          ((ATOM PCN)                        (* ; 

                                                           "Deleting before the end of text.")

                           )
                          (T                                 (* ; 

                                                        "Deleting in front of a real piece of text")

                             (COND
                                ([AND (IGREATERP CHLIM START-OF-PIECE)
                                      (ILESSP CHLIM (IPLUS START-OF-PIECE (fetch
 (PIECE PLEN)
                                                                             of
 PCN]
                                 (SETQ HIPC (\SPLITPIECE
 PCN (- CHLIM START-OF-PIECE)
                                                   TEXTOBJ PCNON))
                                 (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ)))
                                (T (SETQ HIPC PCN]           (* ; 

                                                   "if not on a piece bound, split the last piece.")

                       (AND PC1 (EQ PC1 HIPC)
                            (HELP "circular"))
                       [SETQ PCLST (bind
 NPC [PC _ (COND
                                                          (PC1 (fetch
 (PIECE NEXTPIECE)
                                                                  of
 PC1))
                                                          (T 
                                                             (* ;; 

                                                         "(\EDITELT PCTB (ADD1 \FirstPieceOffset))")


                                                             (\GETBASEPTR (\FIRSTNODE PCTB)
                                                                    0]
                                      while
 (AND PC (NEQ PC HIPC))
                                      collect
 (PROG1 PC
                                                      (SETQ PC (fetch
 (PIECE NEXTPIECE)
                                                                  of
 PC)))]
                       [OR DONTDIRTY (\TEDIT.HISTORYADD TEXTOBJ
                                            (create
 TEDITHISTORYEVENT
                                                   THACTION _ 'Delete
                                                   THLEN _ LEN
                                                   THCH# _ CH#
                                                   THFIRSTPIECE _ (CAR PCLST]
                                                             (* ; 

                                                           "Add this event to the history list")


                  (* ;; "Actually delete the pieces:")


                       (for
 PC in
 PCLST do
 [AND (fetch
 (PIECE POBJ) of
 PC)
                                                            (IMAGEOBJPROP (fetch
 (PIECE POBJ)
                                                                             of
 PC)
                                                                   'WHENDELETEDFN)
                                                            (APPLY* (IMAGEOBJPROP (fetch

                                                                                   (PIECE POBJ)
                                                                                     of
 PC)
                                                                           'WHENDELETEDFN)
                                                                   (fetch
 (PIECE POBJ)
                                                                      of
 PC)
                                                                   (CAR (fetch
 (TEXTOBJ \WINDOW)
                                                                           of
 TEXTOBJ] 
                                                             (* \DELETEPIECE PC PCTB)

                                                      (\DELETETREE PC (fetch
 (PIECE PTREENODE)
                                                                         of
 PC)))

                  (* ;; "Link around the deleted pieces:")


                       (COND
                          (PC1 (replace
 (PIECE NEXTPIECE) of
 PC1 with
 HIPC)))
                       (COND
                          (HIPC (replace
 (PIECE PREVPIECE) of
 HIPC with
 PC1)))

                  (* ;; "Unchain the deleted pieces from the rest of the document.")


                       (AND (CAR (FLAST PCLST))
                            (replace
 (PIECE PREVPIECE) of
 (CAR (FLAST PCLST)) with
 NIL))
                       (AND (CAR PCLST)
                            (replace
 (PIECE PREVPIECE) of
 (CAR PCLST) with
 NIL))
                       (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
                                                             (* ; 

                                                 "Force the next insertion to be in a fresh piece.")

                       (\TEDIT.DIFFUSE.PARALOOKS PC1 HIPC)   (* ; 

                                                           "PROPOGATE PARALOOKS THRU THE DELETION")

                   ]
             (freplace
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ with
 (IDIFFERENCE TEXTLEN LEN))
                                                             (* ; "Update the file's length")

             (OR DONTDIRTY (replace
 (TEXTOBJ \DIRTY) of
 TEXTOBJ with
 T])

(\SETUPGETCH

  [LAMBDA (CH# TEXTOBJ)
                                  (* ; "Edited 14-Apr-93 17:14 by jds")


(* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#")


    (* ;; "NB that 1st char in the textobj is #1.")


    (* ;; "(declare (localvars . t))")


    (PROG (PC PCNO PS PF CHOFFSET CHARSLEFT (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
              (STREAM (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ))
              FPOS OFFST SUBSTREAM START-OF-PIECE)
          (replace
 (TEXTSTREAM FATSTREAMP) of
 STREAM with
 NIL)
          [COND
             [(LISTP CH#)                                    (* ; 

                                                   "If CH# is a piece-offset pair, make use of it.")

              (SETQ PC (fetch
 (EDITMARK PC) of
 CH#))
              (SETQ CHOFFSET (fetch
 (EDITMARK PCOFF) of
 CH#))
              (COND
                 ((ATOM PC)                                  (* ; 

                                                    "This SETUPGETCH is to the final pseudo-piece!")

                  (freplace
 (TEXTSTREAM PIECE) of
 STREAM with
 PC)
                  (freplace
 (STREAM COFFSET) of
 STREAM with
 0)
                  (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
                  (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
                  (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM with
 0)
                  (freplace
 (TEXTSTREAM PCOFFSET) of
 STREAM with
 0)
                  (RETURN]
             ((IGREATERP CH# (IMAX 1 (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)))
              (ERROR "TRYING TO \SETUPGETCH BEYOND END OF TEXT"))
             (T 
                (* ;; "CH# is indeed a character number.  Find the corresponding piece, its pcno, and the offset within that piece.")


                (SETQ PC (\CHTOPC
 CH# PCTB T))

                (* ;; "(setq pc (\\editelt pctb (add1 pcno)))")


                (SETQ CHOFFSET (- CH# START-OF-PIECE]
          (freplace
 (TEXTSTREAM PIECE) of
 STREAM with
 PC)
          (replace
 (STREAM BINABLE) of
 STREAM with
 T)
          (SETQ CHARSLEFT (IDIFFERENCE (fetch
 (PIECE PLEN) of
 PC)
                                 CHOFFSET))
          (freplace
 (TEXTSTREAM PCOFFSET) of
 STREAM with
 CHOFFSET)
          (COND
             ((SETQ PS (ffetch
 (PIECE PSTR) of
 PC))  (* ; "This piece resides in a STRING.")

              (\TEDIT.TEXTBIN.STRINGSETUP
 CHOFFSET CHARSLEFT STREAM PS))
             ((SETQ PF (ffetch
 (PIECE PFILE) of
 PC)) (* ; "This piece resides on a FILE")

              (\TEDIT.TEXTBIN.FILESETUP
 PC CHOFFSET CHARSLEFT STREAM PF (fetch
 (PIECE PFATP)
                                                                               of
 PC)))
             [(SETQ PF (ffetch
 (PIECE POBJ) of
 PC))  (* ; 

          "This piece points to an object.  set up so \TextBin will be called, and will return it.")

              (COND
                 ((SETQ SUBSTREAM (IMAGEOBJPROP PF 'SUBSTREAM))
                                                             (* ; 

                                         "There is a stream below this one! Reflect things upward.")

                                                             (* ; 

                                    "This is a simple object.  Just set things up so it gets read.")

                  (\SETUPGETCH
 (ADD1 CHOFFSET)
                         (fetch
 (TEXTSTREAM TEXTOBJ) of
 SUBSTREAM))
                  (replace
 (STREAM BINABLE) of
 STREAM with
 NIL)
                  (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
                  (freplace
 (STREAM COFFSET) of
 STREAM with
 CHOFFSET)
                  (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 (fetch
 (PIECE PLEN)
                                                                            of
 PC))
                  (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
                  (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM with
 CHOFFSET)
                  (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
                  (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with

                                                                           (fetch
 (TEXTSTREAM
                                                                                       
                                                                                     CURRENTPARALOOKS
                                                                                       ) of

                                                                                         SUBSTREAM))
                  (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM with
 (fetch

                                                                                 (TEXTSTREAM 
                                                                                        CURRENTLOOKS)
                                                                                   of
 SUBSTREAM))
                  (RETURN))
                 (T                                          (* ; 

                                    "This is a simple object.  Just set things up so it gets read.")

                    (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 1)
                    (freplace
 (STREAM COFFSET) of
 STREAM with
 0)
                    (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 1)
                    (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
                    (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM with
 0)
                    (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
                    (replace
 (STREAM BINABLE) of
 STREAM with
 NIL)
                                                             (* ; 

                                                          "Force the next BIN to go thru our code.")

                    ]
             (T (ERROR "Piece is neither a file nor a string??" PC)))
          (replace
 (TEXTSTREAM CURRENTPARALOOKS) of
 STREAM with

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

                                                         "Set the character looks and font caches.")

          (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM with
 (\TEDIT.APPLY.STYLES
                                                                         (ffetch
 (PIECE PLOOKS)
                                                                            of
 PC)
                                                                         PC TEXTOBJ])

(\TEDIT.REOPEN.STREAM

  [LAMBDA (TEXTSTREAM PIECESTREAM)
                       (* ; "Edited 11-Jun-99 15:12 by rmk:")


                                                             (* ; "Edited 11-Jun-99 15:12 by rmk:")


                                                             (* ; "Edited 11-Jun-99 14:24 by rmk:")


                                                             (* ; "Edited 15-Apr-93 15:53 by jds")


    (* ;; "Re-open the backing file stream, and propogate the change thru the entire piece table.  Also, if TXTFILE is set to the closed stream, fill it in as well.")


    (LET* ([NEWSTREAM (OPENSTREAM PIECESTREAM 'INPUT NIL '((TYPE TEXT]
           (TEXTOBJ (TEXTOBJ TEXTSTREAM))
           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
           PC)
          (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB)
                          0))

          (* ;; "Run thru the pieces, correcting any that used this stream to use the new one:")


          (while
 PC do
 (COND
                                  ((EQ (fetch
 (PIECE PFILE) of
 PC)
                                       PIECESTREAM)
                                   (replace
 (PIECE PFILE) of
 PC with
 NEWSTREAM)))
                              (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC)))

          (* ;; "Check the TXTFILE, and if it uses the closed stream, fix it as well:")


          (COND
             ((EQ (fetch
 (TEXTOBJ TXTFILE) of
 TEXTOBJ)
                  PIECESTREAM)                               (* ; 

                                                     "Yup, it was the old, closed stream.  Fix it.")

              (replace
 (TEXTOBJ TXTFILE) of
 TEXTOBJ with
 NEWSTREAM)))

          (* ;; "Return the new value for the stream:")


          NEWSTREAM])

(\TEDIT.COPYTEXTSTREAM.PIECEMAPFN

  [LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ)
                     (* ; "Edited 31-May-91 14:00 by jds")

                                                             (* Called by COPYTEXTSTREAM via 

                                                           TEDIT.SELECTED.PIECES, to do the 

                                                           copy-operation processing on the 

                                                           candidate pieces.)

    (PROG (OBJ NEWOBJ COPYFN)
          (SETQ PC (create
 PIECE using
 PC PNEW _ T)) (* No matter what, we need a fresh 

                                                           copy.)

          [COND
             ((fetch
 (PIECE POBJ) of
 PC)             (* This piece describes an object)

              (SETQ OBJ (fetch
 (PIECE POBJ) of
 PC))
              [COND
                 [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN))
                  (SETQ NEWOBJ (APPLY* COPYFN OBJ (fetch
 (TEXTOBJ STREAMHINT) of
 FROMOBJ)
                                      (fetch
 (TEXTOBJ STREAMHINT) of
 TOOBJ)))
                  (COND
                     ((EQ NEWOBJ 'DON'T)                     (* He said not to copy this piece --

                                                           abort the whole copy.)

                      (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T)
                      (RETFROM 'TEDIT.COPY))
                     (NEWOBJ (replace
 (PIECE POBJ) of
 PC with
 NEWOBJ))
                     (T (replace
 (PIECE POBJ) of
 PC with
 (COPYALL OBJ]
                 (OBJ                                        (* No copy fn; just strike off a 

                                                           copy of our own)

                      (replace
 (PIECE POBJ) of
 PC with
 (COPYALL OBJ]
              (COND
                 ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN))
                                                             (* If there's an eventfn for 

                                                           copying, use it.)

                  (APPLY* COPYFN OBJ (CAR (fetch
 (TEXTOBJ \WINDOW) of
 TOOBJ))
                         (fetch
 (TEXTOBJ STREAMHINT) of
 FROMOBJ)
                         (fetch
 (TEXTOBJ STREAMHINT) of
 TOOBJ]
          (RETURN PC])

(\TEXTINIT

  [LAMBDA NIL
                                           (* ; "Edited  7-Oct-2021 08:40 by rmk:")

                                                             (* ; 

                                          "Create the FDEV and STREAM prototypes for TEXT streams.")


    (* ;; "TEXT streams make use of the following STREAM fields:")


    (* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")


    (* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")


    (* ;; "F2 (* # chars left in piece at end of underlying file's page)")


    (* ;; "F3 (* The TEXTOBJ for this stream)")


    (* ;; "F4")


    (* ;; "F5 (* The PIECE we're currently inside)")


    (* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")


    (* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")


    (* ;; "(FW8 WORD)")


    (SETQ \TEXTIMAGEOPS (create
 IMAGEOPS
                               IMAGETYPE _ 'TEXT
                               IMXPOSITION _ (FUNCTION \TEXTDSPXPOSITION)
                               IMYPOSITION _ (FUNCTION \TEXTDSPYPOSITION)
                               IMLEFTMARGIN _ (FUNCTION \TEXTLEFTMARGIN)
                               IMRIGHTMARGIN _ (FUNCTION \TEXTRIGHTMARGIN)
                               IMFONT _ (FUNCTION \TEXTDSPFONT)
                               IMCLOSEFN _ (FUNCTION NILL)
                               IMFONTCREATE _ 'DISPLAY
                               IMLINEFEED _ (FUNCTION \TEXTDSPLINEFEED)
                               IMCHARWIDTH _ (FUNCTION \TEXTDSPCHARWIDTH)
                               IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH)))
    (SETQ \TEXTFDEV (create
 FDEV
                           DEVICENAME _ 'TEXT
                           RESETABLE _ T
                           RANDOMACCESSP _ T
                           PAGEMAPPED _ NIL
                           GETFILENAME _ (FUNCTION NILL)
                           BIN _ (FUNCTION \TEXTBIN)
                           BOUT _ (FUNCTION \TEXTBOUT)
                           CLOSEFILE _ (FUNCTION \TEXTCLOSEF)
                           OPENFILE _ (FUNCTION \TEXTOPENF)
                           DELETEFILE _ (FUNCTION NILL)
                           DIRECTORYNAMEP _ (FUNCTION NILL)
                           EVENTFN _ (FUNCTION NILL)
                           GENERATEFILES _ (FUNCTION \GENERATENOFILES)
                           GETFILEINFO _ (FUNCTION NILL)
                           HOSTNAMEP _ (FUNCTION NILL)
                           READPAGES _ (FUNCTION NILL)
                           REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM)
                                                    (replace
 (STREAM ACCESS) of
 STREAM
                                                       with
 'BOTH)
                                                    STREAM]
                           SETFILEINFO _ (FUNCTION NILL)
                           BACKFILEPTR _ (FUNCTION \TEXTBACKFILEPTR)
                           SETFILEPTR _ (FUNCTION \TEXTSETFILEPTR)
                           PEEKBIN _ (FUNCTION \TEXTPEEKBIN)
                           GETEOFPTR _ (FUNCTION \TEXTGETEOFPTR)
                           GETFILEPTR _ (FUNCTION \TEXTGETFILEPTR)
                           EOFP _ (FUNCTION \TEXTEOFP)
                           FDBINABLE _ T
                           FDBOUTABLE _ NIL
                           FDEXTENDABLE _ NIL
                           TRUNCATEFILE _ (FUNCTION NILL)
                           WRITEPAGES _ (FUNCTION NILL)))

    (* ;; "The prototypical Text stream")


    (SETQ \TEXTOFD
     (create
 STREAM
            BINABLE _ T
            BOUTABLE _ NIL
            ACCESS _ 'BOTH
            USERCLOSEABLE _ T
            USERVISIBLE _ T
            DEVICE _ \TEXTFDEV
            F1 _ NIL
            F2 _ 0
            F3 _ NIL
            F5 _ NIL
            FW6 _ 0
            FW7 _ 0
            MAXBUFFERS _ 10
            IMAGEOPS _ \TEXTIMAGEOPS
            IMAGEDATA _ (create
 TEXTIMAGEDATA)))

    (* ;; "Maybe more functions later?")


    (MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN)
           NIL
           'CR)
    (\EXTERNALFORMAT \TEXTOFD :TEDIT)

    (* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")


    (CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
           (FUNCTION (LAMBDA (CONDITION)
                       (LET ((STREAM (STREAM-ERROR-STREAM CONDITION)))
                            (COND
                               [(AND (BOUNDP 'ERRORPOS)
                                     (TEXTSTREAMP
 STREAM))
                                                             (* ; 

           "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")

                                (LET ((XCL::RESULT (REOPENTEXTSTREAM
 STREAM)))
                                     (CL:WHEN XCL::RESULT
                                         (ENVAPPLY (STKNAME ERRORPOS)
                                                (SUBST XCL::RESULT STREAM (STKARGS ERRORPOS))
                                                (STKNTH -1 ERRORPOS ERRORPOS)
                                                ERRORPOS T T))]
                               (*TEDIT-OLD-STREAM-ERROR-HANDLER* 
                                                             (* ; 

                         "Some other kind of stream, so punt to the old handler (if there is one):")

                                      (APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])

(\TEXTMARK

  [LAMBDA (TEXTOBJ)
                                      (* ; "Edited 31-May-91 14:18 by jds")

    (PROG ((STREAM (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)))
          (RETURN (CONS (ffetch
 (TEXTSTREAM PIECE) of
 STREAM)
                        (IDIFFERENCE (create
 BYTEPTR
                                            PAGE _ (ffetch
 (STREAM CPAGE) of
 STREAM)
                                            OFFSET _ (ffetch
 (STREAM COFFSET) of
 STREAM))
                               (create
 BYTEPTR
                                      PAGE _ (ffetch
 (TEXTSTREAM PCSTARTPG) of
 STREAM)
                                      OFFSET _ (ffetch
 (TEXTSTREAM PCSTARTCH) of
 STREAM])

(\TEXTTTYBOUT

  [LAMBDA (STREAM BYTE)
                                  (* ; "Edited 31-May-91 14:18 by jds")

                                                             (* Do BOUT to a text stream, which 

                                                           is an insertion at the caret.)

    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM)))
          (COND
             ((EQ BYTE ERASECHARCODE)
              (\TEDIT.CHARDELETE TEXTOBJ "" (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)))
             ((EQ IGNORE.CCE (fetch
 CCECHO of
 (\SYNCODE (OR (fetch
 (TEXTOBJ TXTTERMSA)
                                                                       of
 TEXTOBJ)
                                                                    \PRIMTERMSA)
                                                             BYTE)))
                                                             (* Nothing, ignore it)

              )
             (T (SELCHARQ BYTE
                     ((EOL CR LF) 
                          (\TEXTBOUT
 STREAM BYTE)
                          (replace
 (STREAM CHARPOSITION) of
 STREAM with
 0))
                     (PROGN (\TEXTBOUT
 STREAM BYTE)
                            (add
 (fetch
 (STREAM CHARPOSITION) of
 STREAM)
                                   1])
)
(DEFINEQ

(\INSERTCH

  [LAMBDA (CH CH# TEXTOBJ INSERTMARK)
                   (* ; "Edited 29-Jan-99 17:19 by kaplan")


    (* ;; "If the current ch is 1+last ch in the distinguished INPUTPIECE, then append this text to that piece (make a new one if need be.), and fix up ch#s in the PCTB")


    (* ;; "else, create a new input piece (as a substring of the old one) and INSERT it at the right spot, perhaps after splitting a piece to make room.")


    (COND
       ((NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ))

        (* ;; "Only insert if the document is allowed to change.")


        (PROG (PC (LEN (COND
                          ((type?
 STRINGP CH)
                           (NCHARS CH))
                          (T 1)))
                  [FATP (COND
                           [(type?
 STRINGP CH)
                            (AND (fetch
 (STRINGP FATSTRINGP) of
 CH)
                                 (NOT (NULL (for
 CHAR instring
 CH
                                               thereis
 (IGREATERP CHAR \MAXTHINCHAR]
                           (T (IGREATERP CH \MAXTHINCHAR]
                  CHNO NEWPC PREVPC EVENT REPLACING (NEWFLAG NIL)
                  (\INEXTCH (fetch
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ))
                  (\INLEN (fetch
 (TEXTOBJ \INSERTLEN) of
 TEXTOBJ))
                  (\INLEFT (fetch
 (TEXTOBJ \INSERTLEFT) of
 TEXTOBJ))
                  (\INSTRING (fetch
 (TEXTOBJ \INSERTSTRING) of
 TEXTOBJ))
                  (\INPC (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ))
                  (\INFIRSTCH (fetch
 (TEXTOBJ \INSERTFIRSTCH) of
 TEXTOBJ))
                  (PCTB (ffetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
                  (TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                  (IMARKPC (fetch
 (EDITMARK PC) of
 INSERTMARK))
                  (IMARKCH (fetch
 (EDITMARK PCOFF) of
 INSERTMARK))
                  PLOOKS NLOOKS START-OF-PIECE)
              [COND
                 ((ZEROP LEN)                                (* ; "Nothing to insert, really!")

                  (RETURN))
                 [(ZEROP (fetch
 (BTREENODE COUNT) of
 PCTB))
                                                             (* ; "PCTB is empty.")

                  (\INSERT.FIRST.PIECE
 TEXTOBJ)
                  (SETQ \INPC (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ))
                  (SETQ \INSTRING (fetch
 (TEXTOBJ \INSERTSTRING) of
 TEXTOBJ))
                  (COND
                     ((type?
 STRINGP CH)                 (* ; 

                                       "If input is a string, copy it to the insert piece's string")

                      (RPLSTRING \INSTRING 1 CH))
                     (T                                      (* ; 

                                         "If it's a single charcode, move it to the piece's string")

                        (RPLCHARCODE \INSTRING 1 CH)))
                  (replace
 (PIECE PLEN) of
 \INPC (freplace
 (TEXTOBJ \INSERTLEN)
                                                            of
 TEXTOBJ with
 LEN))
                  (freplace
 (TEXTOBJ \INSERTLEFT) of
 TEXTOBJ with
 (IDIFFERENCE 512 LEN))
                  (freplace
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ with
 LEN)
                  (\TEDIT.HISTORYADD TEXTOBJ (create
 TEDITHISTORYEVENT
                                                    THACTION _ 'Insert
                                                    THLEN _ (fetch
 (PIECE PLEN) of
 \INPC)
                                                    THCH# _ CH#
                                                    THFIRSTPIECE _ (LIST \INPC)
                                                    THPOINT _ 'RIGHT]
                 ((OR [AND (fetch
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ)
                           (OR (IEQP CH# \INEXTCH)
                               (AND INSERTMARK (EQ IMARKPC (fetch
 (PIECE NEXTPIECE) of
 \INPC)
                                                   )
                                    (EQ IMARKCH 0]
                      (AND NIL (EQ CH# 1)
                           (EQ \INEXTCH -1)))

                  (* ;; "We're inserting at the end of a previous insertion, for which we already have a piece built.  Just add to it.")


                  (* ;; "Or, First insertion to empty document.")


                  (COND
                     ((IGEQ \INLEFT LEN)                     (* ; 

                                                 "There's enough room in this piece -- fill it in.")

                      (COND
                         ((type?
 STRINGP CH)             (* ; 

                                       "If input is a string, copy it to the insert piece's string")

                          (RPLSTRING \INSTRING (ADD1 \INLEN)
                                 CH))
                         (T                                  (* ; 

                                         "If it's a single charcode, move it to the piece's string")

                            (RPLCHARCODE \INSTRING (ADD1 \INLEN)
                                   CH)))
                      (replace
 (PIECE PLEN) of
 \INPC with
 (freplace
 (TEXTOBJ 
                                                                                           \INSERTLEN
                                                                                           )
                                                                         of
 TEXTOBJ
                                                                         with
 (IPLUS \INLEN LEN))
                             )                               (* ; 

                                                           "Fix the length of the insert piece")

                      (freplace
 (TEXTOBJ \INSERTLEFT) of
 TEXTOBJ with
 (IDIFFERENCE 
                                                                                         \INLEFT LEN)
                             )                               (* ; "And the space left in the piece")

                      (freplace
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ with
 (IPLUS \INEXTCH 
                                                                                           LEN))
                                                             (* ; "And the next CH#")

                                                             (* ; "And the piece # for future use")

                      )
                     (T                                      (* ; 

                                                     "No room.  Chop this piece & start a new one.")

                        (replace
 (PIECE PSTR) of
 \INPC with
 (SUBSTRING \INSTRING 1 \INLEN
                                                                               ))
                                                             (* ; 

                                                        "Chop the current piece's string to length")

                        (SETQ NEWPC (create
 PIECE
                                           PSTR _ (ALLOCSTRING 512 '% )
                                           PLOOKS _ (fetch
 (PIECE PLOOKS) of
 \INPC)
                                           PPARALOOKS _ (fetch
 (PIECE PPARALOOKS) of
 \INPC)
                                           PPARALAST _ NIL
                                           PNEW _ T))        (* ; "Create the new piece")

                        (freplace
 (TEXTOBJ \INSERTSTRING) of
 TEXTOBJ
                           with
 (SETQ \INSTRING (fetch
 (PIECE PSTR) of
 NEWPC)))
                                                             (* ; 

                                                           "Set the \INSTRING field in TEXTOBJ")

                        (COND
                           ((type?
 STRINGP CH)           (* ; 

                                       "If input is a string, copy it to the insert piece's string")

                            (RPLSTRING \INSTRING 1 CH))
                           (T                                (* ; 

                                         "If it's a single charcode, move it to the piece's string")

                              (RPLCHARCODE \INSTRING 1 CH)))
                        (replace
 (PIECE PLEN) of
 NEWPC with
 LEN)
                                                             (* ; 

                                         "So far, the present input is the only thing in the piece")

                        (replace
 (TEXTOBJ \INSERTPCNO) of
 TEXTOBJ
                           with
 (\INSERTPIECE
 NEWPC (OR (fetch
 (PIECE NEXTPIECE)
                                                                   of
 \INPC)
                                                                'LASTPIECE)
                                           TEXTOBJ))         (* ; 

                                          "Insert the new piece into the text and save the piece #")


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

                                                             (* ; 

                                                           "Which may have caused a PCTB overflow")

                                                             (* ; 

                                                       "This does not happen, after change pctree.")

                        (freplace
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ with
 (SETQ \INPC NEWPC))
                        (freplace
 (TEXTOBJ \INSERTLEFT) of
 TEXTOBJ with
 (IDIFFERENCE
                                                                                     512 LEN))
                        (freplace
 (TEXTOBJ \INSERTLEN) of
 TEXTOBJ with
 LEN)
                        (replace
 (TEXTOBJ \INSERTFIRSTCH) of
 TEXTOBJ with
 CH#)
                                                             (* ; 

                                                           "CH# of the first inserted character")

                        (replace
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ with
 (IPLUS CH# LEN))
                                                             (* ; 

                            "The CH# of the next character, if it's inserted at the current caret.")

                        (replace
 THFIRSTPIECE of
 (fetch
 (TEXTOBJ TXTHISTORY) of

                                                                                         TEXTOBJ)
                           with
 (NCONC1 (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ)
                                           NEWPC))
                        (SETQ NEWFLAG T)                     (* ; "Note the new piece's creation")

                        ))
                  (add
 (fetch
 THLEN of
 (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ))
                         LEN)                                (* ; 

                                             "Update the length of the insertion/replacement text.")

                  )
                 (T 
                    (* ;; "NEW INSERTION POINT;  IF THERE'S ANYTHING LEFT OF THE PREVIOUS INSERT PIECE, CRACK OFF A NEW ONE & FILL IT.  THEN FIGURE OUT WHERE TO SHOEHORN IT IN.")


                    (SETQ PC (OR IMARKPC (\CHTOPC
 CH# PCTB T)))
                    [COND
                       ((AND \INPC (IGEQ \INLEFT LEN))       (* ; 

                                 "There's room left in the prior input-piece's string;  re-use it.")

                        (SETQ NEWPC (create
 PIECE
                                           PSTR _ (SUBSTRING \INSTRING (ADD1 \INLEN))
                                           PLOOKS _ (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
                                           PPARALOOKS _ (fetch
 (PIECE PPARALOOKS) of
 \INPC)
                                           PPARALAST _ NIL
                                           PNEW _ T))        (* ; "Build the new piece")

                        (replace
 (PIECE PSTR) of
 \INPC with
 (SUBSTRING \INSTRING 1 \INLEN
                                                                               ))
                        (freplace
 (TEXTOBJ \INSERTLEFT) of
 TEXTOBJ with
 (IDIFFERENCE
                                                                                     \INLEFT LEN)))
                       (T                                    (* ; 

                                                          "No room left;  build a whole new piece.")

                          (SETQ NEWPC (create
 PIECE
                                             PSTR _ (freplace
 (TEXTOBJ \INSERTSTRING)
                                                       of
 TEXTOBJ with
 (ALLOCSTRING 512))
                                             PLOOKS _ (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
                                             PPARALOOKS _ (OR (AND \INPC (fetch
 (PIECE PPARALOOKS
                                                                                           )
                                                                            of
 \INPC))
                                                              (\TEDIT.UNIQUIFY.PARALOOKS
                                                               (create
 FMTSPEC
                                                                  copying
 (fetch
 (TEXTOBJ
                                                                                          FMTSPEC)
                                                                                 of
 TEXTOBJ))
                                                               TEXTOBJ))
                                             PPARALAST _ NIL
                                             PNEW _ T))
                          (freplace
 (TEXTOBJ \INSERTLEFT) of
 TEXTOBJ with
 (IDIFFERENCE
                                                                                       512 LEN]
                    (freplace
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ with
 (SETQ \INPC NEWPC))
                    (replace
 (PIECE PLEN) of
 NEWPC with
 LEN)
                    (freplace
 (TEXTOBJ \INSERTSTRING) of
 TEXTOBJ with

                                                                         (SETQ \INSTRING
                                                                          (fetch
 (PIECE PSTR)
                                                                             of
 NEWPC)))
                    (COND
                       ((type?
 STRINGP CH)               (* ; 

                                                           "Insert the characters into the piece")

                        (RPLSTRING \INSTRING 1 CH))
                       (T (RPLCHARCODE \INSTRING 1 CH)))
                    (freplace
 (TEXTOBJ \INSERTLEN) of
 TEXTOBJ with
 LEN)
                    (freplace
 (TEXTOBJ \INSERTFIRSTCH) of
 TEXTOBJ with
 CH#)
                                                             (* ; 

                                               "Cache the first-inserted-ch #, for backspace speed")

                    (SETQ NEWFLAG T)
                    (COND
                       ((OR (IGREATERP CH# TEXTLEN)
                            (IEQP CH# START-OF-PIECE))       (* ; 

                      "We're inserting on a piece boundary;  do it, then remember the prior piece.")

                        (\INSERTPIECE
 \INPC PC TEXTOBJ NIL))
                       (T                                    (* ; 

                          "Not on a piece boundary;  split the piece we're inside of, then insert.")

                          (\INSERTPIECE
 \INPC (\SPLITPIECE
 PC (- CH# START-OF-PIECE)
                                                         TEXTOBJ)
                                 TEXTOBJ NIL)))
                    [COND
                       ((NOT (fetch
 (PIECE PPARALOOKS) of
 \INPC))
                                                             (* ; 

                          "There weren't any paralooks available at creation time.  Find some now.")

                        [SETQ PLOOKS (AND (fetch
 (PIECE PREVPIECE) of
 \INPC)
                                          (fetch
 (PIECE PPARALOOKS) of
 (fetch

                                                                                (PIECE PREVPIECE)
                                                                                  of
 \INPC]
                        [SETQ NLOOKS (AND (fetch
 (PIECE NEXTPIECE) of
 \INPC)
                                          (fetch
 (PIECE PPARALOOKS) of
 (fetch

                                                                                (PIECE NEXTPIECE)
                                                                                  of
 \INPC]
                        (replace
 (PIECE PPARALOOKS) of
 \INPC
                           with
 (COND
                                       ((NOT PLOOKS)         (* ; 

                                                           "No preceding para to take looks from")

                                        (OR NLOOKS (fetch
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ)))
                                       ((NOT NLOOKS)         (* ; 

                                                           "No succeeding paras to take looks from")

                                        (OR PLOOKS (fetch
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ)))
                                       (T PLOOKS]
                    (replace
 (TEXTOBJ \INSERTPCNO) of
 TEXTOBJ with
 0)
                                                             (* ; 

                                                           "Save the pcno for future insertions")

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

                                                    "The PCTB may have expanded during the insert.")

                    (SETQ PREVPC (OR (fetch
 (PIECE PREVPIECE) of
 NEWPC)
                                     PC))                    (* ; 

                                      "The piece we're to take the inserted characters' looks from")

                    (replace
 (PIECE PLOOKS) of
 NEWPC with
 (fetch
 (TEXTOBJ CARETLOOKS)
                                                                         of
 TEXTOBJ))
                    [replace
 (PIECE PPARALOOKS) of
 NEWPC
                       with
 (COND
                                   ((ZEROP TEXTLEN)          (* ; 

                                                           "No text yet;  use default paralooks")

                                    (fetch
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ))
                                   ((SETQ PREVPC (fetch
 (PIECE NEXTPIECE) of
 \INPC))
                                                             (* ; 

                                                          "There's later text.  Use its para looks")

                                    (fetch
 (PIECE PPARALOOKS) of
 PREVPC))
                                   ((SETQ PREVPC (fetch
 (PIECE PREVPIECE) of
 \INPC))
                                                             (* ; 

                                         "There's earlier text.  Use its looks, copied if need be.")

                                    (COND
                                       ((fetch
 (PIECE PPARALAST) of
 PREVPC)
                                        (fetch
 (PIECE PPARALOOKS) of
 PREVPC))
                                       (T (fetch
 (PIECE PPARALOOKS) of
 PREVPC]
                    (SETQ EVENT (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ))
                                                             (* ; "Prior edit event.")

                    [SETQ REPLACING (AND (EQ (fetch
 THACTION of
 EVENT)
                                             'Delete)
                                         (IEQP CH# (fetch
 THCH# of
 EVENT]
                    (COND
                       ((AND (fetch
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ)
                             (IEQP CH# \INEXTCH)
                             (EQ (fetch
 THACTION of
 EVENT)
                                 'Insert))

                        (* ;; "We're continuing a prior insertion, even if we had to create a new piece.  Just continue the old history event, too.")


                        (add
 (fetch
 THLEN of
 EVENT)
                               LEN))
                       (T                                    (* ; 

                          "Nope, this is a new insertion/replacement.  Make the new history event.")

                          (\TEDIT.HISTORYADD TEXTOBJ (create
 TEDITHISTORYEVENT
                                                            THACTION _ (COND
                                                                          (REPLACING 'Replace)
                                                                          (T 'Insert))
                                                            THLEN _ (fetch
 (PIECE PLEN)
                                                                       of
 \INPC)
                                                            THCH# _ CH#
                                                            THFIRSTPIECE _ \INPC
                                                            THPOINT _ 'RIGHT
                                                            THOLDINFO _ (AND REPLACING EVENT]
              [OR NEWFLAG (PROGN                             (* ; 

                           "We didn't add a piece, so we must update character numbers in the PCTB")

                                                             (* ; "The insert-piece's PCTB entry")


                                 (* ;; "(for I from (IPLUS PCNO \EltsPerPiece) to (\EDITELT PCTB \PCTBLastPieceOffset) by \EltsPerPiece do (\EDITSETA PCTB I (IPLUS (\EDITELT PCTB I) LEN)))")


                                 (COND
                                    ((NOT (AND (EQ CH# 1)
                                               (EQ \INEXTCH -1)))
                                                             (* ; 

                            "Update character numbers in the PCTB doesn't need when 1st insertion.")

                                     (UPDATEPCNODES \INPC LEN PCTB]
              (freplace
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ with
 (SETQ TEXTLEN (IPLUS LEN 
                                                                                           TEXTLEN)))
              (replace
 (TEXTOBJ \INSERTNEXTCH) of
 TEXTOBJ with
 (IPLUS CH# LEN))
              (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 T)
              (replace
 (TEXTOBJ \DIRTY) of
 TEXTOBJ with
 T)
              (replace
 (PIECE PFATP) of
 \INPC with
 (OR (fetch
 (PIECE PFATP)
                                                                      of
 \INPC)
                                                                   FATP])

(\INSERTCR

  [LAMBDA (CH CH# TEXTOBJ)
                               (* ; "Edited 31-May-91 14:00 by jds")


    (* ;; "Handle insertion of CR and meta-CR.  The former causes a paragraph break, while the latter doesn't.  Note, though, that inserting a meta-CR causes the doucment to become formatted.")


    (COND
       ((fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ))
       (T (LET (INPC)
               (COND
                  ([AND (NOT (fetch
 (TEXTOBJ FORMATTEDP) of
 TEXTOBJ))
                        (NOT (IEQP CH (CHARCODE CR]          (* ; 

              "Inserting a meta-CR into an unformatted document.  Start by setting up para breaks.")

                   (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ)))
               (\INSERTCH
 (CHARCODE CR)
                      CH# TEXTOBJ)                           (* ; "Put the CR in")

               (COND
                  ((IEQP CH (CHARCODE CR))                   (* ; 

                                     "It's really a CR, rather than a meta-CR so do para breaking.")

                   (SETQ INPC (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ))
                   (AND INPC (replace
 (PIECE PPARALAST) of
 INPC with
 T))
                                                             (* ; 

             "Mark the end of the paragraph (INPC might be NIL if the insert got refused somehow).")

                   (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
                                                             (* ; 

                                                          "FORCE A NEW PIECE ON THE NEXT CHARACTER")

                   ])
)



(* ;;; "Functions to manipulate the Piece Table (PCTB)")


(DEFINEQ

(\CHTOPC

  [LAMBDA (CH# PCTB TELL-PC-START?)
                      (* ; "Edited 15-Apr-93 16:05 by jds")


    (* ;; "Given a character # in a text object, and the object's piece table, return a pointer to the piece containing that character, else NIL.")


    (* ;; "If TELL-PC-START? is not NIL, sets the free variable START-OF-PIECE to the ch# of the piece's start.")


    (LET ((TREE PCTB)
          (BASE-CH# 1)
          TBASE-CH# FOUND)
         (while
 (type?
 BTREENODE TREE)
            do
 [for
 I from
 1 to
 (fetch
 (BTREENODE COUNT) of
 TREE)
                      as
 OFST from
 2 by
 4
                      do
 (COND
                                ((IGREATERP (SETQ TBASE-CH# (IPLUS BASE-CH# (\GETBASEFIXP TREE OFST))
                                             )
                                        CH#)
                                 (SETQ FOUND (\GETBASEPTR TREE (- OFST 2)))
                                 (RETURN))
                                (T (SETQ BASE-CH# TBASE-CH#]
                  (SETQ TREE FOUND))
         (AND TELL-PC-START? (SETQ START-OF-PIECE BASE-CH#))
         (OR TREE 'LASTPIECE])

(\CHTOPCNO

  [LAMBDA (CH# PCTB)
                                    (* ; "Edited 13-Jun-90 00:47 by mitani")


    (* ;; "Given a character # in a text object, and the object's piece table, return a pointer to the piece containing that character, else NIL")


    (DECLARE
 (LOCALVARS . T))
    (LET ((INDEX 0)
          (TREE (fetch
 (PCTNODE HI) of
 PCTB))
          CHNUM)
         [while
 TREE do
 (COND
                                   [(IEQP CH# (SETQ CHNUM (fetch
 (PCTNODE CHNUM) of
 TREE)))
                                                             (* ; "FIND NODE")

                                    (RETURN (SETQ INDEX (IPLUS INDEX (fetch
 (PCTNODE RANK)
                                                                        of
 TREE]
                                   ((IGREATERP CH# CHNUM)    (* ; "MOVE RIGHT")

                                    (SETQ INDEX (IPLUS INDEX (fetch
 (PCTNODE RANK) of
 TREE)))
                                    (SETQ TREE (fetch
 (PCTNODE HI) of
 TREE)))
                                   ((ILESSP CH# CHNUM)       (* ; "MOVE LEFT")

                                    (SETQ TREE (fetch
 (PCTNODE LO) of
 TREE]
         (IMAX INDEX 1])

(\CLEARPCTB

  [LAMBDA (PCTB)
                                         (* ; "Edited 23-Feb-88 11:11 by jds")

          
          (* ;; "(PROG ((OLASTPC (\EDITELT PCTB \PCTBLastPieceOffset))) (\EDITSETA PCTB \FirstPieceOffset 1) (* Create the LASTPIECE pseudo-piece placeholder in the first piece of the table) (\EDITSETA PCTB (ADD1 \FirstPieceOffset) (QUOTE LASTPIECE)) (for I from \SecondPieceOffset to OLASTPC do (* Now remove the other pieces, setting them to NIL) (\EDITSETA PCTB I NIL)) (\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 \FirstPieceOffset)) (* Fix up the last-piece pointer) (\EDITSETA PCTB \PCTBFreePieces (IPLUS (\EDITELT PCTB \PCTBFreePieces) (LRSH (IDIFFERENCE OLASTPC (ADD1 \FirstPieceOffset)) 1))) (* And the free count of pieces.) (RETURN PCTB))")


    (HELP])

(\CREATEPIECEORSTREAM

  [LAMBDA (STRING LOOKS PARALOOKS START END)
             (* ; "Edited 11-Jun-99 14:25 by rmk:")


                                                             (* ; "Edited 31-May-91 14:18 by jds")


    (* ;; "Given a source for text, build a PIECE to describe it.")


    (* ;; "HOWEVER-- if it's aformatted file, return the stream for that file.")


    (PROG (PC)
          [SETQ PC
           (COND
              ((STRINGP STRING)                              (* ; "It's a string.")

               (create
 PIECE
                      PSTR _ STRING
                      PFILE _ NIL
                      PLEN _ (NCHARS STRING)
                      PPARALAST _ NIL
                      PPARALOOKS _ PARALOOKS
                      PFATP _ (fetch
 (STRINGP FATSTRINGP) of
 STRING)))
              ((NULL STRING)                                 (* ; 

                                                   "If it's NIL, use an empty string for the text.")

               (create
 PIECE
                      PSTR _ ""
                      PFILE _ NIL
                      PLEN _ 0
                      PPARALAST _ NIL
                      PPARALOOKS _ PARALOOKS))
              ((ATOM STRING)                                 (* ; 

                                                           "An atom is a file name.  Open it.")

               [SETQ STRING (OPENSTREAM STRING 'INPUT 'OLD '(TYPE TEXT]
               (RETURN STRING))
              [(STREAMP STRING)
               (COND
                  [(EQ NoBits (fetch
 (STREAM ACCESSBITS) of
 STRING))
                                                             (* ; 

                                                        "If the stream is no longer open, open it.")

                   (RETURN (OPENSTREAM STRING 'INPUT 'OLD '((TYPE TEXT]
                  (T (RETURN STRING]
              ((type?
 PIECE STRING)
               STRING)
              (T                                             (* ; 

                                                      "Anything else is coerced to a string first.")

                 (SETQ STRING (MKSTRING STRING))
                 (create
 PIECE
                        PSTR _ STRING
                        PFILE _ NIL
                        PLEN _ (NCHARS STRING)
                        PPARALAST _ NIL
                        PPARALOOKS _ PARALOOKS]
          (replace
 (PIECE PLOOKS) of
 PC with
 (OR LOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))
                 )
          (replace
 (PIECE PPARALOOKS) of
 PC with
 (OR PARALOOKS (create
 FMTSPEC
                                                                              using
 
                                                                                TEDIT.DEFAULT.FMTSPEC
                                                                                  )))
          (RETURN PC])

(\DELETEPIECE

  [LAMBDA (PC PCTB PC#)
                                  (* ; "Edited 20-Apr-93 19:06 by jds")


    (* ;; "Remove piece PC from the piece table PCTB.  Adjust the character numbers of succeeding pieces, if need be.")


    (PROG (PCNODE (NEXT (fetch
 (PIECE NEXTPIECE) of
 PC))
                 (PREV (fetch
 (PIECE PREVPIECE) of
 PC)))
          (\DELETETREE PC (fetch
 (PIECE PTREENODE) of
 PC))
          (COND
             (NEXT (replace
 (PIECE PREVPIECE) of
 NEXT with
 PREV)))
                                                             (* ; 

                                                           "Break any forward link from the piece")

          (COND
             (PREV (replace
 (PIECE NEXTPIECE) of
 PREV with
 NEXT)))
                                                             (* ; "and any backward link.")

      ])

(\FINDPIECE

  [LAMBDA (PC PCTB)
                                      (* ; "Edited 31-May-91 13:53 by jds")


         (* Given a piece and the pctb it's in, return the elt %# of the CH# entry for 

       that piece in the table)


    (LET ((NODE (FINDPCNODE PC PCTB)))
         (INDEX (fetch
 (PCTNODE CHNUM) of
 NODE)
                PCTB])

(\INSERTPIECE

  [LAMBDA (NEW OLD TEXTOBJ DONTUPDATECH#S PC# NEW-PREVLEN PREV)

                                                             (* ; "Edited  7-Oct-94 17:43 by jds")


    (* ;; "Insert the piece NEW in front of the piece OLD;  re-allocate PCTB if need be")


    (PROG* ((PLEN (fetch
 (PIECE PLEN) of
 NEW))
            (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
            OLDLEN PCNODE PREVPC)
           (COND
              ((ZEROP (fetch
 (BTREENODE COUNT) of
 PCTB))
                                                             (* ; "PCTB is empty.")

               (replace
 (PIECE NEXTPIECE) of
 NEW with
 NIL)
               (replace
 (PIECE PREVPIECE) of
 NEW with
 NIL)
               (replace
 (BTREENODE DOWN1) of
 PCTB with
 NEW)
               (replace
 (BTREENODE COUNT) of
 PCTB with
 1)
               (replace
 (BTREENODE TOTLEN) of
 PCTB with
 PLEN)
               (RETURN 1)))
           (SETQ OLDLEN (fetch
 (BTREENODE TOTLEN) of
 PCTB))
           [SETQ PCNODE (COND
                           ((OR (NULL OLD)
                                (ATOM OLD))                  (* ; "Inserting in front of a symbol OR NIL, which must be LASTPIECE, the end-of-doc marker.  Go find the node that contains it.")

                            (\LASTNODE PCTB))
                           (T                                (* ; 

         "Normal case; go find the btree node that contains the piece we're inserting in front of.")

                              (FINDPCNODE OLD PCTB]
           (\INSERTTREE NEW OLD PCNODE NEW-PREVLEN NIL PREV)

     (* ;; "Update inter-piece linkages:")


           (COND
              [(OR (NULL OLD)
                   (ATOM OLD))                               (* ; "Inserting in front of a symbol OR NIL, which must be LASTPIECE, the end-of-doc marker.  Go find the node that contains it.")

               (replace
 (PIECE NEXTPIECE) of
 NEW with
 NIL)
               (replace
 (PIECE PREVPIECE) of
 NEW with
 (AND (NOT (ZEROP OLDLEN))
                                                                       (SETQ PREVPC (\CHTOPC

                                                                                     OLDLEN PCTB]
              (T                                             (* ; 

         "Normal case; go find the btree node that contains the piece we're inserting in front of.")

                 (replace
 (PIECE NEXTPIECE) of
 NEW with
 OLD)
                 (replace
 (PIECE PREVPIECE) of
 NEW with
 (SETQ PREVPC (ffetch

                                                                                  (PIECE PREVPIECE)
                                                                                    of
 OLD)))
                 (replace
 (PIECE PREVPIECE) of
 OLD with
 NEW)))
           (AND PREVPC (replace
 (PIECE NEXTPIECE) of
 PREVPC with
 NEW])

(\MAKEPCTB

  [LAMBDA (PC1 MINLEN)
                                   (* ; "Edited 15-Apr-93 15:48 by jds")


    (* ;; "Create a new piece table, with PC1 as its first piece, and a dummy piece at the end, with 1st ch# of 1+ (chlim of pc1)")


    (* ;; "A piece Table has the following format: It's an array, with 2 header words (1_# of pieces left in table unused) (2_offset of last used word in tbl), followed by 2-word entries: the first ch# in the piece, and a pointer to the piece.")


    (* ;; "NEW piece tree ")


    (* ;; "ROOT->LO: total hight of piece tree")


    (* ;; "ROOT->HI : Top node of piece tree")


    (LET ((PCTB (CREATE
 BTREENODE))
          PLEN)
         (COND
            (PC1 (FREPLACE
 (BTREENODE COUNT) OF
 PCTB WITH
 2)
                 (FREPLACE
 (BTREENODE TOTLEN) OF
 PCTB WITH
 (SETQ PLEN (FETCH

                                                                                   (PIECE PLEN)
                                                                                     OF
 PC1)))
                 (FREPLACE
 (BTREENODE DOWN1) OF
 PCTB WITH
 PC1)
                 (FREPLACE
 (BTREENODE DLEN1) OF
 PCTB WITH
 PLEN)
                 (FREPLACE
 (BTREENODE DOWN2) OF
 PCTB WITH
 'LASTPIECE)
                 (FREPLACE
 (BTREENODE DLEN2) OF
 PCTB WITH
 0)
                 (FREPLACE
 (PIECE PTREENODE) OF
 PC1 WITH
 PCTB))
            (T 
               (* ;; 

             "No initial piece, so create a 0-long document, with only the ending-piece dummy")


               (FREPLACE
 (BTREENODE COUNT) OF
 PCTB WITH
 1)
               (FREPLACE
 (BTREENODE TOTLEN) OF
 PCTB WITH
 0)
               (FREPLACE
 (BTREENODE DOWN1) OF
 PCTB WITH
 'LASTPIECE)
               (FREPLACE
 (BTREENODE DLEN1) OF
 PCTB WITH
 0)))
         PCTB])

(\SPLITPIECE

  [LAMBDA (PC CH TEXTOBJ PC#)
                            (* ; "Edited 21-Apr-93 17:49 by jds")


    (* ;; "Split the piece PC before CH (rel to start of PIECE);  return the new second piece.")


    (* ;; "PC#, if present, points at the CH# entry for the piece being split.")


    (PROG* ((PCTB (ffetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
            (NEWPC (create
 PIECE using
 PC))
            CHNO NEWLEN NEXTPC)
           (SETQ CHNO CH)                                    (* ; 

                                                    "Offset within the piece before which to break")

           (COND
              ((ILEQ CHNO 0)
               (SHOULDNT "Splitting a piece at the start.")))
           (replace
 (PIECE PPARALAST) of
 PC with
 NIL)
                                                             (* ; 

                                 "There can be no para break before the split, as things now work.")

           (COND
              ((ffetch
 (PIECE PSTR) of
 PC)           (* ; 

                                  "This piece points to a string.  Split it for the two new pieces")

               (freplace
 (PIECE PSTR) of
 NEWPC with
 (SUBSTRING (ffetch
 (PIECE PSTR)
                                                                              of
 PC)
                                                                       (ADD1 CHNO)))
               (freplace
 (PIECE PLEN) of
 NEWPC with
 (IDIFFERENCE (ffetch
 (PIECE
                                                                                          PLEN)
                                                                                of
 PC)
                                                                       CHNO))
               (freplace
 (PIECE PSTR) of
 PC with
 (SUBSTRING (ffetch
 (PIECE PSTR)
                                                                           of
 PC)
                                                                    1 CHNO))
               (freplace
 (PIECE PLEN) of
 PC with
 CHNO))
              ((ffetch
 (PIECE PFILE) of
 PC)          (* ; 

                                       "This piece points to a file.  Set the fileptrs accordingly")

               (freplace
 (PIECE PFILE) of
 NEWPC with
 (ffetch
 (PIECE PFILE)
                                                                    of
 PC))
               [freplace
 (PIECE PFPOS) of
 NEWPC with
 (COND
                                                                    ((fetch
 (PIECE PFATP)
                                                                        of
 NEWPC)
                                                             (* ; 

                                     "This is a FAT piece;  need to allow 2 bytes per char skipped")

                                                                     (IPLUS (ffetch
 (PIECE PFPOS)
                                                                               of
 PC)
                                                                            CHNO CHNO))
                                                                    (T 
                                                             (* ; 

                                                           "Regular piece;  allow 1 byte per char")

                                                                       (IPLUS (ffetch

                                                                               (PIECE PFPOS)
                                                                                 of
 PC)
                                                                              CHNO]
               (freplace
 (PIECE PLEN) of
 NEWPC with
 (IDIFFERENCE (ffetch
 (PIECE
                                                                                          PLEN)
                                                                                of
 PC)
                                                                       CHNO))
               (FREPLACE
 (PIECE PLEN) OF
 PC WITH
 CHNO)))
           (PROGN                                            (* UNINTERRUPTABLY)

                  (SETQ NEXTPC (ffetch
 (PIECE NEXTPIECE) of
 PC))
                                                             (* LET ((PCNODE (FETCH

                                                           (PIECE PTREENODE) OF PC)))

                                                           (* ;; 

                                      "Update the length of the original piece in it's tree entry.")

                                                           (for ITEM# from 0 by 4 as I from 1 

                                                           to (fetch (BTREENODE COUNT) of 

                                                           PCNODE) when (EQ (\GETBASEPTR PCNODE 

                                                           ITEM#) PC) do (* ;;

                                                           "FIXME - I think this can be done as aport of \INSERTPIECE / \INSERTTREEE, by looking back 1 from the OLD entry and updating. --JDS")

                                                           (\PUTBASEFIXP PCNODE

                                                           (IPLUS ITEM# 2) (fetch

                                                           (PIECE PLEN) of PC))

                                                           (RETURN)))

                  (\INSERTPIECE
 NEWPC (OR NEXTPC 'LASTPIECE)
                         TEXTOBJ NIL NIL (IMINUS (fetch
 (PIECE PLEN) of
 NEWPC))
                         PC)

                  (* ;; "update nextlink and prevlink")


                  (COND
                     ((NULL NEXTPC)                          (* ; 

                                                           "PC is last piece (not LASTPIECE)")

                                                             (* ; "NEWPC is new last piece.")

                      (replace
 (PIECE NEXTPIECE) of
 NEWPC with
 NIL))
                     (T (replace
 (PIECE NEXTPIECE) of
 NEWPC with
 NEXTPC)
                        (replace
 (PIECE PREVPIECE) of
 NEXTPC with
 NEWPC)))
                  (replace
 (PIECE NEXTPIECE) of
 PC with
 NEWPC)
                  (replace
 (PIECE PREVPIECE) of
 NEWPC with
 PC))
                                                             (* ; "Now set its starting CH#")

           (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
                                                             (* ; 

                                         "Whenever you split a piece, you can't add to it anymore.")

           (RETURN NEWPC])

(\INSERT.FIRST.PIECE

  [LAMBDA (TEXTOBJ)
                                      (* ; "Edited 31-May-91 14:00 by jds")


    (* ;; "Insert 1st piece to empty PCTB.")


    (PROG (PC)
          (\INSERTPIECE
 [SETQ PC (\CREATEPIECEORSTREAM
 NIL (CHARLOOKS.FROM.FONT DEFAULTFONT)
                                            (COND
                                               (TEXTOBJ (fetch
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ))
                                               (T (create
 FMTSPEC using
 TEDIT.DEFAULT.FMTSPEC
                                                         ]
                 NIL TEXTOBJ)
          (replace
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ with
 PC)
          (replace
 (PIECE PSTR) of
 PC with
 (freplace
 (TEXTOBJ \INSERTSTRING)
                                                          of
 TEXTOBJ with
 (ALLOCSTRING 512])
)



(* ; "Generic-IO type operations support")


(DEFINEQ

(\TEXTCLOSEF

  [LAMBDA (STREAM)
                                       (* ; "Edited 15-Apr-93 16:43 by jds")

                                                             (* ; 

                                                           "Close the files underlying a stream")

    (PROG ((TEXTOBJ (TEXTOBJ STREAM))
           PCTB PC)
          (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
          [OR (ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
              (COND
                 ((TYPE?
 PIECE (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB)
                                                   0)))
                  (fetch
 (PIECE PFILE) of
 PC)
                  (CLOSEF? (fetch
 (PIECE PFILE) of
 PC))
                  (SETQ PC (FETCH
 (PIECE NEXTPIECE) OF
 PC))
                  (WHILE
 PC DO
 (AND (fetch
 (PIECE PFILE) of
 PC)
                                            (CLOSEF? (fetch
 (PIECE PFILE) of
 PC)))
                                      (SETQ PC (FETCH
 (PIECE NEXTPIECE) OF
 PC]

     (* ;; "And close the REAL file as well, in case we'd made a local cache.")


          (CLOSEF? (fetch
 (TEXTOBJ TXTFILE) of
 TEXTOBJ])

(\TEXTCLOSEF-SUBTREE

  [LAMBDA (PCTREE)
                                       (* ; "Edited 31-May-91 14:00 by jds")


    (* ;; "Run thru the pieces in the document, closing the underlying file")


    (* ;; "by traverse pctree")


    (LET (PC)
         (COND
            ((NULL PCTREE)
             NIL)
            (T (SETQ PC (fetch
 (PCTNODE PCE) of
 PCTREE))
               (AND (NOT (ATOM PC))
                    (fetch
 (PIECE PFILE) of
 PC)
                    (CLOSEF? (fetch
 (PIECE PFILE) of
 PC)))
               (\TEXTCLOSEF-SUBTREE
 (fetch
 (PCTNODE LO) of
 PCTREE))
               (\TEXTCLOSEF-SUBTREE
 (fetch
 (PCTNODE HI) of
 PCTREE])

(\TEXTDSPFONT

  [LAMBDA (STREAM NEWFONT)
                               (* ; "Edited 31-May-91 14:02 by jds")


    (* ;; "Set the font for a TEdit window.  Need change the caret looks, for character insertion, and the WINDOW's looks, so that TEXEC type-out to the window does the right thing.")


    (LET ((TEXTOBJ (TEXTOBJ STREAM)))
         (PROG1 (fetch
 (CHARLOOKS CLFONT) of
 (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ))
             [COND
                (NEWFONT 

                       (* ;; "Only do this if there's a new font to set:")


                       (TEDIT.CARETLOOKS STREAM (\GETFONTDESC NEWFONT 'DISPLAY))
                       (COND
                          ((fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)

                           (* ;; "Update the windows, if there are any.")


                           (for
 WIN in
 (fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)
                              do
 (DSPFONT NEWFONT WIN])])

(\TEXTEOFP

  [LAMBDA (STREAM)
                                       (* ; "Edited 31-May-91 14:18 by jds")


    (* ;; "Test for EOF on a text stream: At end of a piece, and there's no more pieces.")


    (OR (NOT (fetch
 (TEXTSTREAM PIECE) of
 STREAM))
        (EQ (fetch
 (TEXTSTREAM PIECE) of
 STREAM)
            'LASTPIECE)
        (AND (IEQP (fetch
 (STREAM COFFSET) of
 STREAM)
                   (fetch
 (STREAM CBUFSIZE) of
 STREAM))
             (ZEROP (fetch
 (TEXTSTREAM CHARSLEFT) of
 STREAM))
             (OR (NOT (fetch
 (PIECE NEXTPIECE) of
 (fetch
 (TEXTSTREAM PIECE) of
 STREAM
                                                                 )))
                 (bind
 (PC _ (fetch
 (PIECE NEXTPIECE) of
 (fetch
 (TEXTSTREAM PIECE)
                                                                        of
 STREAM))) while

                                                                                         PC
                    do
 (COND
                              ((NOT (ZEROP (fetch
 (PIECE PLEN) of
 PC)))
                               (RETURN NIL)))
                          (SETQ PC (fetch
 (PIECE NEXTPIECE) of
 PC)) finally
 (RETURN
                                                                                         T])

(\TEXTGETEOFPTR

  [LAMBDA (STREAM)
                                       (* ; "Edited 31-May-91 13:58 by jds")

    (fetch
 (TEXTOBJ TEXTLEN) of
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM])

(\TEXTGETFILEPTR

  [LAMBDA (STREAM)
                                       (* ; "Edited 28-Mar-94 15:32 by jds")


    (* ;; "GETFILEPTR fn for text streams.")


    (PROG ((PC (fetch
 (TEXTSTREAM PIECE) of
 STREAM))
           (CHARSLEFT (fetch
 (TEXTSTREAM CHARSLEFT) of
 STREAM))
           (OFFSET (fetch
 (STREAM COFFSET) of
 STREAM))
           (LIMIT (fetch
 (STREAM CBUFSIZE) of
 STREAM))
           PLEN)
          (COND
             ((EQ PC 'LASTPIECE)                             (* ; "STREAM is Empty Document")

              (RETURN 0))
             [PC                                             (* ; 

                                     "There's a piece.  That means he's inside the file somewhere.")

                 (SETQ PLEN (fetch
 (PIECE PLEN) of
 PC))
                 (RETURN (IMIN [SUB1 (IPLUS (\TEDIT.PIECE-CHNO PC)
                                            (IDIFFERENCE PLEN CHARSLEFT)
                                            (COND
                                               ((fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                                                             (* ; 

  "This is a 16-bit stream;  The difference is in BYTES, and needs to be divided by 2 to get chars")

                                                (IQUOTIENT (IDIFFERENCE OFFSET LIMIT)
                                                       2))
                                               (T (IDIFFERENCE OFFSET LIMIT]
                               (fetch
 (TEXTOBJ TEXTLEN) of
 (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                      of
 STREAM]
             (T                                              (* ; 

                                             "Lack of a current piece means he walked off the end.")

                (RETURN (IMAX 1 (fetch
 (TEXTOBJ TEXTLEN) of
 (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                       of
 STREAM])

(\TEXTOPENF

  [LAMBDA (STREAM ACCESS ASDF QWER ZXCV)
                 (* ; "Edited 31-May-91 13:58 by jds")

                                                             (* Return the stream, opened for 

                                                           input)

    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
           PCTB PC)
          (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
          (\TEXTOPENF-SUBTREE
 (fetch
 (PCTNODE HI) of
 PCTB))

     (* ;; "(for I from (ADD1 \FirstPieceOffset) to (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)) by \EltsPerPiece do (SETQ PC (\EDITELT PCTB I)) (COND ((AND (fetch PFILE of PC) (EQ (fetch ACCESSBITS of (fetch PFILE of PC)) NoBits)) (\TEDIT.REOPEN.STREAM STREAM (fetch PFILE of PC)))))")


          (RETURN STREAM])

(\TEXTOPENF-SUBTREE

  [LAMBDA (PCTREE)
                                       (* ; "Edited 31-May-91 14:19 by jds")

    (LET (PC)
         (COND
            ((NULL PCTREE)
             NIL)
            (T (SETQ PC (fetch
 (PCTNODE PCE) of
 PCTREE))
               [COND
                  ((AND (fetch
 (PIECE PFILE) of
 PC)
                        (EQ (fetch
 (STREAM ACCESSBITS) of
 (fetch
 (PIECE PFILE)
                                                                     of
 PC))
                            NoBits))
                   (\TEDIT.REOPEN.STREAM
 STREAM (fetch
 (PIECE PFILE) of
 PC]
               (\TEXTOPENF-SUBTREE
 (fetch
 (PCTNODE LO) of
 PCTREE))
               (\TEXTOPENF-SUBTREE
 (fetch
 (PCTNODE HI) of
 PCTREE])

(\TEXTOUTCHARFN

  [LAMBDA (CH STREAM)
                                    (* ; "Edited 31-May-91 13:59 by jds")

    (\INSERTCH
 CH (fetch
 (TEXTOBJ TEXTLEN) of
 (fetch
 (TEXTSTREAM TEXTOBJ)
                                                             of
 STREAM))
           (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM])

(\TEXTBACKFILEPTR

  [LAMBDA (STREAM)
                                       (* ; "Edited 28-Mar-94 15:32 by jds")


    (* ;; "Use this to BACKFILEPTR a text stream.")


    [PROG (PC PS PF REALFILE)
          (COND
             [(AND (IEQP (fetch
 (STREAM CPAGE) of
 STREAM)
                         (fetch
 (TEXTSTREAM PCSTARTPG) of
 STREAM))
                   (IEQP (fetch
 (STREAM COFFSET) of
 STREAM)
                         (fetch
 (TEXTSTREAM PCSTARTCH) of
 STREAM)))
                                                             (* ; 

                                             "Hit start of piece;  back to PREVPIECE & keep going.")

              [SETQ PC (replace
 (TEXTSTREAM PIECE) of
 STREAM
                          with
 (fetch
 (PIECE PREVPIECE) of
 (fetch
 (TEXTSTREAM PIECE)
                                                                          of
 STREAM]
                                                             (* ; "Move to previous piece")

              (replace
 (STREAM BINABLE) of
 STREAM with
 T)
              (replace
 (TEXTSTREAM FATSTREAMP) of
 STREAM with
 NIL)
                                                             (* add (fetch (TEXTSTREAM PCNO) of 

                                                           STREAM) -1)

              (while
 (AND PC (ZEROP (fetch
 (PIECE PLEN) of
 PC)))
                 do
                                      (* ; 

                                               "Skip over any zero-length pieces as we back along.")

                       (SETQ PC (fetch
 (PIECE PREVPIECE) of
 PC)))
              (COND
                 [PC (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM
                        with
 (\TEDIT.APPLY.STYLES (fetch
 (PIECE PLOOKS) of
 PC)
                                        PC
                                        (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM)))
                     (COND
                        ((SETQ PS (fetch
 (PIECE PSTR) of
 PC))
                                                             (* ; "This piece lives in a string.")

                         (\TEDIT.TEXTBIN.STRINGSETUP
 (SUB1 (fetch
 (PIECE PLEN) of
 PC))
                                1 STREAM PS)

                         (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")


                         )
                        ((SETQ PF (fetch
 (PIECE PFILE) of
 PC))
                                                             (* ; "This piece lives on a file.")

                         (\TEDIT.TEXTBIN.FILESETUP
 PC (SUB1 (fetch
 (PIECE PLEN) of
 PC))
                                1 STREAM PF (fetch
 (PIECE PFATP) of
 PC)
                                'PEEKBIN))
                        ((fetch
 (PIECE POBJ) of
 PC)
                         (replace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0))
                        (T (ERROR "CAN'T GET TO NEXT PIECE"]
                 (T (ERROR "Trying to BACKFILEPTR thru start of text."]
             ((ZEROP (fetch
 (STREAM COFFSET) of
 STREAM))
                                                             (* ; "Move back 1 file page")

              (SETQ REALFILE (fetch
 (TEXTSTREAM REALFILE) of
 STREAM))
              (replace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 (IPLUS (fetch

                                                                                 (TEXTSTREAM 
                                                                                        CHARSLEFT)
                                                                                   of
 STREAM)
                                                                                (fetch

                                                                                 (STREAM CBUFSIZE)
                                                                                   of
 STREAM)))
              (replace
 (STREAM COFFSET) of
 REALFILE with
 0)
              (COND
                 ((fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                                                             (* ; 

                                                           "16 bit stream, so back up 2 bytes.")

                  (\BACKFILEPTR REALFILE)
                  (\BACKFILEPTR REALFILE))
                 (T (\BACKFILEPTR REALFILE)))
              (\PEEKBIN REALFILE)
              (replace
 (STREAM CPAGE) of
 STREAM with
 (fetch
 (STREAM CPAGE)
                                                                    of
 REALFILE))
              (replace
 (STREAM COFFSET) of
 STREAM with
 (fetch
 (STREAM COFFSET)
                                                                      of
 REALFILE))
              (replace
 (STREAM CBUFSIZE) of
 STREAM with
 (fetch
 (STREAM CBUFSIZE)
                                                                       of
 REALFILE))
              (replace
 (STREAM CPPTR) of
 STREAM with
 (fetch
 (STREAM CPPTR)
                                                                    of
 REALFILE)))
             (T                                              (* ; "JUST ACT CASUAL & DO IT.")

                (COND
                   ((fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                                                             (* ; 

                                                           "16 bit stream, so back up 2 bytes.")

                    (\PAGEDBACKFILEPTR STREAM)
                    (\PAGEDBACKFILEPTR STREAM))
                   (T (\PAGEDBACKFILEPTR STREAM]
    T])

(\TEXTBOUT

  [LAMBDA (STREAM BYTE)
                                  (* ; "Edited 10-May-93 16:59 by jds")

                                                             (* ; 

                                    "Do BOUT to a text stream, which is an insertion at the caret.")

    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
           (CH# (ADD1 (\TEXTGETFILEPTR
 STREAM)))
           WINDOW TEXTLEN PS PC PSTR OFFST)
          (SETQ TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
          (SETQ WINDOW (fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ))
          (AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#))
          (\INSERTCH
 BYTE CH# TEXTOBJ)
          (AND WINDOW (TEDIT.UPDATE.SCREEN TEXTOBJ))
          (AND (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)
               (RETURN))                                     (* ; 

                                                     "If teh stream is readonly, nothing happened!")

          [SETQ PS (ffetch
 (PIECE PSTR) of
 (SETQ PC (fetch
 (TEXTOBJ \INSERTPC)
                                                               of
 TEXTOBJ]
                                                             (* ; "This piece resides in a STRING.")

          (replace
 (TEXTSTREAM PIECE) of
 STREAM with
 PC)
          (freplace
 (STREAM CPPTR) of
 STREAM with
 (ADDBASE (ffetch
 (STRINGP BASE)
                                                                          of
 PS)
                                                                     (LRSH (SETQ OFFST
                                                                            (ffetch
 (STRINGP
                                                                                         OFFST)
                                                                               of
 PS))
                                                                           1)))
          (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
          (freplace
 (STREAM COFFSET) of
 STREAM with
 (IPLUS (freplace
 (TEXTSTREAM
                                                                                      PCSTARTCH)
                                                                          of
 STREAM
                                                                          with
 (LOGAND 1 OFFST))
                                                                       (fetch
 (TEXTOBJ \INSERTLEN
                                                                                         )
                                                                          of
 TEXTOBJ)))
          (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
                                                             (* ; 

                                                 "Page # within the 'file' where this piece starts")

          (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 (fetch
 (STREAM COFFSET)
                                                                    of
 STREAM))
          (freplace
 (STREAM EPAGE) of
 STREAM with
 1)
          (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
          (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 NIL])

(\TEDITOUTCCODEFN

  [LAMBDA (STREAM CHARCODE)
                             (* ; "Edited 12-Oct-2021 15:38 by rmk:")


    (* ;; "OUTCCODEFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes (via \TEXTBOUT). BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.")


    (COND
       ((EQ CHARCODE (CHARCODE EOL))
        (\BOUT STREAM (CHARCODE CR))
        (freplace
 (STREAM CHARPOSITION) of
 STREAM with
 0))
       (T (\BOUT STREAM CHARCODE)
          (freplace
 (STREAM CHARPOSITION) of
 STREAM with

                                                            (PROGN 
                                                             (* ; "Ugh.  Don't overflow")

                                                                   (IPLUS16 (ffetch
 (STREAM
                                                                                         CHARPOSITION
                                                                                         )
                                                                               of
 STREAM)
                                                                          1])

(\TEXTSETEOF

  [LAMBDA (STREAM EOFPTR)
                                (* ; "Edited 31-May-91 14:19 by jds")

                                                             (* Set the EPAGE/EOFFSET of the 

                                                           stream to be (SUB1 of EOFPTR))

    (replace
 (STREAM EPAGE) of
 STREAM with
 (fetch
 (BYTEPTR PAGE) of
 EOFPTR))
    (replace
 (STREAM EOFFSET) of
 STREAM with
 (fetch
 (BYTEPTR OFFSET) of
 EOFPTR])

(\TEXTSETFILEPTR

  [LAMBDA (STREAM FILEPOS)
                               (* ; "Edited 22-Apr-93 13:44 by jds")

                                                             (* ; 

                                                           "Sets the file ptr for a text stream.")

    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM)))
          (COND
             ((ZEROP (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)))
             ((OR (IEQP FILEPOS -1)
                  (IEQP FILEPOS (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)))
                                                             (* ; "Means end of file")

              (\SETUPGETCH
 (IMAX 1 (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
                     TEXTOBJ)
              (\BIN STREAM))
             ((OR (ILESSP FILEPOS 0)
                  (IGREATERP FILEPOS (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ)))
                                                             (* ; 

                                                     "If the fileptr is not within the text, punt.")

              (\ILLEGAL.ARG FILEPOS))
             (T (\SETUPGETCH
 (IMAX 1 (ADD1 FILEPOS))
                       TEXTOBJ])

(\TEXTDSPXPOSITION

  [LAMBDA (STREAM XPOSITION)
                            (* ; "Edited  3-Jan-2001 17:27 by rmk:")

                                                             (* ; 

                                   "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:")


    (* ;; 

"Simply returns the XPOSITION of the primary window's display stream, this is a read-only function")


    (LET [(WINDOW (CAR (fetch
 \WINDOW of
 (TEXTOBJ STREAM]
         (COND
            (WINDOW (DSPXPOSITION NIL WINDOW))
            (T                                               (* ; 

                                          "If there is no window, estimate from character position")

               (TIMES (CHARWIDTH (CHARCODE SPACE)
                             STREAM)
                      (POSITION STREAM])

(\TEXTDSPYPOSITION

  [LAMBDA (STREAM YPOSITION)
                             (* ; "Edited 31-May-91 13:59 by jds")


         (* Simply returns the XPOSITION of the primary window's display stream, this is 

       a read-only function)


    (LET [(WINDOW (CAR (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ STREAM]
         (IF
 WINDOW
             THEN
 (DSPYPOSITION NIL WINDOW)
           ELSE
 (AND \#DISPLAYLINES (NEQ \CURRENTDISPLAYLINE -1)
                         (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE])

(\TEXTLEFTMARGIN

  [LAMBDA (STREAM XPOSITION)
                             (* ; "Edited 31-May-91 14:03 by jds")


(* ;;; "Returns the left margin of the textstream.  This is a read-only function")


    (IF
 (CAR (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ STREAM)))
        THEN
 [IPLUS 8 (fetch
 (FMTSPEC LEFTMAR) of
 (fetch
 (TEXTOBJ FMTSPEC)
                                                                 of
 (TEXTOBJ STREAM]
      ELSE
 0])

(\TEXTRIGHTMARGIN

  [LAMBDA (STREAM XPOSITION)                                 (* ; "Edited 31-May-91 14:03 by jds")


(* ;;; "Returns the right margin of the textstream.  This is a read-only function")


    (LET ((TEXTOBJ (TEXTOBJ STREAM)))
         (IF
 (fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ)
             THEN
 (LET [(RIGHTMAR (fetch
 (FMTSPEC RIGHTMAR) of
 (fetch
 (TEXTOBJ 
                                                                                             FMTSPEC)
                                                                              of
 TEXTOBJ]
                           (IF
 (ZEROP RIGHTMAR)
                               THEN
 (fetch
 (TEXTOBJ WRIGHT) of
 TEXTOBJ)
                             ELSE
 RIGHTMAR))
           ELSE
 (TIMES (CHARWIDTH (CHARCODE A)
                                  STREAM)
                           (LINELENGTH NIL STREAM])

(\TEXTDSPCHARWIDTH

  [LAMBDA (STREAM CHARCODE)                                  (* ; 

                                                           "Edited  9-Feb-99 12:59 by kaplan")

    (CHARWIDTH CHARCODE (DSPFONT NIL STREAM])

(\TEXTDSPSTRINGWIDTH

  [LAMBDA (STREAM STRING)                                    (* ; 

                                                           "Edited  9-Feb-99 13:00 by kaplan")

    (STRINGWIDTH STRING (DSPFONT NIL STREAM])

(\TEXTDSPLINEFEED

  [LAMBDA (STREAM VALUE)
    (FONTPROP (DSPFONT NIL STREAM)
           'HEIGHT])
)
(DEFINEQ

(\TEXTBIN

  [LAMBDA (STREAM)

    (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return value of OBJECTCHAR property for image objecdts")


    (* ;; "Edited 28-Mar-94 15:33 by jds")


(* ;;; "Do BIN slow case for a text stream")

                                                             (* ; 

                                 "NB that PEEKBIN and BACKFILEPTR need to track changes in this code")

    (DECLARE
 (LOCALVARS . T))
    (LET (BYTE)                                              (* ; 

                               "RMK:  Capture all return values for any special imageobject coercion")

         [SETQ BYTE (PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM)
                          (COND
                             [(ILESSP (fetch
 (STREAM COFFSET) of
 STREAM)
                                     (fetch
 (STREAM CBUFSIZE) of
 STREAM))
                                                             (* ; 

                                                             "Simple case -- just do the usual BIN")

                              (COND
                                 [(SETQ PO (fetch
 (PIECE POBJ) of
 (fetch
 (TEXTSTREAM PIECE)
                                                                     of
 STREAM)))
                                                             (* ; "Handle objects specially")

                                  (COND
                                     ((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM))
                                                             (* ; 

                                         "If this object has a substream in it, go to that substream")

                                      (add
 (fetch
 (STREAM COFFSET) of
 STREAM)
                                           1)
                                      (RETURN (\BIN SUBSTREAM)))
                                     (T 
                                        (* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.")


                                        (replace
 (STREAM COFFSET) of
 STREAM
                                           with
 (fetch
 (STREAM CBUFSIZE) of
 STREAM))
                                        (replace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
                                        (RETURN PO]
                                 [(fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                                                             (* ; 

                                                             "This is a 16 bit BIN.  grab 2 bytes.")

                                                             (* ; 

                                               "WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??")

                                  (RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM)
                                                        256)
                                                 (COND
                                                    ((ILESSP (fetch
 (STREAM COFFSET) of
 STREAM)
                                                            (fetch
 (STREAM CBUFSIZE) of
 STREAM))
                                                             (* ; 

              "This pair of characters doesn't straddle a file page bound.  Just grab the next char.")

                                                     (\PAGEDBIN STREAM))
                                                    (T       (* ; 

        "Need to move to the next page on the backing file.  Doing so also grabs the next character.")

                                                       (\TEDIT.TEXTBIN.NEW.PAGE
 STREAM T]
                                 (T (RETURN (\PAGEDBIN STREAM]
                             (T                              (* ; 

                                         "We've either hit a page bound in a file, or a piece bound.")

                                (RETURN (COND
                                           [(ZEROP (fetch
 (TEXTSTREAM CHARSLEFT) of
 STREAM))
                                                             (* ; "Time for a new piece.")

                                            [repeatwhile
 (AND PC (ZEROP (fetch
 (PIECE PLEN)
                                                                           of
 PC)))
                                               do
            (* ; 

                                           "Skip over any zero-length pieces at the end of the file.")

                                                  (SETQ OPC (fetch
 (TEXTSTREAM PIECE) of
 STREAM))
                                                  (SETQ PC (replace
 (TEXTSTREAM PIECE) of
 STREAM
                                                              with
 (AND OPC (fetch
 (PIECE NEXTPIECE)
                                                                               of
 OPC]
                                            (replace
 (STREAM BINABLE) of
 STREAM with
 T)
                                            (replace
 (TEXTSTREAM FATSTREAMP) of
 STREAM with
 NIL)
                                                             (* ; 

                                                             "Move to the next piece in the chain")

                                            (COND
                                               [PC           (* ; "There IS a next piece to move to.")

                                                   (AND (fetch
 (TEXTSTREAM LOOKSUPDATEFN)
                                                           of
 STREAM)
                                                        (SETQ NPC (APPLY* (fetch
 (TEXTSTREAM 
                                                                                        LOOKSUPDATEFN
                                                                                        )
                                                                             of
 STREAM)
                                                                         STREAM PC))
                                                        (replace
 (TEXTSTREAM PIECE) of
 STREAM
                                                           with
 (SETQ PC NPC)))
                                                             (* ; 

   "Take care of any piece-change uproar.  uproar -- which may include picking a new piece to go to.")

                                                   [COND
                                                      (NPC   (* ; 

                                      "If we got an NPC, this was taken care of by the LOOKSUPDATEFN")

                                                           )
                                                      ([AND (SETQ PO (fetch
 (PIECE POBJ) of
 PC))
                                                            (SETQ SUBSTREAM (IMAGEOBJPROP
                                                                             PO
                                                                             'SUBSTREAM]
                                                       (\SETUPGETCH
 1 (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                         of
 SUBSTREAM))
                                                       (replace
 (TEXTSTREAM CURRENTPARALOOKS)
                                                          of
 STREAM with
 (fetch
 (TEXTSTREAM 
                                                                                     CURRENTPARALOOKS
                                                                                       ) of
 SUBSTREAM
                                                                                ))
                                                       (replace
 (TEXTSTREAM CURRENTLOOKS)
                                                          of
 STREAM with
 (fetch
 (TEXTSTREAM 
                                                                                       CURRENTLOOKS)
                                                                            of
 SUBSTREAM)))
                                                      [(NEQ (fetch
 (PIECE PPARALOOKS) of
 OPC)
                                                            (fetch
 (PIECE PPARALOOKS) of
 PC))
                                                       (replace
 (TEXTSTREAM CURRENTPARALOOKS)
                                                          of
 STREAM with
 (\TEDIT.APPLY.PARASTYLES
                                                                          (fetch
 (PIECE PPARALOOKS)
                                                                             of
 PC)
                                                                          PC
                                                                          (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                             of
 STREAM)))
                                                       (replace
 (TEXTSTREAM CURRENTLOOKS)
                                                          of
 STREAM with
 (\TEDIT.APPLY.STYLES
                                                                          (fetch
 (PIECE PLOOKS)
                                                                             of
 PC)
                                                                          PC
                                                                          (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                             of
 STREAM]
                                                      ((NOT (EQCLOOKS (fetch
 (PIECE PLOOKS)
                                                                         of
 PC)
                                                                   (fetch
 (PIECE PLOOKS) of
 OPC)))
                                                       (replace
 (TEXTSTREAM CURRENTLOOKS)
                                                          of
 STREAM with
 (\TEDIT.APPLY.STYLES
                                                                          (fetch
 (PIECE PLOOKS)
                                                                             of
 PC)
                                                                          PC
                                                                          (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                             of
 STREAM]
                                                   (COND
                                                      ((SETQ PS (fetch
 (PIECE PSTR) of
 PC))
                                                             (* ; "This piece lives in a string.")

                                                       (\TEDIT.TEXTBIN.STRINGSETUP

                                                        0
                                                        (fetch
 (PIECE PLEN) of
 PC)
                                                        STREAM PS)

                                 (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")

                                                             (* ; 

                                  "Then actually grab the next character to hand back to the caller.")

                                                       (\BIN STREAM))
                                                      ((SETQ PF (fetch
 (PIECE PFILE) of
 PC))
                                                             (* ; "This piece lives on a file.")

                                                       (\TEDIT.TEXTBIN.FILESETUP
 PC 0
                                                              (fetch
 (PIECE PLEN) of
 PC)
                                                              STREAM PF (fetch
 (PIECE PFATP)
                                                                           of
 PC)
                                                              'PEEKBIN)
                                                       (\BIN STREAM))
                                                      [(SETQ PO (fetch
 (PIECE POBJ) of
 PC))
                                                       (replace
 (STREAM BINABLE) of
 STREAM
                                                          with
 NIL)
                                                       (COND
                                                          (SUBSTREAM 
                                                             (* ; 

                                            "There is a stream below this one, to feed chars upward.")

                                                                 (\SETUPGETCH
 1 (fetch
 (TEXTSTREAM
                                                                                        TEXTOBJ)
                                                                                   of
 SUBSTREAM))
                                                                 (freplace
 (STREAM COFFSET)
                                                                    of
 STREAM with
 0)
                                                                 (freplace
 (TEXTSTREAM CHARSLEFT)
                                                                    of
 STREAM
                                                                    with
 (fetch
 (PIECE PLEN)
                                                                            of
 PC))
                                                                 (freplace
 (STREAM CBUFSIZE)
                                                                    of
 STREAM
                                                                    with
 (fetch
 (PIECE PLEN)
                                                                            of
 PC))
                                                                 (freplace
 (STREAM CPAGE)
                                                                    of
 STREAM with
 0)
                                                                 (freplace
 (TEXTSTREAM PCSTARTCH)
                                                                    of
 STREAM with
 0)
                                                                 (freplace
 (TEXTSTREAM PCSTARTPG)
                                                                    of
 STREAM with
 0)
                                                                 (replace
 (TEXTSTREAM 
                                                                                 CURRENTPARALOOKS)
                                                                    of
 STREAM
                                                                    with
 (fetch
 (TEXTSTREAM 
                                                                                     CURRENTPARALOOKS
                                                                                       ) of
 SUBSTREAM
                                                                                ))
                                                                 (replace
 (TEXTSTREAM CURRENTLOOKS)
                                                                    of
 STREAM
                                                                    with
 (fetch
 (TEXTSTREAM 
                                                                                       CURRENTLOOKS)
                                                                            of
 SUBSTREAM))
                                                                 (RETURN (\BIN SUBSTREAM)))
                                                          (T (replace
 (TEXTSTREAM CHARSLEFT)
                                                                of
 STREAM with
 0)
                                                             (RETURN PO]
                                                      (T (ERROR "CAN'T GET TO NEXT PIECE"]
                                               (T            (* ; 

                                                         "There are no more pieces.  Punt gracefully")

                                                  (COND
                                                     ((fetch
 (STREAM ENDOFSTREAMOP) of
 STREAM)
                                                             (* ; 

                                             "If there's an EOF handler, call it & return the result")

                                                      (RETURN (APPLY* (fetch
 (STREAM ENDOFSTREAMOP)
                                                                         of
 STREAM)
                                                                     STREAM)))
                                                     (T      (* ; "Otherwise, return NIL")

                                                        (RETURN NIL]
                                           [(SETQ PO (fetch
 (PIECE POBJ) of
 (fetch
 (TEXTSTREAM PIECE)
                                                                               of
 STREAM)))
                                                             (* ; "This is an object")

                                            (replace
 (STREAM BINABLE) of
 STREAM with
 NIL)
                                            (COND
                                               (SUBSTREAM    (* ; 

                                            "There is a stream below this one, to feed chars upward.")

                                                      (\SETUPGETCH
 1 (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                        of
 SUBSTREAM))
                                                      (freplace
 (STREAM COFFSET) of
 STREAM
                                                         with
 1)
                                                      (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM
                                                         with
 0)
                                                      (freplace
 (STREAM CBUFSIZE) of
 STREAM
                                                         with
 (fetch
 (PIECE PLEN) of
 PC))
                                                      (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
                                                      (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM
                                                         with
 1)
                                                      (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM
                                                         with
 0)
                                                      (replace
 (TEXTSTREAM CURRENTPARALOOKS)
                                                         of
 STREAM with
 (fetch
 (TEXTSTREAM 
                                                                                     CURRENTPARALOOKS
                                                                                      ) of
 SUBSTREAM)
                                                             )
                                                      (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM
                                                         with
 (fetch
 (TEXTSTREAM CURRENTLOOKS)
                                                                 of
 SUBSTREAM))
                                                      (RETURN (\BIN SUBSTREAM)))
                                               (T (replace
 (TEXTSTREAM CHARSLEFT) of
 STREAM
                                                     with
 0)
                                                  (RETURN PO]
                                           (T                (* ; 

                                                           "Need to move to the next page in a file.")

                                              (RETURN (\TEDIT.TEXTBIN.NEW.PAGE
 STREAM]
         (IF
 (IMAGEOBJP BYTE)
             THEN
 (OR (GETTEXTPROP
 (FETCH
 (TEXTSTREAM TEXTOBJ) OF
 STREAM)
                             'OBJECTBYTE)
                      BYTE)
           ELSE
 BYTE])

(\TEDIT.TEXTBIN.STRINGSETUP

  [LAMBDA (CHOFFSET CHARSLEFT STREAM PS)
                 (* ; "Edited 31-May-91 14:21 by jds")

    (PROG (OFFST)
          (COND
             ((fetch
 (STRINGP FATSTRINGP) of
 PS)

         (* The string is FAT. Therefore, make all the offsets and things take account 

       of the fact that each char is really 2 bytes.)


              (freplace
 (STREAM CPPTR) of
 STREAM with
 (ADDBASE (ffetch
 (STRINGP
                                                                                        BASE)
                                                                              of
 PS)
                                                                         (ffetch
 (STRINGP OFFST)
                                                                            of
 PS)))

         (* The char page ptr can point to the real first char, since it's a word.)


              (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
              (freplace
 (STREAM COFFSET) of
 STREAM with
 (UNFOLD CHOFFSET 2))
                                                             (* Offset into the string, in bytes.

                                                           That 2 should really be something 

                                                           like BYTESPERFATCHAR.)

              (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
                                                             (* Page %# within the "file" where 

                                                           this piece starts)

              (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM with
 0)
                                                             (* Char within "page" where the 

                                                           piece starts (for BACKFILEPTR))

              (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 (IPLUS (UNFOLD CHARSLEFT 2)
                                                                            (ffetch
 (STREAM
                                                                                         COFFSET)
                                                                               of
 STREAM)))
                                                             (* Since the chars-left field is 

                                                           words, and we're talking bytes.)

              (freplace
 (STREAM EPAGE) of
 STREAM with
 1)
              (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)

         (* When we hit the end of the string, we'll have run out off the piece, too.)


              (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 NIL)
              (replace
 (STREAM BINABLE) of
 STREAM with
 NIL)
                                                             (* To force BINs thru the \TEXTBIN 

                                                           function so we can get two bytes.)

              (replace
 (TEXTSTREAM FATSTREAMP) of
 STREAM with
 T)
                                                             (* And mark the stream as having 

                                                           wide characters, so \TEXTBIN knows 

                                                           what to do.)

              )
             (T                                              (* Characters are thin in this 

                                                           string (the usual case))

                (freplace
 (STREAM CPPTR) of
 STREAM with

                                                           (ADDBASE (ffetch
 (STRINGP BASE)
                                                                       of
 PS)
                                                                  (LRSH (SETQ OFFST
                                                                         (ffetch
 (STRINGP OFFST)
                                                                            of
 PS))
                                                                        1)))
                (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
                (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
                                                             (* Page %# within the "file" where 

                                                           this piece starts)

                (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM with
 (LOGAND 1 OFFST))
                                                             (* Char within "page" where the 

                                                           piece starts (for BACKFILEPTR))

                (freplace
 (STREAM COFFSET) of
 STREAM with
 (IPLUS (LOGAND 1 OFFST)
                                                                             CHOFFSET))
                (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 (IPLUS CHARSLEFT
                                                                              (ffetch

                                                                               (STREAM COFFSET)
                                                                                 of
 STREAM)))
                (freplace
 (STREAM EPAGE) of
 STREAM with
 1)
                (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
                (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 NIL)
                (replace
 (TEXTSTREAM FATSTREAMP) of
 STREAM with
 NIL])

(\TEDIT.TEXTBIN.FILESETUP

  [LAMBDA (PC CHOFFSET CHARSLEFT STREAM PF FATP OPERATION NOERRORFLG)

                                                             (* ; "Edited  8-Jun-99 23:37 by rmk:")


                                                             (* ; "Edited  8-Jun-99 23:33 by rmk:")


                                                             (* ; "Edited  8-Jun-99 23:32 by rmk:")


                                                             (* ; "Edited 15-Apr-93 15:53 by jds")

                                                             (* ; 

                                      "Do the setup needed to make a text stream read from a file.")

    (PROG ((BYTESLEFT (COND
                         (FATP (UNFOLD CHARSLEFT 2))
                         (T CHARSLEFT)))
           (BYTEOFFSET (COND
                          (FATP (UNFOLD CHOFFSET 2))
                          (T CHOFFSET)))
           CH FPOS)
          [COND
             ((IEQP (ffetch
 (STREAM ACCESSBITS) of
 PF)
                    NoBits)                                  (* ; "ASSURE THAT THE FILE IS OPEN")

              (SETQ PF (\TEDIT.REOPEN.STREAM
 STREAM PF]
          [freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 (ffetch
 (BYTEPTR PAGE)
                                                                         of
 (SETQ FPOS
                                                                                 (ffetch

                                                                                  (PIECE PFPOS)
                                                                                    of
 PC]
                                                             (* ; 

                                                      "Page within the file where the piece starts")

          (freplace
 (TEXTSTREAM PCSTARTCH) of
 STREAM with
 (ffetch
 (BYTEPTR OFFSET)
                                                                         of
 FPOS))
                                                             (* ; 

                                                           "Char within the page where it starts.")

          (SETFILEPTR PF (IPLUS FPOS BYTEOFFSET))
          [COND
             ((ZEROP (GETEOFPTR PF))                         (* ; 

                                                           "For zero-length files, do nothing.")

              )
             ((ILESSP (IPLUS FPOS BYTEOFFSET)
                     (GETEOFPTR PF))                         (* ; 

                   "Only get the next character if we aren't positioning past the end of the file.")

              (SETQ CH (IF
 (EQ OPERATION 'BIN)
                           THEN
 (CL:IF FATP
                                        (LOGOR (UNFOLD (\PAGEDBIN PF)
                                                      256)
                                               (\PAGEDPEEKBIN PF NOERRORFLG))
                                        (\BIN PF))
                         ELSE
 (CL:IF FATP
                                      (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PF)
                                                           256)
                                                    (\PAGEDPEEKBIN PF NOERRORFLG))
                                             (\PAGEDBACKFILEPTR PF))
                                      (\PEEKBIN PF NOERRORFLG))]

(* ;;; "Move all the relevant fields from the backing file's stream into the text stream, so that microcoded BINs will do the right thing.")


          (freplace
 (STREAM CPPTR) of
 STREAM with
 (ffetch
 (STREAM CPPTR) of

                                                                                         PF))
          (freplace
 (STREAM CPAGE) of
 STREAM with
 (ffetch
 (STREAM CPAGE) of

                                                                                         PF))
          (freplace
 (STREAM COFFSET) of
 STREAM with
 (ffetch
 (STREAM COFFSET)
                                                                   of
 PF))
          (freplace
 (STREAM EPAGE) of
 STREAM with
 32767)
          (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 (IMIN (ffetch
 (STREAM CBUFSIZE)
                                                                          of
 PF)
                                                                       (IPLUS (ffetch

                                                                               (STREAM COFFSET)
                                                                                 of
 PF)
                                                                              BYTESLEFT)))
          [freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with

                                                             (IDIFFERENCE BYTESLEFT
                                                                    (IDIFFERENCE (ffetch

                                                                                  (STREAM CBUFSIZE)
                                                                                    of
 STREAM)
                                                                           (ffetch
 (STREAM 
                                                                                              COFFSET
                                                                                              )
                                                                              of
 STREAM]
          (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 PF)
          (replace
 (TEXTSTREAM FATSTREAMP) of
 STREAM with
 FATP)
                                                             (* ; 

                                   "Mark the stream, if it contains fat characters for this piece.")

          (replace
 (STREAM BINABLE) of
 STREAM with
 (NOT FATP))
                                                             (* ; 

                                        "A stream that has fat chars can't use the micrododed BIN.")

                                                             (* ; 

                                                           "And return the next character in line")

          (RETURN CH])

(\TEDIT.TEXTBIN.NEW.PAGE

  [LAMBDA (STREAM SPLITCHAR)
                             (* ; "Edited 11-Jun-99 15:10 by rmk:")


                                                             (* ; "Edited 11-Jun-99 15:10 by rmk:")


                                                             (* ; "Edited 11-Jun-99 15:01 by rmk:")


                                                             (* ; "Edited 11-Jun-99 15:01 by rmk:")


                                                             (* ; "Edited 11-Jun-99 14:18 by rmk:")


                                                             (* ; "Edited 31-May-91 14:21 by jds")


         (* * Handle crossing a file-page boundary within TEXTBIN)


         (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte 

       character, and only need to read the second byte.

       Otherwise, this function will read 2 bytes for a fat character.)


    (PROG ((FILE (fetch
 (TEXTSTREAM REALFILE) of
 STREAM))
           CH)                                               (* Get the STREAM which describes 

                                                           the file for real)

          [COND
             ((IEQP (fetch
 (STREAM ACCESSBITS) of
 FILE)
                    NoBits)                                  (* The file was closed for some 

                                                           reason; reopen it.)

              (SETQ FILE (\GETSTREAM [OPENFILE (fetch
 (STREAM FULLNAME) of
 FILE)
                                            'INPUT NIL '((TYPE TEXT]
                                'INPUT]
          (replace
 (STREAM COFFSET) of
 FILE with
 (fetch
 (STREAM CBUFSIZE)
                                                                of
 FILE))
                                                             (* Force it to do a page switch for 

                                                           us)

          (SETQ CH (\BIN FILE))                              (* Get the next character in the 

                                                           usual manner)

          (replace
 (STREAM CPPTR) of
 STREAM with
 (fetch
 (STREAM CPPTR) of
 FILE))
                                                             (* Steal the fields we need to 

                                                           simulate that stream)

          (replace
 (STREAM COFFSET) of
 STREAM with
 (fetch
 (STREAM COFFSET)
                                                                  of
 FILE))
          (replace
 (STREAM CPAGE) of
 STREAM with
 (fetch
 (STREAM CPAGE) of
 FILE))
          (replace
 (STREAM CBUFSIZE) of
 STREAM with
 (IMIN (fetch
 (TEXTSTREAM 
                                                                                        CHARSLEFT)
                                                                         of
 STREAM)
                                                                      (fetch
 (STREAM CBUFSIZE)
                                                                         of
 FILE)))
                                                             (* Can't read farther than 

                                                           end-of-piece, tho)

          (replace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 (IDIFFERENCE (fetch

                                                                                   (TEXTSTREAM 
                                                                                          CHARSLEFT)
                                                                                     of
 STREAM)
                                                                            (fetch
 (STREAM 
                                                                                             CBUFSIZE
                                                                                              )
                                                                               of
 STREAM)))
          (COND
             [(AND (fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                   (NOT SPLITCHAR))

         (* This piece contains fat characters. Need to grab a second byte from the 

       file, and construct a 16-bit character)


              (RETURN (LOGOR (UNFOLD CH 256)
                             (\PAGEDBIN STREAM]
             (T                                              (* Regular, 8-bit characters.

                                                           Just return the one we BINned.)


         (* or we only need the second byte, since the first byte was on the prior page.)


                (RETURN CH])
)
(DEFINEQ

(\TEXTPEEKBIN

  [LAMBDA (STREAM NOERRORFLG)

    (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return OBJECTCHAR for image objects, if present")


    (* ;; "Edited 28-Mar-94 15:34 by jds")

                                                             (* ; "DO PEEKBIN for a text stream")

    (LET (BYTE)                                              (* ; 

                                               "BYTE to capture all returns for imageobject coercion")

         [SETQ BYTE (PROG (CH FILE STR PF PS PC PO SUBSTREAM)
                          (SETQ PC (fetch
 (TEXTSTREAM PIECE) of
 STREAM))
                          (COND
                             [(ILESSP (fetch
 (STREAM COFFSET) of
 STREAM)
                                     (fetch
 (STREAM CBUFSIZE) of
 STREAM))
                                                             (* ; 

                                                           "Simple case -- just do the usual PEEKBIN")

                              (COND
                                 ((AND PC (SETQ PO (fetch
 (PIECE POBJ) of
 PC)))
                                  (RETURN PO))
                                 [(fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                                                             (* ; 

                                                       "This is a 16 bit PEEKBIN.  Grab two chars...")

                                  (RETURN (COND
                                             [(\EOFP STREAM)
                                              (COND
                                                 (NOERRORFLG NIL)
                                                 (T (\PEEKBIN STREAM]
                                             ((ILESSP (fetch
 (STREAM COFFSET) of
 STREAM)
                                                     (SUB1 (fetch
 (STREAM CBUFSIZE) of
 STREAM)))
                                                             (* ; 

                                  "We're sure of staying on the same page.  Just grab the characters")

                                              (PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM)
                                                                   256)
                                                            (\PAGEDPEEKBIN STREAM NOERRORFLG))
                                                     (\PAGEDBACKFILEPTR STREAM)))
                                             (T (SETQ PS (fetch
 (STREAM F1) of
 STREAM))
                                                (replace
 (STREAM COFFSET) of
 PS
                                                   with
 (fetch
 (STREAM COFFSET) of
 STREAM))
                                                (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS)
                                                                     256)
                                                              (\PAGEDPEEKBIN PS NOERRORFLG))
                                                       (\PAGEDBACKFILEPTR PS]
                                 (T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG]
                             [PC                             (* ; 

                                         "We've either hit a page bound in a file, or a piece bound.")

                                 (RETURN (COND
                                            [(ZEROP (fetch
 (TEXTSTREAM CHARSLEFT) of
 STREAM))
                                                             (* ; "Time for a new piece.")

                                             (SETQ PC (replace
 (TEXTSTREAM PIECE) of
 STREAM
                                                         with
 (fetch
 (PIECE NEXTPIECE) of
 PC)))
                                                             (* ; 

                                                             "Move to the next piece in the chain")

                                             (COND
                                                [PC (replace
 (TEXTSTREAM CURRENTLOOKS) of
 STREAM
                                                       with
 (\TEDIT.APPLY.STYLES (fetch
 (PIECE PLOOKS
                                                                                               )
                                                                                    of
 PC)
                                                                   PC
                                                                   (fetch
 (TEXTSTREAM TEXTOBJ)
                                                                      of
 STREAM)))
                                                    (COND
                                                       [(SETQ PO (fetch
 (PIECE POBJ) of
 PC))
                                                        (replace
 (STREAM BINABLE) of
 STREAM
                                                           with
 NIL)
                                                        (freplace
 (STREAM CBUFSIZE) of
 STREAM
                                                           with
 (fetch
 (PIECE PLEN) of
 PC))
                                                        (freplace
 (STREAM COFFSET) of
 STREAM
                                                           with
 0)
                                                        (COND
                                                           (SUBSTREAM 
                                                             (* ; 

                                            "There is a stream below this one, to feed chars upward.")

                                                                  (\SETUPGETCH
 1 (fetch
 (TEXTSTREAM
                                                                                         TEXTOBJ)
                                                                                    of
 SUBSTREAM))
                                                                  (freplace
 (TEXTSTREAM CHARSLEFT)
                                                                     of
 STREAM
                                                                     with
 (fetch
 (PIECE PLEN)
                                                                             of
 PC))
                                                                  (freplace
 (STREAM CPAGE)
                                                                     of
 STREAM with
 0)
                                                                  (freplace
 (TEXTSTREAM PCSTARTCH)
                                                                     of
 STREAM with
 0)
                                                                  (freplace
 (TEXTSTREAM PCSTARTPG)
                                                                     of
 STREAM with
 0)
                                                                  (replace
 (TEXTSTREAM 
                                                                                  CURRENTPARALOOKS)
                                                                     of
 STREAM
                                                                     with
 (fetch
 (TEXTSTREAM 
                                                                                     CURRENTPARALOOKS
                                                                                        )
                                                                             of
 SUBSTREAM))
                                                                  (replace
 (TEXTSTREAM CURRENTLOOKS)
                                                                     of
 STREAM
                                                                     with
 (fetch
 (TEXTSTREAM 
                                                                                        CURRENTLOOKS)
                                                                             of
 SUBSTREAM))
                                                                  (RETURN (\BIN SUBSTREAM)))
                                                           (T (replace
 (TEXTSTREAM CHARSLEFT)
                                                                 of
 STREAM with
 0)
                                                              (RETURN PO]
                                                       ((SETQ PS (fetch
 (PIECE PSTR) of
 PC))
                                                             (* ; "This piece lives in a string.")

                                                        (\TEDIT.TEXTBIN.STRINGSETUP

                                                         0
                                                         (fetch
 (PIECE PLEN) of
 PC)
                                                         STREAM PS)

                                 (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")


                                                        (\PEEKBIN STREAM NOERRORFLG))
                                                       ((SETQ PF (fetch
 (PIECE PFILE) of
 PC))
                                                             (* ; "This piece lives on a file.")

                                                        (\TEDIT.TEXTBIN.FILESETUP
 PC 0
                                                               (fetch
 (PIECE PLEN) of
 PC)
                                                               STREAM PF (fetch
 (PIECE PFATP)
                                                                            of
 PC)
                                                               'PEEKBIN NOERRORFLG))
                                                       (T (ERROR "CAN'T GET TO NEXT PIECE"]
                                                (NOERRORFLG  (* ; 

                                                         "There are no more pieces.  Punt gracefully")

                                                       (RETURN NIL))
                                                (T           (* ; "He wants it the hard way.")

                                                   (APPLY* (fetch
 (STREAM ENDOFSTREAMOP) of
 STREAM)
                                                          STREAM]
                                            (T               (* ; 

                                                           "Need to move to the next page in a file.")

                                               (RETURN (\TEDIT.PEEKBIN.NEW.PAGE
 STREAM NOERRORFLG]
                             (NOERRORFLG                     (* ; 

                                                         "There are no more pieces.  Punt gracefully")

                                    (RETURN NIL))
                             (T                              (* ; "He wants it the hard way.")

                                (APPLY* (fetch
 (STREAM ENDOFSTREAMOP) of
 STREAM)
                                       STREAM]
         (IF
 (IMAGEOBJP BYTE)
             THEN
 (OR (GETTEXTPROP
 (FETCH
 (TEXTSTREAM TEXTOBJ) OF
 STREAM)
                             'OBJECTBYTE)
                      BYTE)
           ELSE
 BYTE])

(\TEDIT.PEEKBIN.NEW.PAGE

  [LAMBDA (STREAM NOERRORFLG)
                            (* ; "Edited 11-Jun-99 15:11 by rmk:")


                                                             (* ; "Edited 31-May-91 14:21 by jds")


         (* * Handle crossing a file-page boundary within \TEXTPEEKBIN)


         (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte 

       character, and only need to read the second byte.

       Otherwise, this function will read 2 bytes for a fat character.)


    (PROG ((FILE (fetch
 (TEXTSTREAM REALFILE) of
 STREAM))
           CH)                                               (* Get the STREAM which describes 

                                                           the file for real)

          [COND
             ((IEQP (fetch
 (STREAM ACCESSBITS) of
 FILE)
                    NoBits)                                  (* The file was closed for some 

                                                           reason; reopen it.)

              (SETQ FILE (\GETSTREAM [OPENFILE (fetch
 (STREAM FULLNAME) of
 FILE)
                                            'INPUT NIL '((TYPE TEXT]
                                'INPUT]
          (replace
 (STREAM COFFSET) of
 FILE with
 (fetch
 (STREAM CBUFSIZE)
                                                                of
 FILE))
                                                             (* Force it to do a page switch for 

                                                           us)

          [SETQ CH (COND
                      [(\EOFP FILE)
                       (COND
                          (NOERRORFLG NIL)
                          (T (\PEEKBIN FILE]
                      ((fetch
 (TEXTSTREAM FATSTREAMP) of
 STREAM)
                       (PROG1 (LOGOR (UNFOLD (\PAGEDBIN FILE)
                                            256)
                                     (\PAGEDPEEKBIN FILE NOERRORFLG))
                              (\PAGEDBACKFILEPTR FILE)))
                      (T (\PEEKBIN FILE NOERRORFLG]          (* Get the next character in the 

                                                           usual manner)

          (replace
 (STREAM CPPTR) of
 STREAM with
 (fetch
 (STREAM CPPTR) of
 FILE))
                                                             (* Steal the fields we need to 

                                                           simulate that stream)

          (replace
 (STREAM COFFSET) of
 STREAM with
 (fetch
 (STREAM COFFSET)
                                                                  of
 FILE))
          (replace
 (STREAM CPAGE) of
 STREAM with
 (fetch
 (STREAM CPAGE) of
 FILE))
          (replace
 (STREAM CBUFSIZE) of
 STREAM with
 (IMIN (fetch
 (TEXTSTREAM 
                                                                                        CHARSLEFT)
                                                                         of
 STREAM)
                                                                      (fetch
 (STREAM CBUFSIZE)
                                                                         of
 FILE)))
                                                             (* Can't read farther than 

                                                           end-of-piece, tho)

          (replace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 (IDIFFERENCE (fetch

                                                                                   (TEXTSTREAM 
                                                                                          CHARSLEFT)
                                                                                     of
 STREAM)
                                                                            (fetch
 (STREAM 
                                                                                             CBUFSIZE
                                                                                              )
                                                                               of
 STREAM)))
          (RETURN CH])
)



(* ; "Support for TEXTPROP")


(DEFINEQ

(CGETTEXTPROP

  [LAMBDA (TEXTOBJ PROP)
                                     (* ; "Edited 20-Oct-87 12:36 by jds")

          
          (* ;; "compiles calls on TEXTPROP that are fetching values.  This needs to be changed whenever GETTEXTPROP is changed.")


    (SELECTQ PROP
        ((READONLY READ-ONLY) 
             `(fetch
 (TEXTOBJ TXTREADONLY) of
 ,TEXTOBJ))
        `(LISTGET (fetch
 (TEXTOBJ EDITPROPS) of
 ,TEXTOBJ)
                ',PROP])

(CTEXTPROP

  [LAMBDA (FORMTAIL)
                                     (* ; "Edited 31-May-91 13:59 by jds")


    (* ;; "compiles calls to TEXTPROP")


    (COND
       ((NULL (CDR FORMTAIL))                                (* ; "less that 2 args")

        (printout T "Possible error in call to TEXTPROP: less than 2 args" T (LIST 'TEXTPROP FORMTAIL
                                                                                   )
               T)
        (CGETTEXTPROP
 (LIST 'TEXTOBJ (CAR FORMTAIL))
               NIL))
       ((NOT (EQ (CAADR FORMTAIL)
                 'QUOTE))                                    (* ; "property is not quoted.")

        'IGNOREMACRO)
       [(NULL (CDDR FORMTAIL))                               (* ; "fetching a TEXTPROP property.")

        (CGETTEXTPROP
 (LIST 'TEXTOBJ (CAR FORMTAIL))
               (CADR (CADR FORMTAIL]
       (T                                                    (* ; "storing a window property")

          (LET ((TEXTOBJ (CAR FORMTAIL))
                (PROP (CDADR FORMTAIL))
                (VAL (CADDR FORMTAIL)))
               [SELECTQ PROP
                   ((READONLY READ-ONLY) 
                        `(REPLACE
 (TEXTOBJ TXTREADONLY) OF
 ,TEXTOBJ WITH
 ,VAL))
                   `(COND
                       [(FETCH
 (TEXTOBJ EDITPROPS) OF
 (TEXTOBJ ,TEXTOBJ))
                        (LISTPUT (FETCH
 (TEXTOBJ EDITPROPS) OF
 (TEXTOBJ ,TEXTOBJ))
                               ',PROP
                               ',VAL]
                       (T (REPLACE
 (TEXTOBJ EDITPROPS) OF
 (TEXTOBJ ,TEXTOBJ)
                             WITH
 (LIST ,PROP ,VAL]
               (LIST 'COND (LIST (LIST 'FETCH 'EDITPROPS 'OF (LIST 'TEXTOBJ (CAR FORMTAIL)))
                                 (LIST 'LISTPUT (LIST 'FETCH 'EDITPROPS 'OF (LIST 'TEXTOBJ
                                                                                  (CAR FORMTAIL)))
                                       (CADR FORMTAIL)
                                       (CADDR FORMTAIL)))
                     (LIST T (LIST 'REPLACE 'EDITPROPS 'OF (LIST 'TEXTOBJ (CAR FORMTAIL))
                                   'WITH
                                   (LIST 'LIST (CADR FORMTAIL)
                                         (CADDR FORMTAIL])

(GETTEXTPROP

  [LAMBDA (TEXTOBJ PROP)
                                 (* ; "Edited  9-Feb-89 11:20 by jds")


    (* ;; "Gets values for document properties.  Used by TEXTPROP.")


    (SELECTQ PROP
        ((READONLY READ-ONLY) 
             (FETCH
 (TEXTOBJ TXTREADONLY) OF
 TEXTOBJ))
        ((BEING-EDITED ACTIVE) 
             (FETCH
 (TEXTOBJ TXTEDITING) OF
 TEXTOBJ))
        ((NO-NS-CHARS NONSCHARS NO-NSCHARS) 
             (FETCH
 (TEXTOBJ TXTNONSCHARS) OF
 TEXTOBJ))
        (LISTGET (fetch
 (TEXTOBJ EDITPROPS) of
 TEXTOBJ)
               PROP])

(PUTTEXTPROP

  [LAMBDA (TEXTOBJ PROP VALUE)
                           (* ; "Edited  9-Feb-89 11:19 by jds")

                                                             (* ; 

                                                           "put a value on prop list for a textobj")

    (SELECTQ PROP
        ((READONLY READ-ONLY) 
             (PROG1 (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)
                 (replace
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ with
 VALUE)))
        ((BEING-EDITED ACTIVE) 
             (PROG1 (fetch
 (TEXTOBJ TXTEDITING) of
 TEXTOBJ)
                 (replace
 (TEXTOBJ TXTEDITING) of
 TEXTOBJ with
 VALUE)))
        ((NO-NS-CHARS NONSCHARS NO-NSCHARS) 
             (PROG1 (fetch
 (TEXTOBJ TXTNONSCHARS) of
 TEXTOBJ)
                 (replace
 (TEXTOBJ TXTNONSCHARS) of
 TEXTOBJ with
 VALUE)))
        (COND
           ((fetch
 (TEXTOBJ EDITPROPS) of
 (TEXTOBJ TEXTOBJ))
            (PROG1 (LISTGET (ffetch
 (TEXTOBJ EDITPROPS) of
 (TEXTOBJ TEXTOBJ))
                          PROP)
                (LISTPUT (ffetch
 (TEXTOBJ EDITPROPS) of
 (TEXTOBJ TEXTOBJ))
                       PROP VALUE)))
           (T (freplace
 (TEXTOBJ EDITPROPS) of
 (TEXTOBJ TEXTOBJ) with
 (LIST PROP VALUE))
              NIL])

(TEXTPROP

  [LAMBDA X
                                              (* ; "Edited  9-Feb-89 11:20 by jds")


    (* ;; "general top level entry for both fetching and setting window properties.")


    (COND
       ((IGREATERP X 2)
        (PUTTEXTPROP
 (TEXTOBJ (ARG X 1))
               (ARG X 2)
               (ARG X 3)))
       ((EQ X 2)
        (GETTEXTPROP
 (TEXTOBJ (ARG X 1))
               (ARG X 2)))
       (T (\ILLEGAL.ARG NIL])
)



(* ;; 
"Support for error handling:  The old error handler for the stream-not-open error.  This is here, because you only want to do this ONCE, even if you load TEXTOFD multiple times (as, e.g., in development)"
)



(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER*
 (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(\TEXTINIT
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 TEXTPROP)
)
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 
1990 1991 1993 1994 1995 1999 2000 2001 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2992 53117 (COPYTEXTSTREAM 3002 . 6124) (OPENTEXTSTREAM 6126 . 21003) (REOPENTEXTSTREAM
 21005 . 21427) (TEDIT.STREAMCHANGEDP 21429 . 21727) (TEXTSTREAMP 21729 . 22043) (TXTFILE 22045 . 
22490) (\DELETECH 22492 . 33748) (\SETUPGETCH 33750 . 41029) (\TEDIT.REOPEN.STREAM 41031 . 42881) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42883 . 45321) (\TEXTINIT 45323 . 51010) (\TEXTMARK 51012 . 51760) (
\TEXTTTYBOUT 51762 . 53115)) (53118 78550 (\INSERTCH 53128 . 76854) (\INSERTCR 76856 . 78548)) (78616 
98932 (\CHTOPC 78626 . 79815) (\CHTOPCNO 79817 . 81079) (\CLEARPCTB 81081 . 81877) (
\CREATEPIECEORSTREAM 81879 . 84853) (\DELETEPIECE 84855 . 85768) (\FINDPIECE 85770 . 86136) (
\INSERTPIECE 86138 . 89148) (\MAKEPCTB 89150 . 91065) (\SPLITPIECE 91067 . 98026) (\INSERT.FIRST.PIECE
 98028 . 98930)) (98984 123222 (\TEXTCLOSEF 98994 . 100221) (\TEXTCLOSEF-SUBTREE 100223 . 100929) (
\TEXTDSPFONT 100931 . 101923) (\TEXTEOFP 101925 . 103284) (\TEXTGETEOFPTR 103286 . 103496) (
\TEXTGETFILEPTR 103498 . 105561) (\TEXTOPENF 105563 . 106393) (\TEXTOPENF-SUBTREE 106395 . 107196) (
\TEXTOUTCHARFN 107198 . 107546) (\TEXTBACKFILEPTR 107548 . 113449) (\TEXTBOUT 113451 . 116799) (
\TEDITOUTCCODEFN 116801 . 118067) (\TEXTSETEOF 118069 . 118578) (\TEXTSETFILEPTR 118580 . 119805) (
\TEXTDSPXPOSITION 119807 . 120664) (\TEXTDSPYPOSITION 120666 . 121211) (\TEXTLEFTMARGIN 121213 . 
121696) (\TEXTRIGHTMARGIN 121698 . 122634) (\TEXTDSPCHARWIDTH 122636 . 122874) (\TEXTDSPSTRINGWIDTH 
122876 . 123116) (\TEXTDSPLINEFEED 123118 . 123220)) (123223 161060 (\TEXTBIN 123233 . 144112) (
\TEDIT.TEXTBIN.STRINGSETUP 144114 . 149827) (\TEDIT.TEXTBIN.FILESETUP 149829 . 156215) (
\TEDIT.TEXTBIN.NEW.PAGE 156217 . 161058)) (161061 176823 (\TEXTPEEKBIN 161071 . 172564) (
\TEDIT.PEEKBIN.NEW.PAGE 172566 . 176821)) (176861 182079 (CGETTEXTPROP 176871 . 177347) (CTEXTPROP 
177349 . 179693) (GETTEXTPROP 179695 . 180290) (PUTTEXTPROP 180292 . 181617) (TEXTPROP 181619 . 182077
)))))
STOP