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

(FILECREATED "10-May-2026 13:26:30" {MEDLEY}<library>TEDIT>TEDIT-STREAM.;957 191002 

      :EDIT-BY rmk

      :CHANGES-TO (FNS \TEDIT.OPENTEXTFILE)

      :PREVIOUS-DATE " 1-May-2026 08:15:56" {MEDLEY}<library>TEDIT>TEDIT-STREAM.;956)


(PRETTYCOMPRINT TEDIT-STREAMCOMS)

(RPAQQ TEDIT-STREAMCOMS
       [(DECLARE%: EVAL@COMPILE DONTCOPY
               (EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
                      (MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PPARALOOKS 
                             PPARALAST PFPOS PBYTELEN PNEW PBYTESPERCHAR POBJ)
                      (MACROS SETPC FSETPC GETPC FGETPC)
                      (MACROS THINPIECEP)
                      (MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
                      (MACROS GETTOBJ SETTOBJ FGETTOBJ FSETTOBJ TEXTLEN TEXTSEL TEXTOBJ!)
                      (MACROS GETTSTR SETTSTR FGETTSTR FSETTSTR TEXTSTREAM!)
                      (CONSTANTS * PTYPES)
                      (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)))
        (INITRECORDS PIECE TEXTOBJ TEXTSTREAM)
        (COMS 
              (* ;; "The BIN-level functions")

              (FNS \TEDIT.TEXTBIN \TEDIT.TEXTPEEKBIN \TEDIT.TEXTBACKFILEPTR \TEDIT.TEXTBOUT 
                   \TEDIT.INSTALL.FILEBUFFER)
              (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \ENDOFPIECEP \STARTOFPIECEP \ENDOFBUFFERP 
                                                      \STARTOFBUFFERP)))
        
        (* ;; "External format functions:  equivalent to BIN-level except for COUNTP")

        (FNS \TEDIT.TEXTOUTCHARFN \TEDIT.TEXTINCCODEFN \TEDIT.TEXTBACKCCODEFN 
             \TEDIT.TEXTFORMATBYTESTREAM \TEDIT.TEXTFORMATBYTESTRING)
        
        (* ;; "High-level stream operations")

        (FNS OPENTEXTSTREAM COPYTEXTSTREAM TEDIT.STREAMCHANGEDP TXTFILE)
        (FNS \TEDIT.REOPENTEXTSTREAM \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.OPENTEXTSTREAM.PROPS 
             \TEDIT.OPENTEXTSTREAM.SETUP.SEL \TEDIT.OPENTEXTSTREAM.WINDOW 
             \TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS \TEDIT.OPENTEXTFILE \TEDIT.CREATE.TEXTSTREAM 
             \TEDIT.REOPEN.STREAM)
        (FNS \TEDIT.STREAMINIT TEDIT.IMAGESTREAM.OPEN)
        (ALISTS (IMAGESTREAMTYPES TEDIT))
        
        (* ;; "Is this being used:")

        (FNS \TEDIT.TTYBOUT)
        [INITVARS (*TEDIT-EXTENSIONS* '(TEDIT TED TXT TEXT BRAVO NIL]
        
        (* ;; "Low-level generic stream operations")

        (FNS \TEDIT.TEXTCLOSEF \TEDIT.TEXTDSPFONT \TEDIT.TEXTEOFP \TEDIT.TEXTGETEOFPTR 
             \TEDIT.TEXTSETEOFPTR \TEDIT.TEXTGETFILEPTR \TEDIT.TEXTSETFILEINFO \TEDIT.TEXTOPENF 
             \TEDIT.TEXTSETEOF \TEDIT.TEXTSETFILEPTR \TEDIT.TEXTDSPXPOSITION \TEDIT.TEXTDSPYPOSITION
             \TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTCOLOR \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH 
             \TEDIT.TEXTDSPSTRINGWIDTH \TEDIT.TEXTDSPLINEFEED)
        
        (* ;; "Access by character")

        (FNS \TEDIT.NTHCHARCODE \TEDIT.PIECE.NTHCHARCODE \TEDIT.RPLCHARCODE \TEDIT.PIECE.RPLCHARCODE
             \TEDIT.NTHCHARLOOKS)
        (COMS 
              (* ;; "Editing support")

              (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (INSERTSTRINGLENGTH 512))
                     (MACROS \INSERTCH.EXTENDABLE))
              (FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL 
                   \TEDIT.INSERTCH.INSERTION \TEDIT.INSERTCH.EXTEND)
              (FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO))
        (FNS \TEDIT.INSTALL.PIECE)
        [COMS                                                (* ; "Support for TEXTPROP")
              (FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD 
                   \TEDIT.TEXTPROP)
              (FNS \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN \TEDIT.TEXTOBJ.PROPSTOREFN)
                                                             (* ; "For TEXTOBJ inspection")
              (DECLARE%: DONTCOPY                            (* ; "Only if the declaration is loaded")
                     (ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES 
                                                    \TEDIT.TEXTOBJ.PROPFETCHFN 
                                                    \TEDIT.TEXTOBJ.PROPSTOREFN]
        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.STREAMINIT)))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA TEXTPROP])
(DECLARE%: EVAL@COMPILE DONTCOPY 
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE

(DATATYPE PIECE (                                            (* ; 
                 "The piece describes either a string or part of a file.  , or a generalized OBJECT.")
                 PCONTENTS                                   (* ; "The background source of data for this piece (stream, string, block, object, depending on the PTYPE).")
                 (PTYPE BITS 4)                              (* ; 
                           "How the characters are delivered: thinfile, fatstring, object, substream")
                 NIL                                         (* ; 
              "Was PBYTELEN: Length of this character piece in bytes.  PBYTELEN = PLEN*PBYTESPERCHAR")
                 PFPOS                                       (* ; 
                                                  "The FILEPTR of the start of the piece in the file")
                 PLEN                                        (* ; 
                                                             "Length of the piece, in characters.")
                 NEXTPIECE                                   (* ; "-> Next piece in this textobj.")
                 (PREVPIECE FULLXPOINTER)                    (* ; 
                                                             "-> Prior piece in this text object.")
                 PCHARLOOKS                                  (* ; "Character formatting info ")
                 PBYTESPERCHAR                               (* ; 
       "The number of bytes per character, given that all characters in a piece are the same length.")
                 (PPARALAST FLAG)                            (* ; "This piece ends paragraph")
                 PPARALOOKS                                  (* ; "Paragraph looks for this piece")
                 (PNEW FLAG)                                 (* ; 
             "This text is new here;  used by the tentative edit system, and anyone else interested.")
                 (NIL FLAG)                                  (* ; "Was PFATP")
                 (NIL FLAG)
                 (PTREENODE XPOINTER)                        (* ; 
                                             "Points to the PCTB tree-node that contains this piece.")
                 (NIL BYTE)                                  (* ; 
                                               "Was PCHARSET: High-order charset for FATFILE1 pieces")
                 NIL)                                        (* ; "Was PUTF8BYTESPERCHAR: The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece. But this just duplicates PBYTESPERCHAR for UTF-8 pieces")
                [ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
                                       (type? IMAGEOBJ (PCONTENTS DATUM))
                                       (PCONTENTS DATUM))
                                  (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
                                       (SETPC DATUM PCONTENTS NEWVALUE]
                PFPOS _ 0 PLEN _ 0)

(DATATYPE TEXTOBJ (
                   (* ;; 
   "This is where TEdit stores its state information, and internal data about the text being edited.")

                   PCTB                                      (* ; "The piece table")
                   TEXTLEN                                   (* ; "# of chars in the text")
                   PRIMARYPANE                               (* ; "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC")
                   SUFFIXPIECE                               (* ; 
                    "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
                   CHARFN                                    (* ; 
    "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")
                   HINTPC                                    (* ; 
                                                             "Was: Space left in the type-in piece")
                   HINTPCSTARTCH#                            (* ; 
                                                          "Was # of characters already in the piece.")
                   INSERTSTRING                              (* ; 
                                         "A substring of storage that is available for an insertion.")
                   TXTHISTORYUNDONE                          (* ; "Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece.")
                   (NIL FLAG)                                (* ; " Was \INSERTPCVALID. T if it's OK to use the cached piece.  Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL.")
                   (TXTREADONLYQUIET FLAG)                   (* ; 
                                                           "T => don't print READONLY abort messages")
                   PARABREAKCHARS                            (* ; "Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE")
                   MOUSEREGION                               (* ; 
                                                             "Section of the window the mouse is in.")
                   LOOPFN                                    (* ; "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES.")
                   DS                                        (* ; 
  "NOTE:  THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
                   SEL                                       (* ; 
                                                             "The current selection within the text")
                   LASTARROWX                                (* ; 
                       "X for next arrow up or arrow down. Was: Scratch space for the selection code")
                   SECONDARYSEL                              (* ; "Holds secondary selection and operation just before the mouse leaves a window. Was MOVESEL: Source for the next MOVE of text")
                   NIL                                       (* ; 
                                                           "Was SHIFTEDSEL: Source for the next COPY")
                   NIL                                       (* ; 
                                                       "Was DELETESEL: Text to be deleted imminently")
                   NIL                                       (* ; 
                        "Was WRIGHT: Right edge of the window (or subregion) where this is displayed")
                   WTOP                                      (* ; "Top of the window/region")
                   NIL                                       (* ; 
                                                           "Was WBOTTOM: Bottom of the window/region")
                   NIL                                       (* ; 
                                                          "Was WLEFT: Left edge of the window/region")
                   TXTFILE                                   (* ; 
                                                             "The original text file we're editing")
                   (\XDIRTY FLAG)                            (* ; "T => changed since last saved.")
                   (STREAMHINT FULLXPOINTER)                 (* ; 
                                           "-> the TEXTOFD stream which gives access to this textobj")
                   EDITFINISHEDFLG                           (* ; 
                                                        "T => The guy has asked the editor to go way")
                   NIL                                       (* ; 
                                     "Was CARET: Describes the flashing caret for the editing window")
                   CARETLOOKS                                (* ; 
                                                             "Font to be used for inserted text.")
                   WINDOWTITLE                               (* ; 
                                                  "Original title for this window, of there was one.")
                   THISLINE                                  (* ; 
                                               "Cache of line-related info, to speed up selection &c")
                   (MENUFLG FLAG)                            (* ; 
                                                            "T if this TEXTOBJ is a tedit-style menu")
                   DEFAULTPARALOOKS                          (* ; 
                                      "Default Formatting Spec to be used when formatting paragraphs")
                   (FORMATTEDP FLAG)                         (* ; 
 "Flag for paragraph formatting.  T if this document is to contain paragraph formatting information.")
                   (TXTREADONLY FLAG)                        (* ; 
                                                        "This is only available for shift selection.")
                   (UNDERTEDIT FLAG)                         (* ; "Was TXTEDITING, but it was never fetched. T => This document is in a window and there is an edit process behind it.  For example, it only makes sense to have a caret show up if you are editing.")
                   (TXTNOTSPLITTABLE FLAG)                   (* ; "Can't split into panes, split-region not show. Was TXTNONSCHARS: T => If TEdit rns into a 255, it won't attempt to convert to NS characters.  Used for REALLY plain-text manipulation.")
                   TXTTERMSA                                 (* ; 
                                       "Special instructions for displaying characters on the screen")
                   EDITOPACTIVE                              (* ; 
                  "T if there is an editing operation in progress.  Used to interlock the TEdit menu")
                   DEFAULTCHARLOOKS                          (* ; "The default character looks -- if any -- to be applied to characters coming into the file from outside.")
                   TXTRTBL                                   (* ; 
                                  "The READTABLE to be used by the command loop for command dispatch")
                   TXTWTBL                                   (* ; 
                                                  "The READTABLE to be used to decide on word breaks")
                   EDITPROPS                                 (* ; 
                                                  "The PROPS that were passed into this edit session")
                   (BLUEPENDINGDELETE FLAG)                  (* ; "T if the next insertion in this document is to be preceded by a deletion of the then-current selection")
                   (TXTHISTORYINACTIVE FLAG)                 (* ; 
                                   "T if history events are not recorded (e.g. for transcript files)")
                   TXTHISTORY                                (* ; 
                                                            "The history list for this edit session.")
                   (SELPANE FULLXPOINTER)                    (* ; 
 "The pane in which the last 'real' selection got made for this edit;  used by TEDIT.NORMALIZECAREET")
                   PROMPTWINDOW                              (* ; 
   "A window to be used for unscheduled interactions;  normally a small window above the edit window")
                   DISPLAYCACHE                              (* ; 
                                "The bitmap to be used when building the image of a line for display")
                   DISPLAYCACHEDS                            (* ; 
                                                "The DISPLAYSTREAM that is used to build line images")
                   DISPLAYHCPYDS                             (* ; "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode")
                   TXTPAGEFRAMES                             (* ; 
                              "A tree of page frames, specifying how the document is to be laid out.")
                   TXTCHARLOOKSLIST                          (* ; 
                             "List of all the CHARLOOKSs in the document, so they can be kept unique")
                   TXTPARALOOKSLIST                          (* ; 
                              "List of all the PARALOOKS in the document, so they can be kept unique")
                   (TXTAPPENDONLY FLAG)                      (* ; "Allows updates only at the end of the stream.  Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater")
                   (TXTDON'TUPDATE FLAG)                     (* ; "T if we're holding off on screen updates until later.  Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.")
                   TXTRAWINCLUDESTREAM                       (* ; 
                       "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)")
                   DOCPROPS                                  (* ; 
                      "Document properties that are stored with the document. Not used before 9/2025")
                   TXTSTYLESHEET                             (* ; 
                      "Style sheet local to this document.  Not currently saved as part of the file.")
                   )
                  [ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM)
                                             (PROGN (FSETTOBJ DATUM LASTARROWX NIL)
                                                    (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY)
                                                                               of DATUM))
                                                        (\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
                                                        (freplace \XDIRTY OF DATUM WITH NEWVALUE))]
                  SEL _ (create SELECTION)
                  TEXTLEN _ 0 WTOP _ 0 MOUSEREGION _ 'TEXT THISLINE _ (create THISLINE)
                  PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))

(ACCESSFNS TEXTSTREAM 
           (
            (* ;; 
          "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.")

            (* ;; "The # of characters that have already been read from the current piece")

            (TEXTOBJ (fetch (STREAM F3) of DATUM)
                   (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE))
                                                             (* ; 
                                                             "The TEXTOBJ that is editing this text")
            (PIECE (fetch (STREAM F5) of DATUM)
                   (REPLACE (STREAM F5) OF DATUM WITH NEWVALUE))
                                                             (* ; 
                                   "The PIECE we're currently fetching chars from/putting chars into")
            (PCCHARSLEFT (fetch (STREAM F1) of DATUM)
                   (replace (STREAM F1) of DATUM with NEWVALUE))
                                                             (* ; 
                                                             "Runs from PLEN to 0: piece exhausted")
            (NIL)                                            (* ; "Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ.")
            (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM)
                   (replace (STREAM IMAGEDATA) of DATUM with NEWVALUE))
                                                             (* ; "THIS IS SOMEHOW INVOLVED IN STYLES, NOT SENSIBLE. REMOVE? The PARALOOKS that is currently applicable to characters being taken from the stream. This was  the only residual field of TEXTIMAGEDATA, now gone.")
            (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM)
                   (replace (STREAM F4) OF DATUM with NEWVALUE))
                                                             (* ; "Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting.")
            (STARTINGCOFFSET (fetch (STREAM F2) of DATUM)
                   (replace (STREAM F2) of DATUM with NEWVALUE)))
           [TYPE? (AND (type? STREAM DATUM)
                       (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM]
           (CREATE (create STREAM
                          BINABLE _ NIL
                          BOUTABLE _ NIL
                          ACCESS _ 'BOTH
                          USERCLOSEABLE _ T
                          USERVISIBLE _ T
                          DEVICE _ \TEDITFDEV
                          F1 _ NIL
                          F2 _ 0
                          F3 _ NIL
                          F4 _ NIL
                          F5 _ NIL
                          MAXBUFFERS _ 10
                          IMAGEOPS _ \TEDITIMAGEOPS
                          IMAGEDATA _ NIL)))
)

(/DECLAREDATATYPE 'PIECE
       '(POINTER (BITS 4)
               POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG 
               FLAG XPOINTER BYTE POINTER)
       '((PIECE 0 POINTER)
         (PIECE 0 (BITS . 3))
         (PIECE 2 POINTER)
         (PIECE 4 POINTER)
         (PIECE 6 POINTER)
         (PIECE 8 POINTER)
         (PIECE 10 FULLXPOINTER)
         (PIECE 12 POINTER)
         (PIECE 14 POINTER)
         (PIECE 14 (FLAGBITS . 0))
         (PIECE 16 POINTER)
         (PIECE 16 (FLAGBITS . 0))
         (PIECE 16 (FLAGBITS . 16))
         (PIECE 16 (FLAGBITS . 32))
         (PIECE 18 XPOINTER)
         (PIECE 20 (BITS . 7))
         (PIECE 22 POINTER))
       '24)

(/DECLAREDATATYPE 'TEXTOBJ
       '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER 
               POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
               POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG
               POINTER FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG
               POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG
               POINTER POINTER POINTER)
       '((TEXTOBJ 0 POINTER)
         (TEXTOBJ 2 POINTER)
         (TEXTOBJ 4 POINTER)
         (TEXTOBJ 6 POINTER)
         (TEXTOBJ 8 POINTER)
         (TEXTOBJ 10 POINTER)
         (TEXTOBJ 12 POINTER)
         (TEXTOBJ 14 POINTER)
         (TEXTOBJ 16 POINTER)
         (TEXTOBJ 16 (FLAGBITS . 0))
         (TEXTOBJ 16 (FLAGBITS . 16))
         (TEXTOBJ 18 POINTER)
         (TEXTOBJ 20 POINTER)
         (TEXTOBJ 22 POINTER)
         (TEXTOBJ 24 POINTER)
         (TEXTOBJ 26 POINTER)
         (TEXTOBJ 28 POINTER)
         (TEXTOBJ 30 POINTER)
         (TEXTOBJ 32 POINTER)
         (TEXTOBJ 34 POINTER)
         (TEXTOBJ 36 POINTER)
         (TEXTOBJ 38 POINTER)
         (TEXTOBJ 40 POINTER)
         (TEXTOBJ 42 POINTER)
         (TEXTOBJ 44 POINTER)
         (TEXTOBJ 44 (FLAGBITS . 0))
         (TEXTOBJ 46 FULLXPOINTER)
         (TEXTOBJ 48 POINTER)
         (TEXTOBJ 50 POINTER)
         (TEXTOBJ 52 POINTER)
         (TEXTOBJ 54 POINTER)
         (TEXTOBJ 56 POINTER)
         (TEXTOBJ 56 (FLAGBITS . 0))
         (TEXTOBJ 58 POINTER)
         (TEXTOBJ 58 (FLAGBITS . 0))
         (TEXTOBJ 58 (FLAGBITS . 16))
         (TEXTOBJ 58 (FLAGBITS . 32))
         (TEXTOBJ 58 (FLAGBITS . 48))
         (TEXTOBJ 60 POINTER)
         (TEXTOBJ 62 POINTER)
         (TEXTOBJ 64 POINTER)
         (TEXTOBJ 66 POINTER)
         (TEXTOBJ 68 POINTER)
         (TEXTOBJ 70 POINTER)
         (TEXTOBJ 70 (FLAGBITS . 0))
         (TEXTOBJ 70 (FLAGBITS . 16))
         (TEXTOBJ 72 POINTER)
         (TEXTOBJ 74 FULLXPOINTER)
         (TEXTOBJ 76 POINTER)
         (TEXTOBJ 78 POINTER)
         (TEXTOBJ 80 POINTER)
         (TEXTOBJ 82 POINTER)
         (TEXTOBJ 84 POINTER)
         (TEXTOBJ 86 POINTER)
         (TEXTOBJ 88 POINTER)
         (TEXTOBJ 88 (FLAGBITS . 0))
         (TEXTOBJ 88 (FLAGBITS . 16))
         (TEXTOBJ 90 POINTER)
         (TEXTOBJ 92 POINTER)
         (TEXTOBJ 94 POINTER))
       '96)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS NEXTPIECE MACRO ((PC)
                           (ffetch (PIECE NEXTPIECE) of PC)))

(PUTPROPS PREVPIECE MACRO ((PC)
                           (ffetch (PIECE PREVPIECE) of PC)))

(PUTPROPS PLEN MACRO ((PC)
                      (ffetch (PIECE PLEN) of PC)))

(PUTPROPS PLAST MACRO ((PC)
                       (SUB1 (PLEN PC))))

(PUTPROPS PTYPE MACRO ((PC)
                       (ffetch (PIECE PTYPE) of PC)))

(PUTPROPS PCONTENTS MACRO ((PC)
                           (ffetch (PIECE PCONTENTS) of PC)))

(PUTPROPS PCHARLOOKS MACRO ((PC)
                            (ffetch (PIECE PCHARLOOKS) of PC)))

(PUTPROPS PPARALOOKS MACRO ((PC)
                            (ffetch (PIECE PPARALOOKS) of PC)))

(PUTPROPS PPARALAST MACRO ((PC)
                           (ffetch (PIECE PPARALAST) of PC)))

(PUTPROPS PFPOS MACRO ((PC)
                       (ffetch (PIECE PFPOS) of PC)))

(PUTPROPS PBYTELEN MACRO (OPENLAMBDA (PC)
                           (ITIMES (ffetch (PIECE PLEN) of PC)
                                  (ffetch (PIECE PBYTESPERCHAR) of PC))))

(PUTPROPS PNEW MACRO ((PC)
                      (ffetch (PIECE PNEW) of PC)))

(PUTPROPS PBYTESPERCHAR MACRO ((PC)
                               (ffetch (PIECE PBYTESPERCHAR) of PC)))

(PUTPROPS POBJ MACRO ((PC)
                      (ffetch (PIECE POBJ) of PC)))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE)
                       (replace (PIECE FIELD) of PC with NEWVALUE)))

(PUTPROPS FSETPC MACRO ((PC FIELD NEWVALUE)
                        (freplace (PIECE FIELD) of PC with NEWVALUE)))

(PUTPROPS GETPC MACRO ((PC FIELD)
                       (fetch (PIECE FIELD) of PC)))

(PUTPROPS FGETPC MACRO ((PC FIELD)
                        (ffetch (PIECE FIELD) of PC)))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS THINPIECEP MACRO ((PC)

                            (* ;; "Assume that objects start out thin, for  CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care.")

                            (SELECTC (PTYPE PC)
                                (THIN.PTYPES T)
                                (UTF8.PTYPE (EQ 1 (FGETPC PC PBYTESPERCHAR)))
                                NIL)))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS VISIBLEPIECEP MACRO [(PC)
                               (AND PC (NEQ 0 (PLEN PC))
                                    (NOT (FGETCLOOKS (PCHARLOOKS PC)
                                                CLINVISIBLE])

(PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC)
                                     (find NPC inpieces (AND PC (NEXTPIECE PC))
                                        suchthat (VISIBLEPIECEP NPC))))

(PUTPROPS \PREV.VISIBLE.PIECE MACRO ((PC)
                                     (find PPC backpieces (AND PC (PREVPIECE PC))
                                        suchthat (VISIBLEPIECEP PPC))))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS GETTOBJ MACRO ((TOBJ FIELD)
                         (fetch (TEXTOBJ FIELD) of TOBJ)))

(PUTPROPS SETTOBJ MACRO ((TOBJ FIELD NEWVALUE)
                         (replace (TEXTOBJ FIELD) of TOBJ with NEWVALUE)))

(PUTPROPS FGETTOBJ MACRO ((TOBJ FIELD)
                          (ffetch (TEXTOBJ FIELD) of TOBJ)))

(PUTPROPS FSETTOBJ MACRO ((TOBJ FIELD NEWVALUE)
                          (freplace (TEXTOBJ FIELD) of TOBJ with NEWVALUE)))

(PUTPROPS TEXTLEN MACRO ((TOBJ)
                         (ffetch (TEXTOBJ TEXTLEN) of TOBJ)))

(PUTPROPS TEXTSEL MACRO ((TEXTOBJ)
                         (SELECTION! (GETTOBJ TEXTOBJ SEL))))

(PUTPROPS TEXTOBJ! MACRO ((TOBJ)
                          (\DTEST TOBJ 'TEXTOBJ)))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS GETTSTR MACRO ((TSTR FIELD)
                         (fetch (TEXTSTREAM FIELD) of TSTR)))

(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE)
                         (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))

(PUTPROPS FGETTSTR MACRO ((TSTR FIELD)
                          (ffetch (TEXTSTREAM FIELD) of TSTR)))

(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE)
                          (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))

(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR)
                              (AND (\DTEST TSTR 'STREAM)
                                   (TEXTOBJ! (FGETTSTR TSTR TEXTOBJ))
                                   TSTR)))
)

(RPAQQ PTYPES
       ((THINFILE.PTYPE 0)
        (FATFILE2.PTYPE 2)
        (THINSTRING.PTYPE 3)
        (FATSTRING.PTYPE 4)
        (SUBSTREAM.PTYPE 5)
        (OBJECT.PTYPE 6)
        (LOOKS.PTYPE 7)
        (UTF16BE.PTYPE 8)
        (UTF16LE.PTYPE 9)
        (UTF8.PTYPE 11)
        (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
        (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
        (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
        (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
        (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE))))
(DECLARE%: EVAL@COMPILE 

(RPAQQ THINFILE.PTYPE 0)

(RPAQQ FATFILE2.PTYPE 2)

(RPAQQ THINSTRING.PTYPE 3)

(RPAQQ FATSTRING.PTYPE 4)

(RPAQQ SUBSTREAM.PTYPE 5)

(RPAQQ OBJECT.PTYPE 6)

(RPAQQ LOOKS.PTYPE 7)

(RPAQQ UTF16BE.PTYPE 8)

(RPAQQ UTF16LE.PTYPE 9)

(RPAQQ UTF8.PTYPE 11)

(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))

(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))

(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))

(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))

(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE))


(CONSTANTS (THINFILE.PTYPE 0)
       (FATFILE2.PTYPE 2)
       (THINSTRING.PTYPE 3)
       (FATSTRING.PTYPE 4)
       (SUBSTREAM.PTYPE 5)
       (OBJECT.PTYPE 6)
       (LOOKS.PTYPE 7)
       (UTF16BE.PTYPE 8)
       (UTF16LE.PTYPE 9)
       (UTF8.PTYPE 11)
       (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
       (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
       (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
       (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
       (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE)))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
)

(* "END EXPORTED DEFINITIONS")

)

(/DECLAREDATATYPE 'PIECE
       '(POINTER (BITS 4)
               POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG 
               FLAG XPOINTER BYTE POINTER)
       '((PIECE 0 POINTER)
         (PIECE 0 (BITS . 3))
         (PIECE 2 POINTER)
         (PIECE 4 POINTER)
         (PIECE 6 POINTER)
         (PIECE 8 POINTER)
         (PIECE 10 FULLXPOINTER)
         (PIECE 12 POINTER)
         (PIECE 14 POINTER)
         (PIECE 14 (FLAGBITS . 0))
         (PIECE 16 POINTER)
         (PIECE 16 (FLAGBITS . 0))
         (PIECE 16 (FLAGBITS . 16))
         (PIECE 16 (FLAGBITS . 32))
         (PIECE 18 XPOINTER)
         (PIECE 20 (BITS . 7))
         (PIECE 22 POINTER))
       '24)

(/DECLAREDATATYPE 'TEXTOBJ
       '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER 
               POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
               POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG
               POINTER FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG
               POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG
               POINTER POINTER POINTER)
       '((TEXTOBJ 0 POINTER)
         (TEXTOBJ 2 POINTER)
         (TEXTOBJ 4 POINTER)
         (TEXTOBJ 6 POINTER)
         (TEXTOBJ 8 POINTER)
         (TEXTOBJ 10 POINTER)
         (TEXTOBJ 12 POINTER)
         (TEXTOBJ 14 POINTER)
         (TEXTOBJ 16 POINTER)
         (TEXTOBJ 16 (FLAGBITS . 0))
         (TEXTOBJ 16 (FLAGBITS . 16))
         (TEXTOBJ 18 POINTER)
         (TEXTOBJ 20 POINTER)
         (TEXTOBJ 22 POINTER)
         (TEXTOBJ 24 POINTER)
         (TEXTOBJ 26 POINTER)
         (TEXTOBJ 28 POINTER)
         (TEXTOBJ 30 POINTER)
         (TEXTOBJ 32 POINTER)
         (TEXTOBJ 34 POINTER)
         (TEXTOBJ 36 POINTER)
         (TEXTOBJ 38 POINTER)
         (TEXTOBJ 40 POINTER)
         (TEXTOBJ 42 POINTER)
         (TEXTOBJ 44 POINTER)
         (TEXTOBJ 44 (FLAGBITS . 0))
         (TEXTOBJ 46 FULLXPOINTER)
         (TEXTOBJ 48 POINTER)
         (TEXTOBJ 50 POINTER)
         (TEXTOBJ 52 POINTER)
         (TEXTOBJ 54 POINTER)
         (TEXTOBJ 56 POINTER)
         (TEXTOBJ 56 (FLAGBITS . 0))
         (TEXTOBJ 58 POINTER)
         (TEXTOBJ 58 (FLAGBITS . 0))
         (TEXTOBJ 58 (FLAGBITS . 16))
         (TEXTOBJ 58 (FLAGBITS . 32))
         (TEXTOBJ 58 (FLAGBITS . 48))
         (TEXTOBJ 60 POINTER)
         (TEXTOBJ 62 POINTER)
         (TEXTOBJ 64 POINTER)
         (TEXTOBJ 66 POINTER)
         (TEXTOBJ 68 POINTER)
         (TEXTOBJ 70 POINTER)
         (TEXTOBJ 70 (FLAGBITS . 0))
         (TEXTOBJ 70 (FLAGBITS . 16))
         (TEXTOBJ 72 POINTER)
         (TEXTOBJ 74 FULLXPOINTER)
         (TEXTOBJ 76 POINTER)
         (TEXTOBJ 78 POINTER)
         (TEXTOBJ 80 POINTER)
         (TEXTOBJ 82 POINTER)
         (TEXTOBJ 84 POINTER)
         (TEXTOBJ 86 POINTER)
         (TEXTOBJ 88 POINTER)
         (TEXTOBJ 88 (FLAGBITS . 0))
         (TEXTOBJ 88 (FLAGBITS . 16))
         (TEXTOBJ 90 POINTER)
         (TEXTOBJ 92 POINTER)
         (TEXTOBJ 94 POINTER))
       '96)



(* ;; "The BIN-level functions")

(DEFINEQ

(\TEDIT.TEXTBIN
  [LAMBDA (TSTREAM)

    (* ;; "Edited  9-Apr-2026 00:06 by rmk")

    (* ;; "Edited  7-Apr-2026 09:57 by rmk")

    (* ;; "Edited 13-Oct-2025 17:16 by rmk")

    (* ;; "Edited 21-Oct-2024 00:26 by rmk")

    (* ;; "Edited  3-May-2024 14:57 by rmk")

    (* ;; "Edited 28-Apr-2024 11:30 by rmk")

    (* ;; "Edited 18-Mar-2024 23:34 by rmk")

    (* ;; "Edited  3-Feb-2024 14:27 by rmk")

    (* ;; "Edited  1-Feb-2024 11:44 by rmk")

    (* ;; "Edited  7-Jan-2024 12:00 by rmk")

    (* ;; "Edited 17-Jun-2023 13:47 by rmk")

    (* ;; "Edited  3-May-2023 15:09 by rmk")

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

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

(* ;;; "The BIN slow case for a text stream.  For the fast, binable (THINFILE, THINSTRING) cases, this is called when an end-of-buffer is reached.  If it is not also an end-of-piece, get a new buffer and continue.  Otherwise, get a new piece (which may not be binable).")

(* ;;; "If the stream is not binable (all other piece types) this gets called on every BIN.  Then we start an extra test to distinguish between buffer overflow and piece overflow.")

(* ;;; "The external filepointer (GETFILEPTR, SETFILEPTR) is calculated in characters:  the total number of characters in all previous pieces, plus the characters (based on the offset) in the current piece.")

    (DECLARE (LOCALVARS . T))
    (LET ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM))
          (PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)))
         (PROG1 (if (ffetch (STREAM BINABLE) of TSTREAM)
                    then 
                         (* ;; "The BIN opcode detected a buffer overflow, move either to the next buffer for this piece, or the next piece. The opcode doesn't  manages only COFFSET, so here we have to figure out what4 PCCHARSOFFSET should have been.  NOTE: PCCHARSOFFSET cannot be changed in the stream unless the STARTINGCOFFSET is also bumped to the COFFSET.")

                         (* ;; "The COFFSET goes from 0 to CBUFFSIZE--when it is = to CBUFSIZE we get an overflow.  That maps to 0 in the next buffer.  When we come here in that case, we haven't actually read that characte.")

                         [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM
                                                                                          COFFSET)
                                                                                    of TSTREAM)
                                                                           (ffetch (TEXTSTREAM 
                                                                                      STARTINGCOFFSET
                                                                                          )
                                                                              of TSTREAM] 
                                                             (* ; "1-byte characters")
                         (if (\ENDOFPIECEP PCCHARSLEFT)
                             then 
                                  (* ;; "Move to next piece.  EOF handled below")

                                  (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC)
                                                  0))
                           else 
                                (* ;; "Set up for the next buffer in the same piece. We want to set it for the next unread character. We don't SUB1 because the character hasn't yet been read.")

                                (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT))
                         (CL:IF PC
                             (BIN TSTREAM)
                             (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM))
                  else 
                       (* ;; 
 "Not binable, more complicated return values.  Opcode kicked out, didn't test for buffer overflow .")

                       (CL:WHEN (\ENDOFBUFFERP TSTREAM)

                           (* ;; "Buffer overflow. Installers replace PCCHARSLET")

                           (if (\ENDOFPIECEP PCCHARSLEFT)
                               then (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC)
                                                    0))
                             else (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)))
                       (if (NOT PC)
                           then (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM)
                         elseif (ffetch (STREAM BINABLE) of TSTREAM)
                           then 
                                (* ;; "We are here because BIN punted.  If it punted because it reached the end of a binable piece, then we have just advanced to the next piece.  If it's binnable, then try running the opcode on the new situation.  If it punted because we were not working on a binnable piece then and we are looking at one now, then again we must have advanced.")

                                (BIN TSTREAM)
                         else (add (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)
                                   -1)                       (* ; 
                                                      "Where we will be when the operation completes")
                              (SELECTC (PTYPE PC)
                                  (FATSTRING.PTYPE           (* ; 
                                                        "This counts offset in characters, not bytes")
                                       (PROG1 (\GETBASEFAT (ffetch (STREAM CBUFPTR) of TSTREAM)
                                                     (ffetch (STREAM COFFSET) of TSTREAM))
                                           (add (ffetch (STREAM COFFSET) of TSTREAM)
                                                1)))
                                  (FATFILE2.PTYPE 
                                       (PROG1 (create WORD
                                                     HIBYTE _ (BIN (PCONTENTS PC))
                                                     LOBYTE _ (BIN (PCONTENTS PC)))
                                           (add (ffetch (STREAM COFFSET) of TSTREAM)
                                                2)
                                           (CL:WHEN (\ENDOFBUFFERP TSTREAM)
                                               (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ffetch
                                                                                   (TEXTSTREAM 
                                                                                          PCCHARSLEFT
                                                                                          )
                                                                                     of TSTREAM)))))
                                  (OBJECT.PTYPE 
                                                (* ;; 
              "Return the object as BIN's result, and make sure we'll go to the next page next time.")

                                                (* ;; 
                    "OBJECTBYTE is for callers (like COMPARETEXT) that can't deal with image objects")

                                                (PROG1 (OR (GETTEXTPROP (ffetch (TEXTSTREAM TEXTOBJ)
                                                                           of TSTREAM)
                                                                  'OBJECTBYTE)
                                                           (PCONTENTS PC))
                                                    (add (ffetch (STREAM COFFSET) of TSTREAM)
                                                         1)))
                                  (UTF8.PTYPE (PROG1 (UTF8.BINCODE (PCONTENTS PC))
                                                  (add (ffetch (STREAM COFFSET) of TSTREAM)
                                                       (PBYTESPERCHAR PC))
                                                  (CL:WHEN (\ENDOFBUFFERP TSTREAM)
                                                      (\TEDIT.INSTALL.FILEBUFFER TSTREAM
                                                             (ffetch (TEXTSTREAM PCCHARSLEFT)
                                                                of TSTREAM)))))
                                  (THINFILE.PTYPE            (* ; 
                                             "Fall through when the underlying stream is not binable")
                                       (PROG1 (BIN (PCONTENTS PC))
                                           (add (ffetch (STREAM COFFSET) of TSTREAM)
                                                1)
                                           (CL:WHEN (\ENDOFBUFFERP TSTREAM)
                                               (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ffetch
                                                                                   (TEXTSTREAM 
                                                                                          PCCHARSLEFT
                                                                                          )
                                                                                     of TSTREAM)))))
                                  (PROGN 

                                 (* ;; "For pieces not listed because they require more work. Assumes the function updates COFFSET and that multi-byte characters are safe: don't cross buffer boundaries.")

                                         (\TEDIT.THELP "\TEXTBIN UNKNOWN PTYPE" (PTYPE PC])

(\TEDIT.TEXTPEEKBIN
  [LAMBDA (TSTREAM NOERROR)                                  (* ; "Edited  9-Apr-2026 00:06 by rmk")
                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")
                                                             (* ; "Edited 19-Mar-2024 19:14 by rmk")
                                                             (* ; "Edited 16-Mar-2024 12:44 by rmk")
                                                             (* ; "Edited  1-Feb-2024 11:13 by rmk")
                                                             (* ; "Edited  9-Aug-2022 10:19 by rmk")
                                                             (* ; "Edited  7-Aug-2022 23:53 by rmk")

    (* ;; "Return the next character (object) without advancing TSTREAM.  This may involve moving to the next file buffer or even the next piece.  But there is no need to back out that advance, the new position just anticipates what would happen with any following operations.  What is important, however, is to make sure that the backing stream for file pieces is left at its original position and thus remains consistent with TSTREAM's parameters.")

    (DECLARE (LOCALVARS . T))
    (LET ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM))
          (PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))
          PCONTENTS)
         (if (ffetch (STREAM BINABLE) of TSTREAM)
             then 
                  (* ;; "Buffered pieces:  thin file or thin string.  ")

                  (CL:WHEN (\ENDOFBUFFERP TSTREAM)           (* ; 
                                       "Buffer overflow. Recover piece status from buffer parameters")
                      [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET
                                                                                             )
                                                                                 of TSTREAM)
                                                                        (ffetch (TEXTSTREAM 
                                                                                      STARTINGCOFFSET
                                                                                       ) of TSTREAM]
                      (if (\ENDOFPIECEP PCCHARSLEFT)
                          then (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC)
                                               0))           (* ; "Also at  piece end")
                        else (\TEDIT.INSTALL.FILEBUFFER TSTREAM (SUB1 PCCHARSLEFT)))) 

                  (* ;; "TSTREAM is now set up for the next character, possibly for the first byte of the next piece or buffer.  That's OK, no need to restore the old ones.")

           elseif (\ENDOFPIECEP PCCHARSLEFT)
             then 
                  (* ;; "Not binnable so the BIN opcode always punts.  If no chars left, we advance the stream to the next piece, which may also set up the buffer for file pieces.  For file streams, the  backing stream is properly positioned, and we only have to restore it to its initial position .  For fat strings, the %"buffer%" covers the whole string.  ")

                  (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC)
                                  0)))
         (if PC
             then (if (ffetch (STREAM BINABLE) of TSTREAM)
                      then (\GETBASEBYTE (ffetch (STREAM CBUFPTR) of TSTREAM)
                                  (ffetch (STREAM COFFSET) of TSTREAM))
                    else (SETQ PCONTENTS (PCONTENTS PC))
                         (SELECTC (PTYPE PC)
                             (FATSTRING.PTYPE 
                                  (\GETBASEFAT (ffetch (STREAM CBUFPTR) of TSTREAM)
                                         (ffetch (STREAM COFFSET) of TSTREAM)))
                             (FATFILE2.PTYPE 
                                  (PROG1 (create WORD
                                                HIBYTE _ (BIN PCONTENTS)
                                                LOBYTE _ (\PEEKBIN PCONTENTS))
                                         (\BACKFILEPTR PCONTENTS)))
                             (OBJECT.PTYPE 
                                           (* ;; 
              "Return the object as BIN's result, and make sure we'll go to the next page next time.")

                                           (* ;; 
                    "OBJECTBYTE is for callers (like COMPARETEXT) that can't deal with image objects")

                                           (OR (GETTEXTPROP (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
                                                      'OBJECTBYTE)
                                               PCONTENTS))
                             (UTF8.PTYPE (UTF8.PEEKCCODEFN PCONTENTS))
                             (SUBSTREAM.PTYPE                (* ; "A substream stored as an object")
                                  (\PEEKBIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
                             (\TEDIT.THELP "UNKNOWN PIECE TYPE")))
           elseif NOERROR
             then NIL
           else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])

(\TEDIT.TEXTBACKFILEPTR
  [LAMBDA (TSTREAM)                                          (* ; "Edited  9-Apr-2026 00:07 by rmk")
                                                             (* ; "Edited 16-Feb-2026 08:54 by rmk")
                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")
                                                             (* ; "Edited  1-Feb-2024 11:25 by rmk")
                                                             (* ; "Edited  5-Jan-2024 17:57 by rmk")
                                                             (* ; "Edited 28-Dec-2023 13:34 by rmk")
                                                             (* ; "Edited 23-Dec-2023 12:19 by rmk")
                                                             (* ; "Edited 15-Oct-2023 12:08 by rmk")
                                                             (* ; "Edited 22-Sep-2023 10:11 by rmk")
                                                             (* ; "Edited 17-Jun-2023 13:47 by rmk")
                                                             (* ; "Edited  3-May-2023 15:05 by rmk")
                                                             (* ; "Edited 12-Oct-2022 15:26 by rmk")
                                                             (* ; "Edited 28-Mar-94 15:32 by jds")

    (* ;; "BACKFILEPTR of a text stream backs over a character.")

    (LET ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM))
          (PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))
          PPC)
         (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM)

             (* ;; "The stream was keeping track of BINS, we have to recalibrate.")

             [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET)
                                                                        of TSTREAM)
                                                               (ffetch (TEXTSTREAM STARTINGCOFFSET)
                                                                  of TSTREAM])

         (* ;; "Back the offset one character's worth of bytes")

         (CL:WHEN (if (\STARTOFPIECEP TSTREAM PCCHARSLEFT)
                      then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC))
                                                             (* ; 
                                                    "Back up to last char of previous piece, if any.")
                               (\TEDIT.INSTALL.PIECE TSTREAM PPC (PLAST PPC))
                               (SETQ PC PPC))
                    elseif (AND (MEMB (PTYPE PC)
                                      FILE.PTYPES)
                                (\STARTOFBUFFERP TSTREAM))
                      then 
                           (* ;; "Must be a buffered file, needs to back up 1 character (not bytes) ")

                           (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ADD1 PCCHARSLEFT))
                    else 
                         (* ;; 
                    "This piece can be backed up at least one character's worth of bytes, back it up")

                         (ADD (ffetch (STREAM COFFSET) of TSTREAM)
                              (CL:IF (MEMB (PTYPE PC)
                                           FILE.PTYPES)
                                  (IMINUS (PBYTESPERCHAR PC))
                                  -1)) 

                         (* ;; "If not binable, PCCHARSLEFT is maintained here.")

                         (CL:UNLESS (ffetch (STREAM BINABLE) of TSTREAM)
                             (freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with (ADD1 PCCHARSLEFT)))
                         T)

             (* ;; "We have now backed up to a piece that has at least one character. We are supposed to return the character we backed over.  These special cases are copied from \TEXTPEEKBIN.")

             (SELECTC (PTYPE PC)
                 (THINFILE.PTYPE 
                      (\PEEKBIN (PCONTENTS PC)))
                 (THINSTRING.PTYPE 
                      (\GETBASEBYTE (ffetch (STREAM CBUFPTR) of TSTREAM)
                             (ffetch (STREAM COFFSET) of TSTREAM)))
                 (FATSTRING.PTYPE 
                      (\GETBASEFAT (ffetch (STREAM CBUFPTR) of TSTREAM)
                             (ffetch (STREAM COFFSET) of TSTREAM)))
                 (FATFILE2.PTYPE 
                      (PROG1 (LOGOR (LLSH (BIN (PCONTENTS PC))
                                          8)
                                    (\PEEKBIN (PCONTENTS PC)))
                          (\BACKFILEPTR (PCONTENTS PC))))
                 (OBJECT.PTYPE 
                               (* ;; 
              "Return the object as BIN's result, and make sure we'll go to the next page next time.")

                               (* ;; 
                    "OBJECTBYTE is for callers (like COMPARETEXT) that can't deal with image objects")

                               (OR (GETTEXTPROP (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
                                          'OBJECTBYTE)
                                   (PCONTENTS PC)))
                 (UTF8.PTYPE (UTF8.PEEKCCODEFN (PCONTENTS PC)))
                 (SUBSTREAM.PTYPE                            (* ; "A substream stored as an object")
                      (BIN (IMAGEOBJPROP (PCONTENTS PC)
                                  'SUBSTREAM)))
                 (\TEDIT.THELP "UNKNOWN PIECE TYPE")))])

(\TEDIT.TEXTBOUT
  [LAMBDA (TSTREAM CHAR)                                     (* ; "Edited 20-Apr-2025 13:24 by rmk")
                                                             (* ; "Edited 28-Mar-2025 10:13 by rmk")
                                                             (* ; "Edited 17-Nov-2024 10:05 by rmk")
                                                             (* ; "Edited  6-Sep-2024 13:06 by rmk")
                                                             (* ; "Edited 27-Aug-2024 14:50 by rmk")
                                                             (* ; "Edited 13-Aug-2024 08:28 by rmk")
                                                             (* ; "Edited 25-Jun-2024 11:59 by rmk")
                                                             (* ; "Edited 22-May-2024 21:02 by rmk")
                                                             (* ; "Edited 18-May-2024 18:56 by rmk")
                                                             (* ; "Edited 10-May-2024 22:37 by rmk")
                                                             (* ; "Edited  8-May-2024 22:51 by rmk")
                                                             (* ; "Edited 17-Mar-2024 11:59 by rmk")
                                                             (* ; "Edited 15-Mar-2024 14:38 by rmk")
                                                             (* ; "Edited 23-Dec-2023 12:14 by rmk")
                                                             (* ; "Edited 18-Oct-2023 21:14 by rmk")
                                                             (* ; "Edited 17-Jun-2023 12:18 by rmk")
                                                             (* ; "Edited 23-Feb-2023 15:26 by rmk")
                                                             (* ; "Edited 12-Aug-2022 23:26 by rmk")
                                                             (* ; "Edited 10-May-93 16:59 by jds")

    (* ;; "Do BOUT to a text stream, which is an insertion at the caret.")

    (* ;; "Unlike EOL's that are typed in at \TEDIT.INSERT, EOL's here don't create paragraph breaks.  We would get a new piece after every line of an image stream")

    (* ;; "ADD1 to convert from %"byte%" indexing to TEDIT selection-indexing.")

    (* ;; "Seems foolish to use \TEXTGETFILEPTR here to map from the current piece to the absolute character index, just so \INSERTCH can map backwards from the character number to the piece.")

    (* ;; 
 "NOTE:  This does not replace the character, it inserts in front.  Perhaps calls TEDIT.RPLCHARCODE?")

    (CL:UNLESS (OR (\CHARCODEP CHAR)
                   (IMAGEOBJP CHAR))
           (\ILLEGAL.ARG CHAR))
    (PROG [(TEXTOBJ (FTEXTOBJ TSTREAM))
           (CHNO (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM]
          (CL:WHEN [OR (FGETTOBJ TEXTOBJ TXTREADONLY)
                       (AND (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
                            (ILESSP CHNO (FGETTOBJ TEXTOBJ TEXTLEN]
                                                             (* ; "The generic GETSTREAM missed this, because a textstream that isn't BOTH can't even be filled in.  Although perhaps OPENTEXTSTREAM can fill in the stream, then reset the access bit if that's what the props say.")
              (ERROR "FILE NOT OPEN" TSTREAM)
              (RETURN))
          (if (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN))
              then (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR)    (* ; 
                                                             "Replace in the middle, add at the end")
            elseif (AND (\TEDIT.INSERTCH CHAR CHNO TEXTOBJ (MEMB CHAR (FGETTOBJ TEXTOBJ 
                                                                             PARABREAKCHARS)))
                        (\TEDIT.PRIMARYPANE TEXTOBJ))
              then (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION CHNO 1))

     (* ;; ";; We inserted 1 char.  Whether or not we introduced a new piece or extended an old one, we want to be positioned so that the next BOUT will insert after this one (if nothing else is changed). Do this after potential redisplay, in case the BINS in reformatting change the position.")

     (* ;; "If the selection points to a later character, should the selection be updated, so it selects the same characters?")

          (\TEDIT.TEXTSETFILEPTR TSTREAM CHNO)
          (CL:WHEN NIL (FSETTOBJ TEXTOBJ CARETLOOKS OLDCARETLOOKS))
      CHAR])

(\TEDIT.INSTALL.FILEBUFFER
  [LAMBDA (TSTREAM PCCHARSLEFT)                              (* ; "Edited 21-Oct-2024 00:26 by rmk")
                                                             (* ; "Edited 18-Mar-2024 22:01 by rmk")
                                                             (* ; "Edited 17-Mar-2024 19:37 by rmk")
                                                             (* ; "Edited 28-Dec-2023 17:53 by rmk")
                                                             (* ; "Edited  7-Dec-2023 16:10 by rmk")
                                                             (* ; "Edited  8-Sep-2023 10:40 by rmk")
                                                             (* ; "Edited  8-Sep-2022 14:17 by rmk")
                                                             (* ; "Edited 21-Aug-2022 22:35 by rmk")
                                                             (* ; "Edited  7-Aug-2022 20:35 by rmk")
                                                             (* ; "Edited 31-Jul-2022 20:09 by rmk")

    (* ;; "Sets up the buffer and buffering parameters ofTSTREAM and the underlying PFILE of its piece so that the next BIN wlil return the character PCCHARSLEFT away from the end of the piece.  PCCHARSLEFT is piecewise, STARTINGCOFFSET and other buffering parameters are bufferwise.")

    (* ;; "Called on buffer overflow when the piece itself is not exhausted.  .")

    (* ;; "A binable stream doesn't track the number of 1-byte chars left in this piece, but COFFSET minus STARTINGCOFFSET enables the PCCHARSLEFT to be determined at the end of the buffer.   ")

    (LET* ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM))
           (PFILE (PCONTENTS PC))
           PCBYTESLEFT)
          (CL:UNLESS (MEMB (PTYPE PC)
                           FILE.PTYPES)
              [\TEDIT.THELP "FILE BUFFER FOR NON-FILE PIECE" (LIST PC (\TEDIT.PCTOCH PC (TEXTOBJ
                                                                                         TSTREAM])
          (CL:UNLESS (AND PFILE (\GETSTREAM PFILE 'INPUT T)) (* ; 
                                                   "The file was closed for some reason;  reopen it.")
              (SETQ PFILE (\TEDIT.REOPEN.STREAM TSTREAM PFILE)))
          (CL:UNLESS PCCHARSLEFT                             (* ; "First character of the piece")
              (SETQ PCCHARSLEFT (PLEN PC)))

          (* ;; "PCBYTESLEFT is the number of bytes already covered so that PCCHARSLEFT characters are left in the piece.")

          (SETQ PCBYTESLEFT (ITIMES (IDIFFERENCE (PLEN PC)
                                           PCCHARSLEFT)
                                   (PBYTESPERCHAR PC)))

          (* ;; "Set PFILE to the byte position of the next character of this piece, establishing the PFILE buffer, offset")

          (\SETFILEPTR PFILE (IPLUS (PFPOS PC)
                                    PCBYTESLEFT))
          (\PEEKBIN PFILE T)

          (* ;; 
    "PFILE's buffer parameters should now be good; steal the fields needed to simulate that stream. ")

          (* ;; 
   "The TSTREAM buffersize is reduced so that it only covers bytes that remain in the current piece.")

          (freplace (STREAM CPPTR) of TSTREAM with (ffetch (STREAM CPPTR) of PFILE))
          (freplace (STREAM CBUFSIZE) of TSTREAM with (IMIN (IPLUS (ffetch (STREAM COFFSET)
                                                                      of PFILE)
                                                                   (IDIFFERENCE (PBYTELEN PC)
                                                                          PCBYTESLEFT))
                                                            (ffetch (STREAM CBUFSIZE) of PFILE)))
          (freplace (STREAM COFFSET) of TSTREAM with (ffetch (STREAM COFFSET) of PFILE))
          (freplace (TEXTSTREAM STARTINGCOFFSET) of TSTREAM with (fetch (STREAM COFFSET) of TSTREAM))
          (freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with PCCHARSLEFT])
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS \ENDOFPIECEP MACRO ((PCLEFT)
                              (ILEQ PCLEFT 0)))

(PUTPROPS \STARTOFPIECEP MACRO ((TSTREAM PCLEFT)
                                (IEQP (PLEN (ffetch (TEXTSTREAM PIECE) of TSTREAM))
                                      PCLEFT)))

(PUTPROPS \ENDOFBUFFERP MACRO ((TSTREAM)
                               (IGEQ (ffetch (STREAM COFFSET) of TSTREAM)
                                     (ffetch (STREAM CBUFSIZE) of TSTREAM))))

(PUTPROPS \STARTOFBUFFERP MACRO ((TSTREAM)
                                 (ILEQ (ffetch (STREAM COFFSET) of TSTREAM)
                                       (ffetch (TEXTSTREAM STARTINGCOFFSET) of TSTREAM))))
)
)



(* ;; "External format functions:  equivalent to BIN-level except for COUNTP")

(DEFINEQ

(\TEDIT.TEXTOUTCHARFN
  [LAMBDA (TSTREAM CHARCODE)                                 (* ; "Edited 17-Mar-2024 11:12 by rmk")
                                                             (* ; "Edited 18-Oct-2023 21:05 by rmk")
                                                             (* ; "Edited 22-Jul-2022 19:05 by rmk")
                                                            (* ; "Edited 12-Oct-2021 15:38 by rmk:")

    (* ;; "OUTCHARFN for TEXTSTREAM  -- BOUTs the  16-bit CHARCODE (via \TEXTBOUT), because TEdit streams deal in complete charcodes rather than bytes.  Updates the CHARPOSITION of the stream, which is used by some code to decide things.")

    (COND
       ((EQ CHARCODE (CHARCODE EOL))
        (\TEDIT.TEXTBOUT TSTREAM (CHARCODE CR))
        (freplace (STREAM CHARPOSITION) of TSTREAM with 0))
       (T (\TEDIT.TEXTBOUT TSTREAM CHARCODE)
          (freplace (STREAM CHARPOSITION) of TSTREAM with (PROGN 
                                                             (* ; "Ugh.  Don't overflow")
                                                                 (IPLUS16 (ffetch (STREAM 
                                                                                         CHARPOSITION
                                                                                         )
                                                                             of TSTREAM)
                                                                        1])

(\TEDIT.TEXTINCCODEFN
  [LAMBDA (STREAM COUNTP)                                    (* ; "Edited 31-Jan-2024 16:34 by rmk")
                                                             (* ; "Edited  7-Aug-2022 22:25 by rmk")
                                                             (* ; "Edited 22-Jul-2022 18:47 by rmk")
                                                            (* ; "Edited  6-Aug-2021 15:57 by rmk:")

(* ;;; "Returns a 16 bit character code.  ")

(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to 1, since we only read 1 16-bit %"byte%".")

    (DECLARE (USEDFREE *BYTECOUNTER*))
    (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
    (BIN STREAM])

(\TEDIT.TEXTBACKCCODEFN
  [LAMBDA (STREAM COUNTP)                                    (* ; "Edited 17-Mar-2024 11:11 by rmk")
                                                             (* ; "Edited 22-Jul-2022 19:01 by rmk")
                                                             (* ; "Edited 19-Jul-2022 17:12 by rmk")
                                                            (* ; "Edited 13-Aug-2021 14:08 by rmk:")
    (DECLARE (USEDFREE *BYTECOUNTER*))
    (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
    (\TEDIT.TEXTBACKFILEPTR STREAM])

(\TEDIT.TEXTFORMATBYTESTREAM
  [LAMBDA (STREAM BYTESTREAM)                                (* ; "Edited 24-Apr-2025 23:49 by rmk")
                                                             (* ; "Edited 21-Oct-2024 00:26 by rmk")
                                                             (* ; "Edited 19-Mar-2024 16:13 by rmk")
                                                            (* ; "Edited 24-Jun-2021 16:47 by rmk:")

    (* ;; "BYTESTREAM might come in with a textstream external format, but that's presumably a mistake.  If STREAM is a text stream, then it traffics in MCCS characters, it's format should be relatively vanilla.")

    (\TEDIT.THELP "TEXT FORMATBYTESTREAM?")
    (REPLACE (STREAM CHARSET) OF BYTESTREAM WITH (FETCH (STREAM CHARSET) OF STREAM])

(\TEDIT.TEXTFORMATBYTESTRING
  [LAMBDA (TSTREAM STRING SCRATCHSTREAM)                     (* ; "Edited 24-Apr-2025 23:50 by rmk")
                                                             (* ; "Edited 19-Mar-2024 18:22 by rmk")

    (* ;; "The FORMATBYTESTRINGFN for Text streams.  STRING is presumably in internal MCCS character codes, and those are the codes that TSTREAM will match against, independent of however its backing stream characters might be encoded.  So we can just return STRING")

    (MKSTRING STRING])
)



(* ;; "High-level stream operations")

(DEFINEQ

(OPENTEXTSTREAM
  [LAMBDA (TEXT WINDOW START/PROPS END PROPS)

    (* ;; "Edited  2-Dec-2025 17:49 by rmk")

    (* ;; "Edited 25-Sep-2025 21:30 by rmk")

    (* ;; "Edited  9-Sep-2025 22:07 by rmk")

    (* ;; "Edited 17-Feb-2025 08:57 by rmk")

    (* ;; "Edited 30-Jan-2025 11:15 by rmk")

    (* ;; "Edited 10-Jan-2025 11:17 by rmk")

    (* ;; "Edited 21-Nov-2024 00:18 by rmk")

    (* ;; "Edited  1-Sep-2024 09:20 by rmk")

    (* ;; "Edited 30-Jun-2024 16:17 by rmk")

    (* ;; "Edited 10-May-2024 22:42 by rmk")

    (* ;; "Edited 31-Mar-2024 11:43 by rmk")

    (* ;; "Edited 21-Jan-2024 10:31 by rmk")

    (* ;; "Edited 20-Dec-2023 10:47 by rmk")

    (* ;; "Edited 12-Oct-2023 23:44 by rmk")

    (* ;; "Edited 31-Jan-2022 17:25 by rmk: A string TEXT is converted here to a stream")

    (* ;; "Edited  4-May-93 14:38 by jds")

    (* ;; "Create a TEXTSTREAM to describe the segment of TEXT between START and END.  Optionally, connect that to WINDOW for display. This is the user entry for creating a (sub) textstream.  ")

    (* ;; "")

    (* ;; "If TEXT designates a file, we want to make sure that the file exists and can be opened before bothering the user to do anything else (like define a window region).  ")

    (* ;; "")

    (* ;; "If TEXT is already a text stream, that stream and its text are reused.  But if START and/or END are non-NIL, the pieces before START and after END are deleted from the given text stream.  (An alternative interpretation would be to create a new textstream and insert characters from START to END into it.)")

    (* ;; "")

    (* ;; "If the WINDOW argument is non-NIL, this is responsible for reusing or creating a window and associating it with the text.  To avoid needless user interaction, we ask for a region and create the window after we have been able to open the text stream. But we do the other Tedit window initiallization after the textstream and textobj have been populated.  Note that we do need to make sure the TEXTOBJ exists before we actually get the file, so that the window and its promptwindow are available for messages as the file is read.")

    (* ;; "")

    (* ;; " Finally, WINDOW is passed as T (e.g. from TEDIT) to say that a region must be obtained for a required window.")

    (CL:WHEN (EQ 0 (NCHARS TEXT))                            (* ; 
                                           "Empty string means empty document, not illegal file name")
        (SETQ TEXT NIL))
    (RESETLST
        (LET ((TSTREAM (TEXTSTREAM TEXT T))
              TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE START)
             (DECLARE (SPECVARS TEDIT.GET.FINISHEDFORMS))    (* ; 
                 "Undocumented, but available for special-purpose actions specified somewhere below.")
             (SETQ START (if (FIXP START/PROPS)
                             then START/PROPS
                           elseif (AND (LISTP START/PROPS)
                                       (NOT (LISTP PROPS)))
                             then (SETQ PROPS START/PROPS)
                                  NIL))
             [if TSTREAM
                 then (SETQ TEXTOBJ (TEXTOBJ TSTREAM))
                      (CL:WHEN (OR START END)                (* ; "Do the end first")
                          (CL:WHEN (AND END (ILESSP END (TEXTLEN TEXTOBJ)))
                              (\TEDIT.DELETEPIECES (\TEDIT.SELPIECES (ADD1 END)
                                                          (TEXTLEN TEXTOBJ)
                                                          TEXTOBJ)
                                     TEXTOBJ))
                          (CL:WHEN (AND START (IGREATERP START 1))
                              (\TEDIT.DELETEPIECES (\TEDIT.SELPIECES 1 (SUB1 START)
                                                          TEXTOBJ)
                                     TEXTOBJ)))
                      (\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
                      (\TEDIT.REOPENTEXTSTREAM TSTREAM)
                      (SETQ WINDOW (if [AND (SETQ PRIMPANE (OPENWP (\TEDIT.PRIMARYPANE TSTREAM)))
                                            (OR (NULL WINDOW)
                                                (EQ WINDOW (CAR (WINDOWPROP PRIMPANE 'TYPED-REGION]
                                       then                  (* ; "Reuse the existing window/region")
                                            PRIMPANE
                                     else (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))
               else (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM PROPS))
                    (SETQ TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ))
                    (if TEXT
                        then                                 (* ; 
                                                             "Verify/open the file before the window")
                             (SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS T))
                             (FSETTOBJ TEXTOBJ TXTFILE TEXT)
                      else 
                           (* ;; "An empty document starts in an MCCS environment")

                           (PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
                                  'CHARENCODING
                                  'MCCS)) 

                    (* ;; "If we swap the window before the pieces, the local promptwindow is availabe for messages and queries. Otherwise, those show up in the system prompt.  But if we do it in the opposite order, we don't know how to estimate the width for the window region.")

                    (CL:WHEN TEXT

                        (* ;; "TEXT is a stream. The fresh TEXTSTREAM is updated to hold that text, ready for window and process attachments.")

                        (\TEDIT.OPENTEXTSTREAM.PIECES TEXT TSTREAM START END PROPS))
                    (CL:WHEN WINDOW                          (* ; 
                                                             "WINDOW is Tedit on call from TEDIT")
                        (SETQ WINDOW (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))]

             (* ;; "We now have all the pieces, even for TEXT=NIL (empty document) case.")

             (CL:WHEN WINDOW                                 (* ; "Connect to the window")
                 (\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS))
             (\TEDIT.OPENTEXTSTREAM.SETUP.SEL TSTREAM)
             (\TEDIT.SCROLL.CARET TSTREAM)
             (CL:UNLESS (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)
                    (TEDIT.PAGEFORMAT TEXTOBJ TEDIT.PAGE.FRAMES))
             (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM))
             (SETFILEPTR TSTREAM (CL:IF (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
                                     -1
                                     0))
             TSTREAM))])

(COPYTEXTSTREAM
  [LAMBDA (ORIGINAL CROSSCOPY)                               (* ; "Edited  5-Oct-2025 10:54 by rmk")
                                                             (* ; "Edited 21-Apr-2025 23:48 by rmk")
                                                             (* ; "Edited  8-Feb-2025 20:10 by rmk")
                                                             (* ; "Edited 12-Jan-2025 12:16 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:41 by rmk")
                                                             (* ; "Edited 16-Mar-2024 10:03 by rmk")
                                                             (* ; "Edited 16-Jan-2024 12:27 by rmk")
                                                             (* ; "Edited 22-Sep-2023 20:48 by rmk")
                                                             (* ; "Edited 18-Sep-2023 08:21 by rmk")
                                                             (* ; "Edited 16-Sep-2023 13:06 by rmk")
                                                             (* ; "Edited 21-Jun-2023 00:02 by rmk")
                                                             (* ; "Edited  7-May-2023 11:42 by rmk")
                                                             (* ; "Edited 25-Apr-2023 18:07 by rmk")
                                                             (* ; "Edited 18-Mar-2023 21:15 by rmk")
                                                             (* ; 
                                                        "Edited 24-Apr-95 12:02 by sybalsky:mv:envos")

    (* ;; "Given a stream, textobj or window, returns a new textstream with the same contents.  CROSSCOPY is a documented argument, but it doesn't control what happens.  It is supposed to force a copy of a file piece to a new underlying source (a string or nodircore piece), so that there is no sharing between the original and the copy so that future edits in one stream are independent and safe even if the original file is deleted or modified by operations on the other stream. But edit operations don't change the source file until the file is saved, and tne you get a new version anyway.  In any event, CROSSCOPY is T in all calls within TEDIT (e.g. for installing edit menus).")

    (LET* ((TSTREAM (TEXTSTREAM ORIGINAL))
           (TEXTOBJ (FTEXTOBJ TSTREAM))
           [NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (APPEND (COPY (FGETTOBJ TEXTOBJ EDITPROPS))
                                                             (for DP in (FGETTOBJ TEXTOBJ DOCPROPS)
                                                                collect (LIST (CAR DP)
                                                                              (COPY (CDR DP]
           (NEWTEXTOBJ (FTEXTOBJ NEWSTREAM)))                (* ; 
                                   "Create an empty textstream into which the pieces can be hammered")
          (for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
             do (SETQ NEWPC (\TEDIT.COPYPIECE PC TSTREAM NEWSTREAM NIL 'COPY))
                (CL:UNLESS NEWPC
                    (CL:IF (EQ OBJECT.PTYPE (PTYPE PC))
                        (ERROR "Image object does not allow copying" (POBJ PC))
                        (ERROR "Piece cannot be copied " PC)))
                (\TEDIT.INSERTPIECE NEWPC NIL NEWTEXTOBJ))
          (FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
          (FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
          (FSETTOBJ NEWTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
          (FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL))
          (FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL))
          (FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET))
          (FSETTOBJ NEWTEXTOBJ TXTPAGEFRAMES (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
          (FSETTOBJ NEWTEXTOBJ TXTPARALOOKSLIST (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST))
          (FSETTOBJ NEWTEXTOBJ TXTCHARLOOKSLIST (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST))
          (FSETTOBJ NEWTEXTOBJ MENUFLG (FGETTOBJ TEXTOBJ MENUFLG))
          NEWSTREAM])

(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))))])

(TXTFILE
  [LAMBDA (TEXTOBJ)                                          (* ; "Edited 13-Jul-2023 19:49 by rmk")
                                                             (* ; "Edited 31-May-91 13:58 by jds")

    (* ;; "This function is for compiled access to the TXTFILE field in RESETSAVE expressions.  But maybe user functions should be able to call it, hence the call to TEXTOBJ")

    (fetch (TEXTOBJ TXTFILE) of (TEXTOBJ TEXTOBJ])
)
(DEFINEQ

(\TEDIT.REOPENTEXTSTREAM
  [LAMBDA (TSTREAM)                                          (* ; "Edited 17-Mar-2024 11:12 by rmk")
                                                             (* ; "Edited 10-Mar-2024 00:36 by rmk")
                                                             (* ; "Edited 22-Jan-2024 10:20 by rmk")

    (* ;; "RMK:  Not sure whether this should operate on any stream, or just (by virtue of its name) a text stream.  I put in the TEXTSTREAMP test.")
                                                             (* ; "Edited 31-May-91 14:18 by jds")
    (SETQ TSTREAM (TEXTSTREAM TSTREAM T))
    (CL:WHEN TSTREAM
        (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
             (SETTOBJ TEXTOBJ EDITFINISHEDFLG NIL)
             (replace (STREAM ACCESS) of TSTREAM with (CL:IF (GETTOBJ TEXTOBJ TXTREADONLY)
                                                          'INPUT
                                                          'BOTH))

             (* ;; "Not sure why these are needed, and not the rest of the Text external format")

             (replace (STREAM STRMBINFN) of TSTREAM with (FUNCTION \TEDIT.TEXTBIN))
             (replace (STREAM STRMBOUTFN) of TSTREAM with (FUNCTION \TEDIT.TEXTBOUT))))
    TSTREAM])

(\TEDIT.OPENTEXTSTREAM.PIECES
  [LAMBDA (TEXT TSTREAM START END PROPS)                     (* ; "Edited  8-Sep-2025 22:05 by rmk")
                                                             (* ; "Edited 29-May-2025 19:02 by rmk")
                                                             (* ; "Edited 26-Apr-2025 12:59 by rmk")
                                                             (* ; "Edited 24-Apr-2025 17:09 by rmk")
                                                             (* ; "Edited 26-Sep-2024 22:27 by rmk")
                                                             (* ; "Edited 20-Mar-2024 10:58 by rmk")
                                                             (* ; "Edited 27-Dec-2023 13:33 by rmk")
                                                             (* ; "Edited 23-Oct-2023 13:47 by rmk")
                                                             (* ; "Edited 28-Sep-2023 10:17 by rmk")
                                                             (* ; "Edited 27-Sep-2023 00:13 by rmk")
                                                             (* ; "Edited 18-Sep-2023 17:15 by rmk")
                                                             (* ; "Edited 17-Sep-2023 15:13 by rmk")
                                                             (* ; "Edited 12-Sep-2023 16:46 by rmk")
                                                             (* ; "Edited  9-Sep-2023 16:41 by rmk")

    (* ;; "Don't set TXTFILE here, because TEDIT.GET still needs it.  WINDOW is available for size information, but it has not yet been setup for TEDIT. ")

    (* ;; "The intent is that the window's promptwindow is available for local messages during the fetch, and the RESETSAVE of PROMPTWINDOW would make even messages to the global promptwindow appear locally.  An example is the mouseconfirm in READIMAGEOBJ that asks whether the imageobj code should be loaded from a given file.  The problem is that the Tedit prompt window is usually just 1 line hight and doesn't automatically grow to show multiple lines, so key information may not be displayed.  If the Tedit prompt grows (and it can be determined when/if it should later shrink), then this feature can be enabled.")

    (RESETLST
        (LET* [(TEXTOBJ (FTEXTOBJ TSTREAM))
               (PWINDOW (GETTOBJ TEXTOBJ PROMPTWINDOW))
               (READONLY (GETTEXTPROP TEXTOBJ 'READONLY]     (* ; 
                                                         "READONLY only after creation, if specified")
              (FSETTOBJ TEXTOBJ TXTREADONLY NIL)
              (FSETTOBJ TEXTOBJ TXTDON'TUPDATE T)            (* ; 
                                                       "Don't display or record histories until done")
              (FSETTOBJ TEXTOBJ TXTHISTORY 'DON'T)
              [if (OR (GETTEXTPROP TEXTOBJ 'CACHE)
                      (NOT (RANDACCESSP TEXT)))
                  then                                       (* ; 
                                    "If the file device isn't random access, cache the file locally.")
                                                             (* ; 
                                                         "Also do this if he asks for a local cache.")
                       (SETQ TEXT (\TEDIT.CACHEFILE TEXT TEXTOBJ START END)) 

                       (* ;; 
 "Since we only copied the relevant part of the file into the cache, the whole file is now relevant.")

                       (SETQ START 0)
                       (SETQ END (GETEOFPTR TEXT))
                else (SETQ START (IMAX 0 (OR START 0)))
                     (SETQ END (IMIN (GETEOFPTR TEXT)
                                     (OR END (GETEOFPTR TEXT]
              (if (OR (GETTEXTPROP TEXTOBJ 'CLEARGET)
                      (GETTEXTPROP TEXTOBJ 'UNFORMATTED?)
                      (GETTEXTPROP TEXTOBJ 'UNFORMATTED)
                      (GETTEXTPROP TEXTOBJ 'PLAINTEXT))
                  then (\TEDIT.GET.UNFORMATTED.FILE TEXT TSTREAM START END PROPS)
                elseif (\TEDIT.GET.FORMATTED.FILE TEXT TSTREAM START END PROPS)
                elseif (\TEDIT.GET.FOREIGN.FILE TEXT TSTREAM START END PROPS)
                else (\TEDIT.GET.UNFORMATTED.FILE TEXT TSTREAM START END))
              (CL:WHEN NIL
                  (EQ :XCCS (STREAMPROP TEXT 'FORMAT))       (* ; "XCCS was read as MCCS")
                  (\TEDIT.CONVERT.MCCSTOXCCS TSTREAM))
              (FSETTOBJ TEXTOBJ TXTREADONLY READONLY)
              (FSETTOBJ TEXTOBJ TXTHISTORY NIL)
              (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
              (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Get))
              (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NIL)))
    TSTREAM])

(\TEDIT.OPENTEXTSTREAM.PROPS
  [LAMBDA (TEXTOBJ PROPS)                                    (* ; "Edited 21-Nov-2024 11:28 by rmk")
                                                             (* ; "Edited 31-Aug-2024 20:21 by rmk")
                                                             (* ; "Edited 30-Aug-2024 14:47 by rmk")
                                                             (* ; "Edited 14-Jul-2024 10:30 by rmk")
                                                             (* ; "Edited 23-Jan-2024 08:36 by rmk")
                                                             (* ; "Edited 22-Sep-2023 21:57 by rmk")
                                                             (* ; "Edited 17-Sep-2023 09:41 by rmk")

    (* ;; "Install the props, with earlier ones overriding the defaults.")

    (* ;; "After this, all values should be retrievable by GETTEXTPROP")

    [PUTTEXTPROPS TEXTOBJ (APPEND PROPS TEDIT.DEFAULT.PROPS `(READTABLE ,TEDIT.READTABLE]
    (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])

(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
  [LAMBDA (TSTREAM)                                          (* ; "Edited 10-Jan-2026 23:53 by rmk")
                                                             (* ; "Edited 21-Apr-2025 20:14 by rmk")
                                                             (* ; "Edited  6-Apr-2025 14:24 by rmk")
                                                             (* ; "Edited 17-Feb-2025 08:56 by rmk")
                                                             (* ; "Edited 25-Nov-2024 14:33 by rmk")
                                                             (* ; "Edited 20-Nov-2024 23:56 by rmk")
                                                             (* ; "Edited 29-Sep-2024 10:51 by rmk")
                                                             (* ; "Edited  7-Jul-2024 11:42 by rmk")
                                                             (* ; "Edited  5-Jul-2024 17:15 by rmk")
                                                             (* ; "Edited 18-May-2024 16:25 by rmk")
                                                             (* ; "Edited 12-May-2024 21:40 by rmk")
                                                             (* ; "Edited 15-Mar-2024 13:38 by rmk")
                                                             (* ; "Edited 29-Apr-2024 12:40 by rmk")
                                                             (* ; "Edited 15-Dec-2023 23:05 by rmk")
                                                             (* ; "Edited 12-Oct-2023 22:48 by rmk")
                                                             (* ; "Edited 17-Sep-2023 12:52 by rmk")
                                                             (* ; "Edited 12-Sep-2023 11:26 by rmk")
                                                             (* ; "Edited  9-Sep-2023 13:43 by rmk")
                                                             (* ; "Edited  1-Sep-2023 23:02 by rmk")

    (* ;; "This sets up the initial SEL for TEXTOBJ according to the SEL PROPS entry.  If SELPROP is NIL, the default is 1-0-LEFT--just before the first character.  This doesn't show the selection--this stream may not yet have a window.")

    (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
           (SEL (TEXTSEL TEXTOBJ))
           SELPROP)
          (CL:UNLESS (AND SEL (GETSEL SEL SET))
              (SETQ SELPROP (GETTEXTPROP TEXTOBJ 'SEL))
              (FSETSEL SEL SET T)
              (\TEDIT.NOSEL TSTREAM)
              (CL:UNLESS (EQ SELPROP 'DON'T)
                  (FSETSEL SEL SELKIND 'CHAR)                (* ; "Default, maybe reset below")
                  (if (type? SELECTION SELPROP)
                      then                                   (* ; 
                                         "We came in with an explicit initial selection.  Set it up.")
                           (\TEDIT.COPYSEL SELPROP SEL)
                    elseif (LISTP SELPROP)
                      then 
                           (* ;; "Default to POINT selection")

                           (FSETSEL SEL SELKIND 'CHAR)
                           (\TEDIT.UPDATE.SEL SEL (CAR SELPROP)
                                  (OR (CADR SELPROP)
                                      0)
                                  (OR (CADDR SELPROP)
                                      'LEFT)
                                  'NORMAL)
                    elseif (FIXP SELPROP)
                      then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT 'NORMAL)
                    elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
                      then 
                           (* ;; "Default to after the last character")

                           (\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
                                  0
                                  'RIGHT
                                  'NORMAL)
                    else 
                         (* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1,  But UPDATE.SEL adds 1 when DCH=0.  That's wrong for the initial caret, so brute-force fix it here.  Maybe it's wrong in general?")

                         (\TEDIT.UPDATE.SEL SEL 1 0 'LEFT 'NORMAL)
                         (FSETSEL SEL CHLIM 1))
                  [FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET)
                                                   then      (* ; 
                                                  "An initial selection implies initial caret looks.")
                                                        (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)
                                                 else (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
                                                             (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS]
                  (CL:WHEN (OR (FGETTOBJ TEXTOBJ TXTREADONLY)
                               (FGETTOBJ TEXTOBJ TXTAPPENDONLY))
                                                             (* ; 
                                                     "Don't blink for read-only, but do highlighting")
                      (FSETSEL SEL HASCARET NIL))
                  (\TEDIT.SHOWSEL SEL T TSTREAM)))
          SEL])

(\TEDIT.OPENTEXTSTREAM.WINDOW
  [LAMBDA (WINDOW TSTREAM PROPS)                             (* ; "Edited 21-Apr-2025 20:14 by rmk")
                                                             (* ; "Edited  6-Apr-2025 14:25 by rmk")
                                                             (* ; "Edited  5-Apr-2025 13:10 by rmk")
                                                             (* ; "Edited 21-Nov-2024 00:18 by rmk")
                                                             (* ; "Edited  1-Sep-2024 09:06 by rmk")
                                                             (* ; "Edited 28-Jun-2024 23:06 by rmk")
                                                             (* ; "Edited 16-Jun-2024 15:40 by rmk")
                                                             (* ; "Edited 13-Jun-2024 17:57 by rmk")
                                                             (* ; "Edited 19-May-2024 00:26 by rmk")
                                                             (* ; "Edited  6-May-2024 21:16 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:06 by rmk")
                                                             (* ; "Edited 15-Mar-2024 14:38 by rmk")
                                                             (* ; "Edited 26-Oct-2023 11:02 by rmk")
                                                             (* ; "Edited 18-Sep-2023 23:22 by rmk")
                                                             (* ; "Edited 17-Sep-2023 11:53 by rmk")

    (* ;; "Associates WINDOW with TSTREAM.  Brute force, doesn't let this window stuff change the fileptr.  Maybe should unsplit all panes if WINDOW is split.")

    (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
          (FILEPTR (\TEDIT.TEXTGETFILEPTR TSTREAM)))
         [if WINDOW
             then (\TEDIT.WINDOW.SETUP WINDOW TSTREAM PROPS)
                  (\TEDIT.NOSEL TSTREAM)
                  (\TEDIT.SHOWSEL NIL T TSTREAM)
                  (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
                      (for PANE inpanes TEXTOBJ do (\TEDIT.UPCARET (GETPANEPROP (PANEPROPS PANE)
                                                                          PCARET))))
                  (\TEDIT.TEXTSETFILEPTR TSTREAM FILEPTR)
           elseif (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW)
             then 
                  (* ;; "There is no window for the session, but he has passed in a promptwindow to use, install it in the textobj")

                  (SETTOBJ TEXTOBJ PROMPTWINDOW (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW]
         (SETTOBJ TEXTOBJ \DIRTY NIL)
         WINDOW])

(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
  [LAMBDA (TEXTOBJ)                                          (* ; "Edited 29-Jul-2025 11:53 by rmk")
                                                             (* ; "Edited 22-Mar-2025 21:37 by rmk")
                                                             (* ; "Edited 26-Apr-2023 14:29 by rmk")

    (* ;; 
 "The default looks must be created before the first piece, so that they can provide field-defaults.")

    (LET (FONT CHARLOOKS PARALOOKS)

         (* ;; "Find the default font for this TEXTOBJ -- either what the guy tells us, the one from TEDIT.DEFAULT.PROPS, or his DEFAULTFONT.")

         (SETQ FONT (OR (GETTEXTPROP TEXTOBJ 'FONT)
                        (FONTCREATE DEFAULTFONT)))

         (* ;; "LOOKS for backward compatibility and compatibility with documentation")

         [SETQ CHARLOOKS (OR (GETTEXTPROP TEXTOBJ 'CHARLOOKS)
                             (GETTEXTPROP TEXTOBJ 'LOOKS]
         (SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
                             (AND (type? CHARLOOKS FONT)
                                  FONT)
                             (\TEDIT.CHARLOOKS.FROM.FONT FONT)))
         (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ))
         (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS)
         (SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS)

         (* ;; "PARALOOKS")

         (SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST (GETTEXTPROP
                                                                                  TEXTOBJ
                                                                                  'PARALOOKS)
                                                           TEDIT.DEFAULT.PARALOOKS)
                                TEXTOBJ))
         (SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])

(\TEDIT.OPENTEXTFILE
  [LAMBDA (TEXT PROPS ERROR)                                 (* ; "Edited 10-May-2026 12:57 by rmk")
                                                             (* ; "Edited  2-Dec-2025 17:49 by rmk")
                                                             (* ; "Edited 16-Sep-2025 00:28 by rmk")
                                                             (* ; "Edited  8-Sep-2025 21:52 by rmk")
                                                             (* ; "Edited 21-Nov-2024 11:38 by rmk")
                                                             (* ; "Edited 20-Dec-2023 10:49 by rmk")
                                                             (* ; "Edited 28-Oct-2023 10:33 by rmk")
                                                             (* ; "Edited 26-Sep-2023 18:00 by rmk")
                                                             (* ; "Edited 24-Sep-2023 23:13 by rmk")
                                                             (* ; "Edited 18-Sep-2023 22:40 by rmk")
                                                             (* ; "Edited 17-Sep-2023 21:29 by rmk")
    (CL:WHEN TEXT
        (if (\GETSTREAM TEXT 'INPUT T)
          elseif [AND (OR (LITATOM TEXT)
                          (STRINGP TEXT)
                          (CL:PATHNAMEP TEXT)
                          (STREAMP TEXT))
                      (CAR (NLSETQ (OPENSTREAM (OR (STREAMP TEXT)
                                                   (AND (CL:PATHNAMEP TEXT)
                                                        (FINDFILE TEXT T))
                                                   (FINDFILE-WITH-EXTENSIONS TEXT NIL 
                                                          *TEDIT-EXTENSIONS*)
                                                   TEXT)
                                          'INPUT
                                          'OLD
                                          `((FORMAT ,(LISTGET PROPS 'FORMAT]
          elseif ERROR
            then (ERROR "File not found:" TEXT)))])

(\TEDIT.CREATE.TEXTSTREAM
  [LAMBDA (PROPS)                                            (* ; "Edited 28-Jul-2025 22:56 by rmk")
                                                             (* ; "Edited  7-Feb-2025 08:09 by rmk")
                                                             (* ; "Edited 16-Mar-2024 09:52 by rmk")
                                                             (* ; "Edited 21-Jan-2024 15:16 by rmk")
                                                             (* ; "Edited 17-Sep-2023 00:38 by rmk")
                                                             (* ; "Edited 12-Sep-2023 11:27 by rmk")

    (* ;; "Creates and initializes an empty, windowless textstream")

    (LET* ((TEXTOBJ (create TEXTOBJ))
           (TSTREAM (create TEXTSTREAM
                           TEXTOBJ _ TEXTOBJ)))
          (SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
          (\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
          (\TEDIT.MAKEPCTB TEXTOBJ)
          (\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
                 0)
          TSTREAM])

(\TEDIT.REOPEN.STREAM
  [LAMBDA (TSTREAM PIECESTREAM)                              (* ; "Edited 14-May-2024 18:00 by rmk")
                                                             (* ; "Edited 16-Mar-2024 10:03 by rmk")
                                                             (* ; "Edited 23-Jan-2024 00:28 by rmk")
                                                             (* ; "Edited  9-Nov-2023 17:05 by rmk")
                                                             (* ; "Edited  8-Sep-2023 00:23 by rmk")
                                                             (* ; "Edited 15-Sep-2022 22:56 by rmk")
                                                             (* ; "Edited 11-Jun-99 15:12 by rmk:")
                                                             (* ; "Edited 15-Apr-93 15:53 by jds")

    (* ;; "Re-open a 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.  If there is a reopen operation that simply smashes the existing stream-datum, we wouldn't have to do the sweep.")

    (LET ((TEXTOBJ (TEXTOBJ TSTREAM))
          NEWSTREAM)
         (CL:UNLESS PIECESTREAM
             (SETQ PIECESTREAM (FGETTOBJ TEXTOBJ TXTFILE)))
         (if (\GETSTREAM PIECESTREAM 'INPUT T)
             then PIECESTREAM
           else [SETQ NEWSTREAM (OPENSTREAM PIECESTREAM 'INPUT NIL
                                       `((TYPE TEXT)
                                         (FORMAT ,(STREAMPROP PIECESTREAM :EXTERNAL-FORMAT] 

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

                (for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) when (EQ (PCONTENTS PC)
                                                                      PIECESTREAM)
                   do (FSETPC PC PCONTENTS NEWSTREAM)) 

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

                (CL:WHEN (EQ (FGETTOBJ TEXTOBJ TXTFILE)
                             PIECESTREAM)
                       (FSETTOBJ TEXTOBJ TXTFILE NEWSTREAM)) 

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

                NEWSTREAM])
)
(DEFINEQ

(\TEDIT.STREAMINIT
  [LAMBDA NIL                                                (* ; "Edited 24-Feb-2026 23:38 by rmk")
                                                             (* ; "Edited 16-Feb-2026 12:40 by rmk")
                                                             (* ; "Edited 26-Jan-2026 16:06 by rmk")
                                                             (* ; "Edited 23-Sep-2025 21:03 by rmk")
                                                             (* ; "Edited 20-Sep-2025 08:48 by rmk")
                                                             (* ; "Edited 18-Sep-2025 14:52 by rmk")
                                                             (* ; "Edited 10-Jul-2025 11:28 by rmk")
                                                             (* ; "Edited 15-Apr-2025 23:10 by rmk")
                                                             (* ; "Edited  4-Sep-2024 22:05 by rmk")
                                                             (* ; "Edited 22-May-2024 14:53 by rmk")
                                                             (* ; "Edited 19-Mar-2024 18:16 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:25 by rmk")
                                                             (* ; "Edited 10-Mar-2024 13:50 by rmk")
                                                             (* ; "Edited  7-Mar-2023 15:01 by rmk")
                                                             (* ; "Edited 28-Aug-2022 22:19 by rmk")
                                                             (* ; "Edited 22-Jul-2022 20:02 by rmk")
                                                             (* ; "Edited  3-Jul-2022 00:34 by rmk")
                                                             (* ; "Edited  5-May-2022 15:12 by rmk")
                                                            (* ; "Edited  7-Oct-2021 08:40 by rmk:")
                                                             (* ; 
                                           "Create the FDEV and STREAM prototypes for TEDIT streams.")

    (* ;; "TEDIT streams make use of the following STREAM fields:")

    (* ;; "(DEVICE (* FDEV of this guy -- The TEDIT device)")

    (* ;; "F1 Number of characters to the end of the current piece")

    (* ;; "F2 Starting offset for the character in this piece end of underlying file's page")

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

    (* ;; "F4 LOOKSUPDATEFN")

    (* ;; "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 \TEDITIMAGEOPS (create IMAGEOPS
                                IMAGETYPE _ 'TEDIT
                                IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION)
                                IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION)
                                IMLEFTMARGIN _ (FUNCTION \TEDIT.TEXTLEFTMARGIN)
                                IMRIGHTMARGIN _ (FUNCTION \TEDIT.TEXTRIGHTMARGIN)
                                IMFONT _ (FUNCTION \TEDIT.TEXTDSPFONT)
                                IMCLOSEFN _ (FUNCTION NILL)
                                IMFONTCREATE _ 'DISPLAY
                                IMLINEFEED _ (FUNCTION \TEDIT.TEXTDSPLINEFEED)
                                IMCHARWIDTH _ (FUNCTION \TEDIT.TEXTDSPCHARWIDTH)
                                IMSTRINGWIDTH _ (FUNCTION \TEDIT.TEXTDSPSTRINGWIDTH)
                                IMSCALE _ [FUNCTION (LAMBDA NIL 1]
                                IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))

    (* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count.  If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed.  But INCCODE wants to go through the BIN opcode")

    (MAKE-EXTERNALFORMAT :TEDIT (FUNCTION \TEDIT.TEXTINCCODEFN)
           (FUNCTION \TEDIT.TEXTPEEKBIN)
           (FUNCTION \TEDIT.TEXTBACKCCODEFN)
           (FUNCTION \TEDIT.TEXTOUTCHARFN)
           (FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
           'CR T (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))

    (* ;; "Support for error handling:  The old error handler for the stream-not-open error.  ")

    (SETQ \TEDITFDEV (create FDEV
                            DEVICENAME _ 'TEDIT
                            RESETABLE _ T
                            RANDOMACCESSP _ T
                            PAGEMAPPED _ NIL
                            GETFILENAME _ (FUNCTION NILL)
                            BIN _ (FUNCTION \TEDIT.TEXTBIN)
                            BOUT _ (FUNCTION \TEDIT.TEXTBOUT)
                            CLOSEFILE _ (FUNCTION \TEDIT.TEXTCLOSEF)
                            OPENFILE _ (FUNCTION \TEDIT.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 \TEDIT.TEXTSETFILEINFO)
                            BACKFILEPTR _ (FUNCTION \TEDIT.TEXTBACKFILEPTR)
                            SETFILEPTR _ (FUNCTION \TEDIT.TEXTSETFILEPTR)
                            PEEKBIN _ (FUNCTION \TEDIT.TEXTPEEKBIN)
                            GETEOFPTR _ (FUNCTION \TEDIT.TEXTGETEOFPTR)
                            SETEOFPTR _ (FUNCTION \TEDIT.TEXTSETEOFPTR)
                            GETFILEPTR _ (FUNCTION \TEDIT.TEXTGETFILEPTR)
                            EOFP _ (FUNCTION \TEDIT.TEXTEOFP)
                            FDBINABLE _ T
                            FDBOUTABLE _ NIL
                            FDEXTENDABLE _ NIL
                            TRUNCATEFILE _ (FUNCTION NILL)
                            WRITEPAGES _ (FUNCTION NILL)
                            DEFAULTEXTERNALFORMAT _ :TEDIT)) (* ; 
                          "Only load once, not every time TEDIT-STREAM is loaded e.g. in development")
    (RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
    (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 (\TEDIT.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])

(TEDIT.IMAGESTREAM.OPEN
  [LAMBDA (FILE OPTIONS)                                     (* ; "Edited 26-Jan-2026 23:55 by rmk")
    (OPENTEXTSTREAM FILE NIL OPTIONS])
)

(ADDTOVAR IMAGESTREAMTYPES (TEDIT (OPENSTREAM TEDIT.IMAGESTREAM.OPEN)
                                  (CREATECHARSET \CREATECHARSET.DISPLAY)))



(* ;; "Is this being used:")

(DEFINEQ

(\TEDIT.TTYBOUT
  [LAMBDA (TSTREAM BYTE)                                     (* ; "Edited 26-Nov-2024 21:18 by rmk")
                                                             (* ; "Edited 24-Jun-2024 00:05 by rmk")
                                                             (* ; "Edited 17-Mar-2024 11:39 by rmk")
                                                             (* ; "Edited 18-Mar-2023 20:08 by rmk")
                                                             (* ; "Edited 31-May-91 14:18 by jds")

    (* ;; "Do BOUT to a text stream, which is an insertion at the caret.")

    (* ;; "IS THIS BEING USED ??  INSTEAD, SPECIAL CASES IN \TEDIT.TEXTOUTCHARFN")

    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
         (if (EQ BYTE ERASECHARCODE)
             then (\TEDIT.CHARDELETE TSTREAM)
           elseif (EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (GETTOBJ TEXTOBJ TXTTERMSA)
                                                                \PRIMTERMSA)
                                                         BYTE)))
           else (\TEDIT.TEXTOUTCHARFN TSTREAM BYTE])
)

(RPAQ? *TEDIT-EXTENSIONS* '(TEDIT TED TXT TEXT BRAVO NIL))



(* ;; "Low-level generic stream operations")

(DEFINEQ

(\TEDIT.TEXTCLOSEF
  [LAMBDA (TSTREAM)                                          (* ; "Edited 16-Mar-2024 10:03 by rmk")
                                                             (* ; "Edited 28-Aug-2023 13:12 by rmk")
                                                             (* ; "Edited 26-Oct-2022 11:17 by rmk")
                                                             (* ; "Edited 22-Aug-2022 14:18 by rmk")
                                                             (* ; "Edited  8-Aug-2022 14:56 by rmk")
                                                             (* ; "Edited 15-Apr-93 16:43 by jds")
                                                             (* ; 
                                                             "Close the files underlying a stream")
    (LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
         (for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) when (AND (MEMB (PTYPE PC)
                                                                      FILE.PTYPES)
                                                                (PCONTENTS PC))
            do (CLOSEF? (PCONTENTS PC)))

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

         (CLOSEF? (GETTOBJ TEXTOBJ TXTFILE])

(\TEDIT.TEXTDSPFONT
  [LAMBDA (TSTREAM NEWFONT)                                  (* ; "Edited 14-Jul-2025 22:57 by rmk")
                                                             (* ; "Edited  5-Jul-2025 18:55 by rmk")
                                                             (* ; "Edited 17-Mar-2024 11:49 by rmk")
                                                             (* ; "Edited 15-Oct-2023 17:13 by rmk")
                                                             (* ; "Edited  8-Sep-2022 14:16 by rmk")
                                                             (* ; "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 TSTREAM)))
         (PROG1 (fetch (CHARLOOKS CLFONT) of (FGETTOBJ TEXTOBJ CARETLOOKS))
             (CL:WHEN NEWFONT
                 (TEDIT.CARETLOOKS TSTREAM (FONTCREATE NEWFONT NIL NIL NIL 'DISPLAY))
                 (for PANE inpanes (PROGN TEXTOBJ) do (DSPFONT NEWFONT PANE))))])

(\TEDIT.TEXTEOFP
  [LAMBDA (TSTREAM)                                          (* ; "Edited 18-Mar-2024 22:43 by rmk")
                                                             (* ; "Edited 23-Dec-2023 11:53 by rmk")
                                                             (* ; "Edited  1-Jun-2023 17:07 by rmk")
                                                             (* ; "Edited 10-Aug-2022 12:41 by rmk")
                                                             (* ; "Edited  5-Aug-2022 16:37 by rmk")
                                                             (* ; "Edited 31-May-91 14:18 by jds")

    (* ;; "Test for EOF on a text stream: At end of a piece, and there are no more pieces (visible or not).  This assumes that there are no zero-length pieces.")

    (OR (ZEROP (FGETTOBJ (TEXTOBJ TSTREAM)
                      TEXTLEN))
        (CL:WHEN (\ENDOFBUFFERP TSTREAM)
            [LET ((PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)))
                 (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM)
                     [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET)
                                                                                of TSTREAM)
                                                                       (ffetch (TEXTSTREAM 
                                                                                      STARTINGCOFFSET
                                                                                      ) of TSTREAM])
                 (AND (\ENDOFPIECEP PCCHARSLEFT)
                      (NULL (NEXTPIECE (fetch (TEXTSTREAM PIECE) of TSTREAM])])

(\TEDIT.TEXTGETEOFPTR
  [LAMBDA (TSTREAM)                                          (* ; "Edited 17-Mar-2024 12:27 by rmk")
                                                             (* ; "Edited 31-May-91 13:58 by jds")
    (GETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
           TEXTLEN])

(\TEDIT.TEXTSETEOFPTR
  [LAMBDA (TSTREAM LEN)                                      (* ; "Edited 20-Apr-2025 23:44 by rmk")
                                                             (* ; "Edited  6-Apr-2025 12:29 by rmk")
                                                             (* ; "Edited 25-Nov-2024 20:13 by rmk")
                                                             (* ; "Edited  7-Jul-2024 11:43 by rmk")
                                                             (* ; "Edited 23-May-2024 08:33 by rmk")

    (* ;; "Eliminate all trailing bytes so the file contains the first LEN characters")

    (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
           (TEXTLEN (TEXTLEN TEXTOBJ))
           (SEL (TEXTSEL TEXTOBJ))
           (TAILSEL (\TEDIT.COPYSEL SEL)))
          (CL:UNLESS (IGEQ LEN TEXTLEN)
              (RESETLST
                  [RESETSAVE (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
                         `(PROGN (PUTTEXTPROP ,TEXTOBJ 'APPEND OLDVALUE]
                  (FSETTOBJ TEXTOBJ TXTAPPENDONLY NIL)
                  (\TEDIT.UPDATE.SEL TAILSEL (ADD1 LEN)
                         (IDIFFERENCE TEXTLEN LEN))
                  (\TEDIT.FIXSEL SEL TSTREAM)
                  (\TEDIT.DELETE TSTREAM TAILSEL)))])

(\TEDIT.TEXTGETFILEPTR
  [LAMBDA (TSTREAM)                                          (* ; "Edited  7-Feb-2025 08:12 by rmk")
                                                             (* ; "Edited  7-May-2024 21:14 by rmk")
                                                             (* ; "Edited 19-Mar-2024 14:19 by rmk")
                                                             (* ; "Edited 17-Mar-2024 00:25 by rmk")
                                                             (* ; "Edited 21-Oct-2023 20:57 by rmk")
                                                             (* ; "Edited  2-Sep-2022 17:45 by rmk")
                                                             (* ; "Edited 30-Jul-2022 00:07 by rmk")
                                                             (* ; "Edited 28-Mar-94 15:32 by jds")

    (* ;; "GETFILEPTR fn for text streams.  Measured in characters (and objects), not 8-bit bytes.")

    (LET ((TEXTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
          (PC (ffetch (TEXTSTREAM PIECE) of TSTREAM))
          PCCHARSLEFT)
         (if (OR (NULL PC)
                 (\SUFFIXPIECEP PC TEXTOBJ))
             then 
                  (* ;; "Not set or off the end")

                  (FGETTOBJ TEXTOBJ TEXTLEN)
           elseif (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
             then 
                  (* ;; "Replace a lingering piece from a delete-everything?")

                  (freplace (TEXTSTREAM PIECE) of TSTREAM with (FGETTOBJ TEXTOBJ SUFFIXPIECE))
                  0
           else                                              (* ; "Somewhere inside the document")
                (SETQ PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))
                (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM)

                    (* ;; "PCCHARSLEFT may lag. If binable, everything is thin, no need to multiply. We don't change anything in TSTREAM")

                    [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET)
                                                                               of TSTREAM)
                                                                      (ffetch (TEXTSTREAM 
                                                                                     STARTINGCOFFSET)
                                                                         of TSTREAM]) 

                (* ;; "-1 to go from TEDIT-selection character-indexing back to nominal %"byte%" positions. SETFILEPTR goes the other way.")

                (IPLUS -1 (\TEDIT.PCTOCH PC TEXTOBJ)
                       (IDIFFERENCE (PLEN PC)
                              PCCHARSLEFT])

(\TEDIT.TEXTSETFILEINFO
  [LAMBDA (TSTREAM ATTRIBUTE VALUE DEVICE)                   (* ; "Edited 22-May-2024 14:58 by rmk")
    (LET ((TEXTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
          SEL)
         (SELECTQ ATTRIBUTE
             (LENGTH                                         (* ; 
                                                             "Delete the tail if LENGTH is shrinking")
                     (\TEDIT.TEXTSETEOFPTR TSTREAM VALUE))
             NIL])

(\TEDIT.TEXTOPENF
  [LAMBDA (TSTREAM ACCESS)                                   (* ; "Edited 16-Mar-2024 10:03 by rmk")
                                                             (* ; "Edited  7-Dec-2023 21:01 by rmk")
                                                             (* ; "Edited 22-Aug-2022 15:16 by rmk")
                                                             (* ; "Edited 31-May-91 13:58 by jds")
                                                             (* ; 
                                                             "Return the stream, opened for input")
    (for PC inpieces (\TEDIT.FIRSTPIECE (TEXTOBJ TSTREAM))
       when [AND (MEMB (PTYPE PC)
                       FILE.PTYPES)
                 (EQ NoBits (fetch (STREAM ACCESSBITS) of (PCONTENTS PC]
       DO (\TEDIT.REOPEN.STREAM TSTREAM (PCONTENTS PC)))
    TSTREAM])

(\TEDIT.TEXTSETEOF
  [LAMBDA (TSTREAM EOFPTR)                                   (* ; "Edited 17-Mar-2024 12:28 by rmk")
                                                             (* ; "Edited 31-May-91 14:19 by jds")
                                                             (* ; 
                                         "Set the EPAGE/EOFFSET of the stream to be (SUB1 of EOFPTR)")
    (replace (STREAM EPAGE) of TSTREAM with (fetch (BYTEPTR PAGE) of EOFPTR))
    (replace (STREAM EOFFSET) of TSTREAM with (fetch (BYTEPTR OFFSET) of EOFPTR])

(\TEDIT.TEXTSETFILEPTR
  [LAMBDA (TSTREAM FILEPOS)                                  (* ; "Edited 20-Apr-2025 00:02 by rmk")
                                                             (* ; "Edited 20-Mar-2024 10:58 by rmk")
                                                             (* ; "Edited 17-Mar-2024 00:27 by rmk")
                                                             (* ; "Edited 23-Dec-2023 12:14 by rmk")
                                                             (* ; "Edited 22-Oct-2023 16:14 by rmk")
                                                             (* ; "Edited  2-Sep-2022 11:34 by rmk")
                                                             (* ; "Edited  8-Aug-2022 23:55 by rmk")
                                                             (* ; "Edited 22-Apr-93 13:44 by jds")
                                                             (* ; 
                                                             "Sets the file ptr for a text stream.")

    (* ;; "FILEPOS is known to be a positive number.  For other filedevices there is no error if the ptr is set beyond the EOF, and GETFILEPTR will return the new position.  But the length of an input file doesn't change and a BIN at any position after the EOF causes the error.  An output file grows.  Filepos is a %"byte%" position, have to add 1 to get to the notion of character in a Tedit selection.")

    (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
          START-OF-PIECE PC CH#)
         (DECLARE (SPECVARS START-OF-PIECE))
         (CL:WHEN (IGREATERP FILEPOS (FGETTOBJ TEXTOBJ TEXTLEN))
                                                             (* ; 
                                    "If the fileptr is not within the text, punt. OR: SET IT TO EOF?")
             (\ILLEGAL.ARG FILEPOS))
         (CL:UNLESS (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
             (SETQ CH# (ADD1 FILEPOS))
             (SETQ PC (\TEDIT.CHTOPC CH# TEXTOBJ T))
             (\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE)))])

(\TEDIT.TEXTDSPXPOSITION
  [LAMBDA (TSTREAM XPOSITION)                                (* ; "Edited 20-Sep-2025 22:48 by rmk")
                                                             (* ; "Edited 25-Jun-2024 11:59 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:15 by rmk")
                                                            (* ; "Edited  3-Jan-2001 17:27 by rmk:")
                                                  (* ; 
                                     "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:")
    (* ;; "This doesn't make much sense for a character-oriented stream like a TEDIT stream.  If the stream is displayed in a window, this returns the window's current position, and changes it as well.  But that doesn't affect or particularly relate to the underlying sequence of characters.")

    (* ;; "If there is no window (an OPENTEXTSTREAM being written on by a printing algorithm, like the pretty printer for source files, this estimates the XPOSITION from the number of characters that have been printed on the line since the last TERPRI (= POSITION), assuming that they are all the width of the space (or the average charwidth).  And if XPOSITION is non-NIL, that is also translated into an estimated number of characters, and spaces are put out to get out to that position (essentially assuming that we are writing at the end of the file).  We can't go backwards.")

    (* ;; "")

    (* ;; "We could be more accurate by reading backwards to the last TERPRI, and not rely on POSITION.  And if we were going backwards, we could think of this as setting the caret position as close as possible to the specified XPOSITION,  But going forward, we still would have to fill in with spaces--and that's the PRETTYPRINT case.")

    (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM))
          SPACEWIDTH CHARPOS NSPACES)                        (* ; 
                                            "If there is no window, estimate from character position")
         (if WINDOW
             then (DSPXPOSITION XPOSITION WINDOW)
           else (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
                                        TSTREAM))
                (SETQ CHARPOS (POSITION TSTREAM))
                (PROG1 (TIMES SPACEWIDTH CHARPOS)
                    (CL:WHEN XPOSITION
                        (SETQ NSPACES (IDIFFERENCE (FIXR (FQUOTIENT XPOSITION SPACEWIDTH))
                                             CHARPOS))
                        (CL:WHEN (IGREATERP NSPACES 0)
                               (SPACES NSPACES TSTREAM))))])

(\TEDIT.TEXTDSPYPOSITION
  [LAMBDA (TSTREAM YPOSITION)                                (* ; "Edited 25-Jun-2024 11:59 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:15 by rmk")
                                                             (* ; "Edited 31-May-91 13:59 by jds")

    (* ;; 
  "Simply returns the YPOSITION of the primary window's display stream, this is a read-only function")

    (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM)))
         (IF WINDOW
             THEN (DSPYPOSITION NIL WINDOW)
           ELSEIF (AND \#DISPLAYLINES (NEQ \CURRENTDISPLAYLINE -1))
             THEN (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE])

(\TEDIT.TEXTLEFTMARGIN
  [LAMBDA (TSTREAM XPOSITION)                                (* ; "Edited 19-Feb-2025 13:39 by rmk")
                                                             (* ; "Edited  8-Feb-2025 17:13 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:30 by rmk")
                                                             (* ; "Edited 31-May-91 14:03 by jds")
    (IPLUS 8 (GETPLOOKS (FGETTOBJ (TEXTOBJ TSTREAM)
                               DEFAULTPARALOOKS)
                    LEFTMAR])

(\TEDIT.TEXTCOLOR
  [LAMBDA (TSTREAM VALUE)                                    (* ; "Edited 22-Apr-2025 15:48 by rmk")
                                                             (* ; "Edited 15-Apr-2025 16:59 by rmk")

    (* ;; "Changes the caret looks, not the document")

    (LET ((CARETLOOKS (FGETTOBJ (FTEXTOBJ TSTREAM)
                             CARETLOOKS)))
         (PROG1 (FGETCLOOKS CARETLOOKS CLCOLOR)
             (CL:WHEN (AND VALUE (NEQ VALUE (FGETCLOOKS CARETLOOKS CLCOLOR)))
                 [TEDIT.CARETLOOKS TSTREAM `(COLOR ,VALUE]))])

(\TEDIT.TEXTRIGHTMARGIN
  [LAMBDA (TSTREAM XPOSITION)                                (* ; "Edited 19-Apr-2025 22:24 by rmk")
                                                             (* ; "Edited 19-Feb-2025 13:39 by rmk")
                                                             (* ; "Edited  8-Feb-2025 22:35 by rmk")
                                                             (* ; "Edited 28-Jun-2024 22:07 by rmk")
                                                             (* ; "Edited 21-Sep-2023 12:38 by rmk")
                                                             (* ; "Edited 31-May-91 14:03 by jds")

(* ;;; "Returns the right margin of the textstream's default paralooks.  If XPOSITION is given, the default looks and the linelength of the string are updated.  ")

    (CL:WHEN XPOSITION                                       (* ; 
                                          "Error if not NIL or greater than 1, implicit NUMBERP test")
        (IGEQ XPOSITION 1))

    (* ;; "If RIGHTMAR is 0 and there is no window (WRIGHT), estimate from the stream's linelength.")

    (* ;; "If \TEDIT.MINIMAL.WINDOW.SETUP sets WRIGHT, maybe that's enough?  I.e. the right margin is either the width of the window or calculated from the LINELENGTH.  It wouldn't depend on the default PARALOOKS or the PARALOOKS of the current piece.")

    (LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
         (if (FGETTOBJ TEXTOBJ PRIMARYPANE)
             then (LET* ((PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
                         (RIGHTMAR (FGETPLOOKS PARALOOKS RIGHTMAR))
                         LEFTMAR NEWPOS)
                        (CL:WHEN (ZEROP RIGHTMAR)
                            (SETQ RIGHTMAR (PANERIGHT (FGETTOBJ TEXTOBJ PRIMARYPANE))))
                        (CL:WHEN (AND XPOSITION (NEQ XPOSITION RIGHTMAR))
                                                             (* ; "Changing the default PARALOOKS")
                            (SETQ LEFTMAR (FGETPLOOKS PARALOOKS LEFTMAR))
                            (CL:WHEN (ILEQ RIGHTMAR LEFTMAR)
                                   (\ILLEGAL.ARG XPOSITION))
                            (FSETTOBJ TEXTOBJ DEFAULTPARALOOKS
                                   (\TEDIT.UNIQUIFY.PARALOOKS (create PARALOOKS
                                                                 using PARALOOKS RIGHTMAR _ XPOSITION
                                                                     )
                                          TEXTOBJ))
                            (LINELENGTH (IQUOTIENT (IDIFFERENCE RIGHTMAR XPOSITION)
                                               (CHARWIDTH (CHARCODE A)
                                                      TSTREAM))
                                   TSTREAM))
                        RIGHTMAR)
           elseif XPOSITION
             then 
                  (* ;; "Even")

                  (LINELENGTH (IQUOTIENT XPOSITION (CHARWIDTH (CHARCODE A)
                                                          TSTREAM))
                         TSTREAM)
           else (TIMES (CHARWIDTH (CHARCODE A)
                              TSTREAM)
                       (LINELENGTH NIL TSTREAM])

(\TEDIT.TEXTDSPCHARWIDTH
  [LAMBDA (TSTREAM CHARCODE)                                 (* ; "Edited 17-Mar-2024 12:23 by rmk")
                                                            (* ; "Edited  9-Feb-99 12:59 by kaplan")
    (CHARWIDTH CHARCODE (\TEDIT.TEXTDSPFONT TSTREAM])

(\TEDIT.TEXTDSPSTRINGWIDTH
  [LAMBDA (TSTREAM STRING)                                   (* ; "Edited 17-Mar-2024 12:32 by rmk")
                                                            (* ; "Edited  9-Feb-99 13:00 by kaplan")
    (STRINGWIDTH STRING (\TEDIT.TEXTDSPFONT TSTREAM])

(\TEDIT.TEXTDSPLINEFEED
  [LAMBDA (TSTREAM VALUE)                                    (* ; "Edited 17-Mar-2024 12:25 by rmk")

    (* ;; "Read only")

    (FONTPROP (\TEDIT.TEXTDSPFONT TSTREAM)
           'HEIGHT])
)



(* ;; "Access by character")

(DEFINEQ

(\TEDIT.NTHCHARCODE
  [LAMBDA (TSTREAM N)                                        (* ; "Edited 15-Feb-2026 14:40 by rmk")
                                                             (* ; "Edited 24-Apr-2025 16:03 by rmk")
                                                             (* ; "Edited 28-Mar-2025 18:31 by rmk")
                                                             (* ; "Edited  7-Jul-2024 11:09 by rmk")
                                                             (* ; "Edited 29-Apr-2024 13:06 by rmk")
                                                             (* ; "Edited 17-Mar-2024 00:27 by rmk")
                                                             (* ; "Edited  1-Feb-2024 09:50 by rmk")
                                                             (* ; "Edited  8-Nov-2023 08:41 by rmk")
                                                             (* ; "Edited  4-Nov-2023 15:23 by rmk")

    (* ;; "Returns the Nth character of TEXTOBJ.  First character is N=1, NIL if out of bounds.  If TSTREAM is a selection, treats it as a substring, N is relative to that.")

    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
          START-OF-PIECE)
         (DECLARE (SPECVARS START-OF-PIECE))
         (CL:WHEN (AND (IGEQ N 1)
                       (ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
             (\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
                    (IDIFFERENCE N START-OF-PIECE)))])

(\TEDIT.PIECE.NTHCHARCODE
  [LAMBDA (PC OFFSET)                                        (* ; "Edited  9-Apr-2026 00:06 by rmk")
                                                             (* ; "Edited 15-Feb-2026 14:31 by rmk")
                                                             (* ; "Edited 24-Apr-2025 16:04 by rmk")
                                                             (* ; "Edited 21-Oct-2024 00:26 by rmk")
                                                             (* ; "Edited 29-Apr-2024 08:46 by rmk")
                                                             (* ; "Edited 22-Mar-2024 00:02 by rmk")
                                                             (* ; "Edited  1-Feb-2024 09:55 by rmk")
                                                             (* ; "Edited  6-Jan-2024 16:36 by rmk")
                                                             (* ; "Edited 29-Dec-2023 11:55 by rmk")
                                                             (* ; "Edited  8-Dec-2023 22:54 by rmk")
                                                             (* ; "Edited  7-Dec-2023 15:57 by rmk")
                                                             (* ; "Edited  8-Nov-2023 08:43 by rmk")
                                                             (* ; "Edited  5-Nov-2023 08:17 by rmk")

    (* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.  OFFSET ranges from 0 to PLEN-1.")

    (CL:WHEN (AND (IGEQ OFFSET 0)
                  (ILESSP OFFSET (PLEN PC)))
        [LET ((PCONTENTS (PCONTENTS PC))
              FILEPOS)
             (SELECTC (PTYPE PC)
                 (STRING.PTYPES (NTHCHARCODE PCONTENTS (ADD1 OFFSET)))
                 (THINFILE.PTYPE 
                      (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
                      (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
                                                    OFFSET))
                      (PROG1 (BIN PCONTENTS)
                             (\SETFILEPTR PCONTENTS FILEPOS)))
                 (FATFILE2.PTYPE 
                      (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
                      (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
                                                    (UNFOLD OFFSET 2)))
                      (PROG1 (\WIN PCONTENTS)
                             (\SETFILEPTR PCONTENTS FILEPOS)))
                 (UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
                             [\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
                                                           (ITIMES OFFSET (PBYTESPERCHAR PC]
                             (PROG1 (UTF8.INCCODEFN PCONTENTS)
                                    (\SETFILEPTR PCONTENTS FILEPOS)))
                 (OBJECT.PTYPE PCONTENTS)
                 (SUBSTREAM.PTYPE                            (* ; "A substream stored as an object")
                      (\TEDIT.THELP 'SUBSTREAM?)
                      (BIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
                 (PROGN 
                        (* ;; "For pieces not listed because they require more work. Assumes the function updates COFFSET and that multi-byte characters are safe: don't cross buffer boundaries.")

                        (\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])

(\TEDIT.RPLCHARCODE
  [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY)   (* ; "Edited 16-Feb-2026 08:37 by rmk")
                                                             (* ; "Edited 24-Apr-2025 17:24 by rmk")
                                                             (* ; "Edited 20-Apr-2025 13:25 by rmk")
                                                             (* ; "Edited 28-Mar-2025 10:04 by rmk")

    (* ;; "Replaces the Nth charcode (or object) in TSTREAM with  NEWCHARCODE (or object) with NEWCHARLOOKS.  ")

    (* ;; "If DONTDISPLAY, this doesn't update the display.  ")

    (* ;; "NOTE:  this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")

    (CL:UNLESS (\TEDIT.READONLY TSTREAM)
        (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
              START-OF-PIECE OLDCHAR)
             (DECLARE (SPECVARS START-OF-PIECE))
             (replace (STREAM BINABLE) of TSTREAM with NIL)
             (SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
                                  (IDIFFERENCE N START-OF-PIECE)
                                  NEWCHARCODE NEWCHARLOOKS))
             (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N 1 NIL NIL 
                                               OLDCHAR))
             (CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
                 (\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
             TSTREAM))])

(\TEDIT.PIECE.RPLCHARCODE
  [LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS)       (* ; "Edited 10-Apr-2026 09:32 by rmk")
                                                             (* ; "Edited 16-Feb-2026 08:41 by rmk")
                                                             (* ; "Edited 28-Jul-2025 23:38 by rmk")
                                                             (* ; "Edited 24-Apr-2025 16:30 by rmk")
                                                             (* ; "Edited 20-Apr-2025 13:25 by rmk")
                                                             (* ; "Edited 28-Mar-2025 10:04 by rmk")

    (* ;; "Replaces the charcode (or object) at OFFSET in PC with NEWCHARCODE (or object) with NEWCHARLOOKS.  This is accomplished by isolating the target character into a length 1 piece, then converting that into a string (or object) piece containing NEWCHAR.")

    (* ;; "Returns OLDCHAR so caller and update history")

    (* ;; "NOTE:  this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")

    (LET (OLDCHAR PARALAST)
         (SETQ PARALAST (MEMB NEWCHARCODE (FGETTOBJ TEXTOBJ PARABREAKCHARS)))
         [if (AND (SMALLP NEWCHARCODE)
                  (MEMB (PTYPE PC)
                        STRING.PTYPES)
                  (OR (NULL NEWCHARLOOKS)
                      (EQ NEWCHARLOOKS (PCHARLOOKS PC)))
                  (NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
                  (NOT PARALAST))
             then 
                  (* ;; 
            "Fast case:  Smash a new character code into an existing string piece with same looks.  ")

                  (SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
                                       (ADD1 OFFSET)))
                  (RPLCHARCODE (PCONTENTS PC)
                         (ADD1 OFFSET)
                         NEWCHARCODE)                        (* ; 
                                                             "May upgrade string from thin to fat")
                  (CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
                                (IGREATERP NEWCHARCODE \MAXTHINCHAR))
                      (FSETPC PC PTYPE FATSTRING.PTYPE)
                      (FSETPC PC PBYTESPERCHAR 2))
           elseif [AND (IMAGEOBJP NEWCHARCODE)
                       (EQ OBJECT.PTYPE (PTYPE PC))
                       (OR (NULL NEWCHARLOOKS)
                           (EQ NEWCHARLOOKS (PCHARLOOKS PC]
             then (SETQ OLDCHAR (POBJ PC))                   (* ; "We know PLEN is 1")
                  (FSETPC PC PCONTENTS NEWCHARCODE)
           else 
                (* ;; 
          "The PC that contained character OFFSET now becomes the suffix of characters after offset.")

                (CL:UNLESS (IEQP OFFSET (PLAST PC))          (* ; "No suffix for the last character")

                    (* ;; 
       "Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")

                    (\TEDIT.SPLITPIECE PC (ADD1 OFFSET)
                           TEXTOBJ)
                    (SETQ PC (PREVPIECE PC)))                (* ; 
                                    "Original PC holds the suffix, new PC ends with change position.")
                (CL:UNLESS (EQ OFFSET 0)
                    (SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
                                    TEXTOBJ)))               (* ; 
                                               "Chop off the prefix. PC is now the singleton target ")

                (* ;; "OFFSET is now isolated into a one-character new piece which we smash.  ")

                (SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 0))
                (if (IMAGEOBJP NEWCHARCODE)
                    then (FSETPC PC PCONTENTS NEWCHARCODE)
                         (FSETPC PC PTYPE OBJECT.PTYPE)
                         (FSETPC PC PBYTESPERCHAR NIL)       (* ; "Doesn't make sense for objects")
                  else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE))) 
                                                             (* ; 
                                              "Use the extend-string in INSERTCH for repeated calls?")
                       (if (IGREATERP NEWCHARCODE \MAXTHINCHAR)
                           then (FSETPC PC PTYPE FATSTRING.PTYPE)
                                (FSETPC PC PBYTESPERCHAR 2)
                         else (FSETPC PC PTYPE THINSTRING.PTYPE)
                              (FSETPC PC PBYTESPERCHAR 1)))
                (FSETPC PC PFPOS NIL)
                (CL:WHEN NEWCHARLOOKS
                    (FSETPC PC PCHARLOOKS (CL:IF (FONTP NEWCHARLOOKS)
                                              (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
                                                                          NEWCHARLOOKS)
                                                     TEXTOBJ)
                                              NEWCHARLOOKS)))]
         (CL:WHEN PARALAST (FSETPC PC PPARALAST T))
         OLDCHAR])

(\TEDIT.NTHCHARLOOKS
  [LAMBDA (TSTREAM N)                                        (* ; "Edited  6-Apr-2025 23:36 by rmk")
                                                             (* ; "Edited  4-Apr-2025 11:11 by rmk")

    (* ;; "Returns the charlooks of character N")

    (PCHARLOOKS (\TEDIT.CHTOPC N (FTEXTOBJ TSTREAM])
)



(* ;; "Editing support")

(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ INSERTSTRINGLENGTH 512)


(CONSTANTS (INSERTSTRINGLENGTH 512))
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS \INSERTCH.EXTENDABLE MACRO [(PREVPC INSERTION INSERTPTYPE)

                                      (* ;; 
                                     "Is INSERTION physcially adjacent to the PCONTENTS of PREVPC ? ")

                                      (AND (EQ INSERTPTYPE (PTYPE PREVPC))
                                           (EQ (ffetch (STRINGP BASE) of INSERTION)
                                               (ffetch (STRINGP BASE) of (PCONTENTS PREVPC)))
                                           (IEQP (IPLUS (PLEN PREVPC)
                                                        (ffetch (STRINGP OFFST) of (PCONTENTS PREVPC)
                                                               ))
                                                 (ffetch (STRINGP OFFST) of INSERTION])
)
)
(DEFINEQ

(\TEDIT.DELETE.SELPIECES
  [LAMBDA (TSTREAM FIRSTCHAR LEN DONTCHECK)                  (* ; "Edited 22-Apr-2025 09:17 by rmk")
                                                             (* ; "Edited  5-Feb-2025 23:33 by rmk")
                                                             (* ; "Edited 26-Nov-2024 22:31 by rmk")
                                                             (* ; "Edited 22-Sep-2024 18:34 by rmk")
                                                             (* ; "Edited  7-Jul-2024 09:09 by rmk")
                                                             (* ; "Edited  7-May-2024 21:14 by rmk")
                                                             (* ; "Edited 17-Mar-2024 00:22 by rmk")
                                                             (* ; "Edited 13-Feb-2024 00:13 by rmk")
                                                             (* ; "Edited 11-Dec-2023 09:51 by rmk")
                                                             (* ; "Edited 21-Oct-2023 23:50 by rmk")
                                                             (* ; "Edited  3-Jun-2023 22:31 by rmk")
                                                            (* ; "Edited 29-Jan-99 17:28 by kaplan")

    (* ;; "Delete LEN characters starting at FIRSTCHAR in TEXTOBJ.  If any of the pieces contains an objecting object, nothing is done.")

    (CL:WHEN (type? SELECTION FIRSTCHAR)
        (CL:UNLESS LEN
            (SETQ LEN (FGETSEL FIRSTCHAR DCH)))
        (SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#)))
    (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
          SELPIECES PREVPC)
         (CL:WHEN [AND (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))
                       (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
                                              TEXTOBJ))
                       (OR DONTCHECK (for PC inselpieces (PROGN SELPIECES)
                                        always (OR (NEQ OBJECT.PTYPE (PTYPE PC))
                                                   (\TEDIT.APPLY.OBJFN (PCONTENTS PC)
                                                          'DELETE TSTREAM]
             (SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST)))
             (\TEDIT.DELETEPIECES SELPIECES TEXTOBJ)

             (* ;; "If the the effect of the deletion is to concatenate a (non-empty) prefix of one paragraph with a (non-empty) suffix of another, propagate the prefix PARALOOKS all the way through to the end of the newly combined paragraph. All the pieces of a paragraph must have the same PARALOOKS.")

             (CL:WHEN (AND PREVPC (NOT (PPARALAST PREVPC)))  (* ; "Retained a non-empty prefix")
                 (for PC (PARALOOKS _ (PPARALOOKS PREVPC)) inpieces (NEXTPIECE PREVPC)
                    do 
                       (* ;; 
                       "(NEXTPIECE PREVPC) is the first retained piece linked in after the deletion")

                       (FSETPC PC PPARALOOKS PARALOOKS) repeatuntil (PPARALAST PC)))
             (\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'END TEXTOBJ)

             (* ;; "")

             (* ;; "The pieces are now properly linked with the proper looks.  SELPIECE holds the deleted pieces needed for undoing.")

             (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Delete FIRSTCHAR
                                               (FGETSPC SELPIECES SPLEN)
                                               NIL NIL NIL SELPIECES))
             T)])

(\TEDIT.INSERTCH
  [LAMBDA (CH CH# TEXTOBJ PARALAST)                          (* ; "Edited 10-Apr-2026 09:46 by rmk")
                                                             (* ; "Edited 26-Jul-2025 21:13 by rmk")
                                                             (* ; "Edited 26-Mar-2025 00:29 by rmk")
                                                             (* ; "Edited 22-Nov-2024 13:48 by rmk")
                                                             (* ; "Edited 22-Sep-2024 12:32 by rmk")
                                                             (* ; "Edited 13-Aug-2024 08:30 by rmk")
                                                             (* ; "Edited 18-May-2024 19:04 by rmk")
                                                             (* ; "Edited  6-May-2024 10:28 by rmk")
                                                             (* ; "Edited 17-Mar-2024 12:41 by rmk")
                                                             (* ; "Edited 21-Jan-2024 14:06 by rmk")
                                                             (* ; "Edited  9-Dec-2023 13:14 by rmk")
                                                             (* ; "Edited 18-Oct-2023 21:16 by rmk")
                                                             (* ; "Edited 15-Oct-2023 15:59 by rmk")
                                                             (* ; "Edited 18-Aug-2023 14:36 by rmk")
                                                             (* ; "Edited  2-Aug-2023 13:12 by rmk")
                                                             (* ; "Edited 25-May-2023 09:14 by rmk")
                                                             (* ; "Edited 23-May-2023 22:44 by rmk")
                                                             (* ; "Edited 25-Oct-2022 12:48 by rmk")

    (* ;; "This inserts CH (a character code or string) into the text just in front of character CH#. After execution the first character of CH will be CH# in the text, the previous CH# char is at CH#+ (NCHARS CH).  If PARALAST, PARALAST will be set for the piece that ends in CH.")

    (* ;; "This is optimized for the common case that the next character to be inserted is at the position one beyond the position of the previously inserted character.")

    (* ;; "   1.  \INSERTCH.INSERTION allocates a string to contain the new character, by chomping the next character from the TEXTOBJ's INSERTSTRING resource.")

    (* ;; "    2.  The insertion will go into a piece at position CH#, and this stores that piece in the HINTPC field of the TEXTOBJ, together with its starting position.  If the next insertion comes immediately have that piece, \CHTOPC can find that piece without searching the BTREE. ")

    (* ;; "     3.  If the piece just before the target is a string piece whose string ends at the position in the same string just before the insertion, then the insertion can be accomplished by extending the string of the previous piece, by adjusting the string offset and length of that piece's string and compensating by shrinking the INSERTIONSTRING resource.")

    (* ;; "")

    (* ;; "The net effect is that typically the target piece is found quickly, and that a sequence of characters that are inserted individually end up in a single string in a single piece (until a paragraph break, or some jumping around that eliminates the string contiguity).")

    (* ;; "")

    (* ;; "In the nonoptimal, atypical case, the next insertion point is unrelated to the last one, a jump to a new place in the stream.  In which case it might be between 2 existing pieces, or it might come in the middle of an existing piece that has to be split.  At that point a new string piece can be introduced to hold the insertion, maybe still sucking from the existing insertion string.")

    (* ;; "")

    (\TEDIT.BTVALIDATE '\TEDIT.INSERTCH 'BEGIN TEXTOBJ)

    (* ;; "")

    [SETQ CH# (MIN CH# (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN]
    (PROG (PREVPC INSERTPTYPE INSERTPC INSERTION (ILEN (CL:IF (type? STRINGP CH)
                                                           (NCHARS CH)
                                                           1)))
          (CL:WHEN (ZEROP ILEN)                              (* ; "Nothing to insert, really!")
              (RETURN))

     (* ;; "")

     (* ;; "Step 1:  Construct the insertion string, presumably chomping the TEXTOBJ resource. May or may not be contiguous with last insertion.")

          (SETQ INSERTION (\TEDIT.INSERTCH.INSERTION CH TEXTOBJ))
          (SETQ INSERTPTYPE (CL:IF (fetch (STRINGP FATSTRINGP) of INSERTION)
                                FATSTRING.PTYPE
                                THINSTRING.PTYPE))

     (* ;; "")

     (* ;; "Step 2:  Find or create a piece with CH#at offset 0. This may involve splitting off an initial substring into a separate previous piece.")

          (SETQ INSERTPC (\TEDIT.ALIGNEDPIECE CH# TEXTOBJ))

     (* ;; "")

     (* ;; "Step 3: Insert the insertion, with luck, just by extending the previous piece, otherwise the insertion goes into its own new previous piece.")

          (FSETTOBJ TEXTOBJ HINTPC NIL)                      (* ; 
                        "The hint has been used, but becomes invalid until the updates are complete.")
          (SETQ PREVPC (PREVPIECE INSERTPC))
          (if (AND PREVPC (\INSERTCH.EXTENDABLE PREVPC INSERTION INSERTPTYPE)
                   (EQ (PCHARLOOKS PREVPC)
                       (FGETTOBJ TEXTOBJ CARETLOOKS))
                   (NOT (PPARALAST PREVPC)))
              then 
                   (* ;; "Heuristic optimization: avoid a new piece if it is clear that won't get us into trouble. We can't append to a paralast candidate piece, because the new material would become part of a new paragraph that may or may not eventually end a different paragraph.")

                   (\TEDIT.INSERTCH.EXTEND PREVPC ILEN TEXTOBJ)
            else (SETQ PREVPC (create PIECE
                                     PTYPE _ INSERTPTYPE
                                     PCONTENTS _ INSERTION
                                     PLEN _ ILEN
                                     PCHARLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS)
                                     PPARALOOKS _ (PPARALOOKS (OR INSERTPC PREVPC))
                                     PNEW _ T))
                 (SELECTC INSERTPTYPE
                     (THINSTRING.PTYPE 
                          (FSETPC PREVPC PBYTESPERCHAR 1))
                     (FATSTRING.PTYPE 
                          (FSETPC PREVPC PBYTESPERCHAR 2))
                     (\TEDIT.THELP "Unexpected PTYPE"))
                 (\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))

     (* ;; "The insertion is done and the pieces are properly integrated into the stream. ")

     (* ;; "")

     (* ;; " Register this event in the TEDIT history.")

          (\TEDIT.INSERTCH.HISTORY TEXTOBJ PREVPC CH# ILEN)

     (* ;; "Finally, as a heuristic for continuous typing, set up the TEXTOBJ hint  to speed up the \CHTOPC piece search if  the next insertion comes just after this one (and this one is not PARALAST). This really doesn't matter for typing, but may make it noticeaby faster for programmatic insertions..")

          (if PARALAST
              then (FSETPC PREVPC PPARALAST T)
            else (FSETTOBJ TEXTOBJ HINTPCSTARTCH# (IPLUS ILEN CH#))
                 (FSETTOBJ TEXTOBJ HINTPC INSERTPC))
          (\TEDIT.BTVALIDATE '\TEDIT.INSERTCH 'END TEXTOBJ)
          (RETURN INSERTPC])

(\TEDIT.INSERTCH.HISTORY
  [LAMBDA (TEXTOBJ PREVPC CH# ILEN)                          (* ; "Edited 22-Sep-2024 18:36 by rmk")
                                                             (* ; "Edited  8-Jun-2023 08:39 by rmk")
                                                             (* ; "Edited 28-May-2023 00:01 by rmk")
                                                             (* ; "Edited 25-May-2023 09:13 by rmk")

    (* ;; "Fix the history to reflect the character/string insertion by extending the event for previous characters in an insertion run.  Backspace removes individual characters, Undo removes the whole sequence.")

    (if (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
        then 
             (* ;; "Maybe the first event after setting the textprop--now's the time to flush")

             (FSETTOBJ TEXTOBJ TXTHISTORY NIL)
             (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
      else (LET ((EVENT (\TEDIT.LASTEVENT TEXTOBJ)))         (* ; "Immediately prior edit event.")
                (CL:UNLESS (type? TEDITHISTORYEVENT EVENT)   (* ; 
                                                             "Don't do composites, fall thru to add.")
                    (SETQ EVENT NIL))
                (if [AND EVENT (EQ PREVPC (GETTH EVENT THFIRSTPIECE))
                         (FMEMB (GETTH EVENT THACTION)
                                '(:Insert :Replace]
                    then 
                         (* ;; "We're continuing a prior insertion, just continue the old history event too. Critical that insertions and replacements save PREVPC as THFIRSTPIECE")

                         (add (GETTH EVENT THLEN)
                              ILEN)
                  else                                       (* ; 
                                           "A new insertion/replacemen requires a new history event.")
                       (if (AND EVENT (EQ (GETTH EVENT THACTION)
                                          :Delete)
                                (IEQP CH# (GETTH EVENT THCH#)))
                           then (SETTH EVENT THACTION :Replace) 
                                                             (* ; 
                                                             "Upgrade the deletion to a replacement")
                                (SETTH EVENT THCH# CH#)
                                (SETTH EVENT THLEN (PLEN PREVPC))
                                (SETTH EVENT THPOINT 'RIGHT)
                                (SETTH EVENT THFIRSTPIECE PREVPC)
                         else 
                              (* ;; "This insertion is unrelated to the previous user action, we push a new event to support undo sequences.")

                              (* ;; "A deletion followed by a first insertion got converted to a replace above. We are now adding a character to the end.  We want to start where it started before, and end one beyond where it ended before.  Why aren't we in the above :Replace case?")

                              (* ;; "In the replace case above, maybe the  PREVPC test isn't right?")

                              (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Insert CH#
                                                                (PLEN PREVPC)
                                                                'RIGHT PREVPC])

(\TEDIT.INSERTEOL
  [LAMBDA (CH CH# TSTREAM)                                   (* ; "Edited 29-Apr-2024 10:46 by rmk")
                                                             (* ; "Edited 17-Mar-2024 11:41 by rmk")
                                                             (* ; "Edited 11-Aug-2023 15:49 by rmk")
                                                             (* ; "Edited  5-May-2023 17:00 by rmk")
                                                             (* ; "Edited 31-May-91 14:00 by jds")

    (* ;; "Handle insertion of EOL and meta-EOL.  The former causes a paragraph break, while the latter doesn't.  Note that inserting a meta-EOL causes the document to become formatted.    \INSERTEOL might add this on to an extendable insertion piece, but a subsequent extension is foreclosed by setting PPARALAST.")

    (* ;; "")

    (PROG [INPC (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM]
          (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
                 (RETURN NIL))
          (CL:UNLESS (OR (FGETTOBJ TEXTOBJ FORMATTEDP)
                         (EQ (CHARCODE EOL)))                (* ; 
               "Inserting a meta-EOL into an unformatted document.  Start by setting up para breaks.")
              (\TEDIT.CONVERT.TO.FORMATTED TSTREAM))
          (SETQ INPC (\TEDIT.INSERTCH (CHARCODE EOL)
                            CH# TEXTOBJ))                    (* ; "Put the EOL in")
          (CL:WHEN (AND (EQ CH (CHARCODE EOL))
                        (PREVPIECE INPC))                    (* ; 
                                    "It's really an EOL, rather than a meta-EOL so do para breaking.")
              (FSETPC (PREVPIECE INPC)
                     PPARALAST T))
          (RETURN INPC])

(\TEDIT.INSERTCH.INSERTION
  [LAMBDA (CH TEXTOBJ)                                       (* ; "Edited 20-Oct-2023 23:57 by rmk")
                                                             (* ; "Edited 15-Oct-2023 14:45 by rmk")
                                                             (* ; "Edited 12-Apr-2023 16:55 by rmk")
                                                             (* ; "Edited 13-Aug-2022 12:48 by rmk")

    (* ;; "Find string-storage that can hold the insertion, and stick it in. Try to chomp from the current INSERTSTRING resource held in the TEXTOBJ, if any.")

    (LET ((INSERTSTRING (FGETTOBJ TEXTOBJ INSERTSTRING))
          LEN FATP INSERTION)
         (if (type? STRINGP CH)
             then (SETQ LEN (ffetch (STRINGP LENGTH) of CH))
                  [SETQ FATP (AND (ffetch (STRINGP FATSTRINGP) of CH)
                                  (for C instring CH never (IGREATERP C \MAXTHINCHAR]
           else (SETQ LEN 1)
                (SETQ FATP (IGREATERP CH \MAXTHINCHAR)))
         [if (AND INSERTSTRING (EQ FATP (fetch (STRINGP FATSTRINGP) of INSERTSTRING))
                  (ILEQ LEN (ffetch (STRINGP LENGTH) of INSERTSTRING)))
             then (SETQ INSERTION (SUBSTRING INSERTSTRING 1 LEN)) 
                                                             (* ; 
                                                          "Chunk it off, keep whatever might be left")
                  (FSETTOBJ TEXTOBJ INSERTSTRING (SUBSTRING INSERTSTRING (ADD1 LEN)
                                                        -1 INSERTSTRING))
           else 
                (* ;; "Allocate a string of the right type, to avoid an extra fattening pass")

                (if (IGREATERP LEN INSERTSTRINGLENGTH)
                    then 
                         (* ;; 
                         "Don't throw out the current cached resource if our new one is already full")

                         (SETQ INSERTION (ALLOCSTRING LEN NIL NIL FATP))
                  else (SETQ INSERTSTRING (ALLOCSTRING INSERTSTRINGLENGTH NIL NIL FATP))
                       (SETQ INSERTION (SUBSTRING INSERTSTRING 1 LEN)) 
                                                             (* ; 
                                        "Let the old one go--we may be starting a new sequential run")
                       (FSETTOBJ TEXTOBJ INSERTSTRING (SUBSTRING INSERTSTRING (ADD1 LEN)
                                                             -1 INSERTSTRING]

         (* ;; "INSERTION can now hold the insertion, smash it in")

         (CL:IF (type? STRINGP CH)
             (RPLSTRING INSERTION 1 CH)
             (RPLCHARCODE INSERTION 1 CH))
         INSERTION])

(\TEDIT.INSERTCH.EXTEND
  [LAMBDA (PC ILEN TEXTOBJ)                                  (* ; "Edited  9-Apr-2026 13:24 by rmk")
                                                             (* ; "Edited 16-Mar-2024 09:56 by rmk")
                                                             (* ; "Edited 21-Jan-2024 14:09 by rmk")
                                                             (* ; "Edited 12-Apr-2023 09:37 by rmk")
                                                             (* ; "Edited  1-Sep-2022 08:26 by rmk")
                                                             (* ; "Edited 30-Aug-2022 11:13 by rmk")
                                                             (* ; "Edited 21-Aug-2022 08:50 by rmk")

    (* ;; "Since INSERTION is physically adjacent to the PCONTENTS of PC, we can smash it on and adjust the lengths above.  We also have to adjust the DLEN for PC in its node.  ")

    (add (PLEN PC)
         ILEN)
    (add (ffetch (STRINGP LENGTH) of (PCONTENTS PC))
         ILEN)
    (add (ffetch (BTSLOT DLEN) of (\FINDSLOT (ffetch (PIECE PTREENODE) of PC)
                                         PC))
         ILEN)
    (\TEDIT.UPDATEPCNODES PC ILEN TEXTOBJ])
)
(DEFINEQ

(\TEDIT.NEXTCHANGEABLE.CHNO
  [LAMBDA (CHNO TEXTOBJ)                                     (* ; "Edited 25-Nov-2024 23:54 by rmk")

    (* ;; "Returns the number of the first visible character at or after CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.")

    (LET ((FIRSTPIECE (\TEDIT.CHTOPC CHNO TEXTOBJ)))
         (find PC inpieces FIRSTPIECE until (GETCLOOKS (PCHARLOOKS PC)
                                                   CLPROTECTED) when (VISIBLEPIECEP PC)
            do (RETURN (if (EQ PC FIRSTPIECE)
                           then CHNO
                         else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ])

(\TEDIT.LASTCHANGEABLE.CHNO
  [LAMBDA (CHNO TEXTOBJ)                                     (* ; "Edited 16-Feb-2026 08:53 by rmk")
                                                             (* ; "Edited 26-Nov-2024 00:00 by rmk")

    (* ;; "Returns the number of the first visible character at or before CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.")

    (LET ((FIRSTPIECE (\TEDIT.CHTOPC CHNO TEXTOBJ)))
         (find PC backpieces FIRSTPIECE until (GETCLOOKS (PCHARLOOKS PC)
                                                     CLPROTECTED) when (VISIBLEPIECEP PC)
            do (RETURN (if (EQ PC FIRSTPIECE)
                           then CHNO
                         else (IPLUS (PLAST PC)
                                     (\TEDIT.PCTOCH PC TEXTOBJ])
)
(DEFINEQ

(\TEDIT.INSTALL.PIECE
  [LAMBDA (TSTREAM PC CHOFFSET)                              (* ; "Edited 26-Apr-2026 23:46 by rmk")
                                                             (* ; "Edited 21-Oct-2024 00:26 by rmk")
                                                             (* ; "Edited 18-May-2024 22:39 by rmk")
                                                             (* ; "Edited  9-May-2024 22:34 by rmk")
                                                             (* ; "Edited 18-Mar-2024 22:26 by rmk")
                                                             (* ; "Edited  1-Feb-2024 00:23 by rmk")
                                                             (* ; "Edited 21-Jan-2024 13:00 by rmk")
                                                             (* ; "Edited  5-Jan-2024 10:30 by rmk")
                                                             (* ; "Edited 28-Dec-2023 10:59 by rmk")
                                                             (* ; "Edited 23-Dec-2023 12:16 by rmk")
                                                             (* ; "Edited  7-Dec-2023 15:46 by rmk")
                                                             (* ; "Edited 26-Nov-2023 20:47 by rmk")
                                                             (* ; "Edited  3-May-2023 15:10 by rmk")
                                                             (* ; "Edited 11-Oct-2022 18:14 by rmk")
                                                             (* ; "Edited  8-Sep-2022 20:46 by rmk")

    (* ;; "Makes PC be the current piece in TSTREAM. set up so that the next character is at CHOFFSET relative to the start of the piece. ")

    (* ;; "SHOULD PARTS OF THIS BE UNINTERRUPTABLE? ")

    (CL:WHEN PC
        (PROG (PCCHARSLEFT (PCONTENTS (PCONTENTS PC))
                     (PLEN (PLEN PC)))

         (* ;; "Install PC in TSTREAM.  ")

              (freplace (TEXTSTREAM PIECE) of TSTREAM with PC)
              (CL:WHEN (ffetch (TEXTSTREAM APPLYLOOKSUPDATEFN) of TSTREAM)

                  (* ;; "Called from \TEDIT.FORMATLINE to update formatting variables at piece boundaries. Otherwise, the call is from one of the external-format functions.  Early versions of the code set CARETLOOKS as pieces were encountered, but it makes more sense for CARETLOOKS to change only by explicit movement of the caret.")

                  (SETQ PC (\TEDIT.FORMATLINE.UPDATELOOKS TSTREAM PC))
                  (CL:UNLESS PC                              (* ; "Invisible to the end?")
                      (RETURN NIL)))

         (* ;; "")

         (* ;; "Now set up for binning.")

              (SETQ PCCHARSLEFT (IDIFFERENCE PLEN CHOFFSET))
              (freplace (STREAM COFFSET) of TSTREAM with 0)
              (SELECTC (PTYPE PC)
                  (FILE.PTYPES 
                               (* ;; "Sets up the buffers and positions the underlying stream.  Unless thinfile, the BIN opcode punts everything.")

                               (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT))
                  (STRING.PTYPES (freplace (STREAM CPPTR) of TSTREAM with (ffetch (STRINGP BASE)
                                                                             of PCONTENTS))
                                 (freplace (STREAM COFFSET) of TSTREAM
                                    with (IPLUS (ffetch (STRINGP OFFST) of PCONTENTS)
                                                CHOFFSET))
                                 (freplace (STREAM CBUFSIZE) of TSTREAM
                                    with (IPLUS (ffetch (STRINGP OFFST) of PCONTENTS)
                                                PLEN)))
                  (OBJECT.PTYPE (freplace (STREAM CBUFSIZE) of TSTREAM with 1))
                  NIL)

         (* ;; "Would work for an ASCII. PTYPE or 1-byte UTF-8, except for MCCS/UNICODE differences.")

              [freplace (STREAM BINABLE) of TSTREAM with (OR (EQ THINFILE.PTYPE (PTYPE PC))
                                                             (EQ THINSTRING.PTYPE (PTYPE PC]
              (freplace (TEXTSTREAM STARTINGCOFFSET) of TSTREAM with (ffetch (STREAM COFFSET)
                                                                        of TSTREAM))
              (freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with PCCHARSLEFT)
              (CL:WHEN (ILESSP PCCHARSLEFT 0)
                     (\TEDIT.THELP "INSTALL.PIECE PCCHARSLEFT LESS THAN 0"))
              (RETURN PC)))])
)



(* ; "Support for TEXTPROP")

(DEFINEQ

(TEXTPROP
  [LAMBDA NARGS                                              (* ; "Edited 30-Jul-2024 12:48 by rmk")
    (CL:UNLESS (IGEQ NARGS 2)
           (\ILLEGAL.ARG NARGS))
    (\TEDIT.TEXTPROP (TEXTOBJ (ARG NARGS 1))
           (ARG NARGS 2)
           (IGEQ NARGS 3)
           (AND (IGEQ NARGS 3)
                (ARG NARGS 3])

(GETTEXTPROP
  [LAMBDA (TSTREAM PROP)                                     (* ; "Edited 30-Jul-2024 12:40 by rmk")

    (* ;; "Gets values for document properties.  ")

    (\TEDIT.TEXTPROP (TEXTOBJ TSTREAM)
           PROP])

(PUTTEXTPROP
  [LAMBDA (TSTREAM PROP VALUE)                               (* ; "Edited 30-Jul-2024 12:41 by rmk")

    (* ;; "Stores VALUE as the PROP value of TSTREAM  ")

    (\TEDIT.TEXTPROP (TEXTOBJ TSTREAM)
           PROP T VALUE])

(GETTEXTPROPS
  [LAMBDA (TSTREAM PROPNAMES)                                (* ; "Edited 30-Jul-2024 12:37 by rmk")
                                                             (* ; "Edited 11-Jul-2024 12:14 by rmk")
    (for PROP (TEXTOBJ _ (TEXTOBJ TSTREAM)) inside PROPNAMES join (LIST PROP (\TEDIT.TEXTPROP TEXTOBJ
                                                                                    PROP])

(PUTTEXTPROPS
  [LAMBDA (TSTREAM PROPS)                                    (* ; "Edited 30-Jul-2024 12:44 by rmk")
                                                             (* ; "Edited 14-Jul-2024 10:27 by rmk")
                                                             (* ; "Edited 11-Jul-2024 12:14 by rmk")

    (* ;; "The %"when%" is to only do the first if there are multiple instances of the same property, so that the first ones take effect, laters ones can act as defaults.  ")

    (* ;; "E.g (FOO T FOO NIL) => T. ")

    (for PTAIL (TEXTOBJ _ (TEXTOBJ TSTREAM)) on PROPS by (CDDR PTAIL)
       when (EQ (CADR PTAIL)
                (LISTGET PROPS (CAR PTAIL))) do (\TEDIT.TEXTPROP TEXTOBJ (CAR PTAIL)
                                                       T
                                                       (CADR PTAIL])

(TEXTPROP.ADD
  [LAMBDA (TSTREAM PROP NEWITEM)                             (* ; "Edited 17-Apr-2025 13:24 by rmk")
    (LET ((OLDITEMS (GETTEXTPROP TSTREAM PROP)))
         (PUTTEXTPROP TSTREAM PROP (CONS NEWITEM OLDITEMS))
         OLDITEMS])

(\TEDIT.TEXTPROP
  [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE)                (* ; "Edited  5-Oct-2025 10:15 by rmk")
                                                             (* ; "Edited 17-Jul-2025 00:19 by rmk")
                                                             (* ; "Edited 16-Feb-2025 23:27 by rmk")
                                                             (* ; "Edited 15-Feb-2025 14:02 by rmk")
                                                             (* ; "Edited 22-Dec-2024 00:23 by rmk")
                                                             (* ; "Edited 23-Nov-2024 09:47 by rmk")
                                                             (* ; "Edited 21-Nov-2024 11:53 by rmk")
                                                             (* ; "Edited 18-Nov-2024 16:37 by rmk")
                                                             (* ; "Edited 15-Nov-2024 18:07 by rmk")
                                                             (* ; "Edited 22-Sep-2024 08:41 by rmk")
                                                             (* ; "Edited 31-Aug-2024 17:56 by rmk")
                                                             (* ; "Edited 29-Aug-2024 12:28 by rmk")
                                                             (* ; "Edited 26-Aug-2024 15:50 by rmk")
                                                             (* ; "Edited 13-Aug-2024 08:27 by rmk")
                                                             (* ; "Edited  5-Aug-2024 16:01 by rmk")
                                                             (* ; "Edited 30-Jul-2024 12:40 by rmk")
                                                             (* ; "Edited 25-Apr-2024 00:00 by rmk")
                                                             (* ; "Edited 21-Sep-2023 09:54 by rmk")
                                                             (* ; "Edited  9-Feb-89 11:20 by jds")

    (* ;; "Internal function for getting/setting properties.  Called by TEXTPROP, GETTEXTPROP, PUTTEXTPROP.  Puts the special code for built-in properties in once place.")

    (TEXTOBJ! TEXTOBJ)
    (SELECTQ PROP
        ((READONLY READ-ONLY) 
             (PROG1 (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
                        (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLYQUIET)
                            'QUIET
                            T))
                 (CL:WHEN SETNEWVALUE
                     (FSETTOBJ TEXTOBJ TXTREADONLY NEWVALUE)
                     (FSETTOBJ TEXTOBJ TXTREADONLYQUIET (EQ 'QUIET NEWVALUE))
                     (\TEDIT.HISTORY.PROP TEXTOBJ T 'OFF))))
        (ACTIVE (PROG1 (FGETTOBJ TEXTOBJ EDITOPACTIVE)
                    (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ EDITOPACTIVE NEWVALUE))))
        (READTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTRTBL)
                       (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTRTBL NEWVALUE))))
        (TERMTABLE (PROG1 (FSETTOBJ TEXTOBJ TXTTERMSA (fetch (TERMTABLEP TERMSA) of NEWVALUE))
                       (CL:IF SETNEWVALUE
                           (FSETTOBJ TEXTOBJ TXTTERMSA (fetch (TERMTABLEP TERMSA) of NEWVALUE)))))
        (BOUNDTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTWTBL)
                        (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTWTBL NEWVALUE))))
        (DON'TUPDATE (PROG1 (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)
                         (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NEWVALUE))))
        (NOTSPLITTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
                           (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE NEWVALUE))))
        (DIRTY (PROG1 (FGETTOBJ TEXTOBJ \XDIRTY)
                   (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ \DIRTY NEWVALUE))))
        (LENGTH (PROG1 (FGETTOBJ TEXTOBJ TEXTLEN)
                    (CL:IF SETNEWVALUE (ERROR "TEXT property LENGTH is read-only"))))
        (APPEND (PROG1 (CL:WHEN (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
                           (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLYQUIET)
                               'QUIET
                               T))
                    (CL:WHEN SETNEWVALUE
                        (FSETTOBJ TEXTOBJ TXTAPPENDONLY NEWVALUE)
                        (FSETTOBJ TEXTOBJ TXTREADONLYQUIET (EQ 'QUIET NEWVALUE))
                        (\TEDIT.HISTORY.PROP TEXTOBJ T 'OFF))))
        (HISTORY (\TEDIT.HISTORY.PROP TEXTOBJ SETNEWVALUE NEWVALUE))
        (PARABREAKCHARS 
             (PROG1 (for C in (FGETTOBJ TEXTOBJ PARABREAKCHARS)
                       collect (SELCHARQ C
                                    (EOL 'EOL)
                                    (LF 'LF)
                                    (CR 'CR)
                                    (FORM 'FORM)
                                    (CHARACTER C)))
                 (CL:WHEN SETNEWVALUE
                     (FSETTOBJ TEXTOBJ PARABREAKCHARS (MKLIST (CHARCODE.DECODE NEWVALUE))))))
        (FILENAME (PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTFILE)
                             (fetch FULLFILENAME of (FGETTOBJ TEXTOBJ TXTFILE)))
                      (CL:WHEN (AND SETNEWVALUE (NEQ NEWVALUE NIL))
                             (ERROR "FILENAME cannot be changed"))))
        (FILESTREAM (PROG1 (FGETTOBJ TEXTOBJ TXTFILE)
                        (CL:WHEN SETNEWVALUE
                            (CL:WHEN (AND NEWVALUE (NOT (type? STREAM NEWVALUE)))
                                   (\ILLEGAL.ARG NEWVALUE))
                            (FSETTOBJ TEXTOBJ TXTFILE NEWVALUE))))
        (PAGEFORMAT (PROG1 (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)
                        (CL:WHEN SETNEWVALUE
                            (CL:UNLESS (type? PAGEREGION NEWVALUE)
                                   (\ILLEGAL.ARG NEWVALUE))
                            (FSETTOBJ TEXTOBJ TXTPAGEFRAMES NEWVALUE))))
        (LOOPFN (PROG1 (FGETTOBJ TEXTOBJ LOOPFN)
                    (CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ LOOPFN NEWVALUE))))
        (CHARFN (PROG1 (FGETTOBJ TEXTOBJ CHARFN)
                    (CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ CHARFN NEWVALUE))))
        (OR (PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS)
                          PROP)
                (CL:WHEN SETNEWVALUE
                    (CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS))
                                                             (* ; 
                                                 "Make sure we have a list to smash, no matter what.")
                        (FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL)))
                    (LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS)
                           PROP NEWVALUE)))
            (PROG1 (GETMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
                          PROP)
                (CL:WHEN SETNEWVALUE
                    (PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
                           PROP NEWVALUE)))])
)
(DEFINEQ

(\TEDIT.TEXTOBJ.PROPNAMES
  [LAMBDA (TEXTOBJ)                                          (* ; "Edited  5-Oct-2025 10:50 by rmk")
                                                             (* ; "Edited  4-Jul-2024 11:08 by rmk")
                                                             (* ; "Edited 30-Jun-2024 09:04 by rmk")

    (* ;; "Stick the user properties at the end with --USERPROPS-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.")

    (LET [[TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ)
                                                                 (SYSRECLOOK1 'TEXTOBJ]
          (EPROPS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X))
          (DPROPS (for X in (fetch (TEXTOBJ DOCPROPS) of TEXTOBJ) collect (CAR X]
         (CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS)
                        (MEMB 'TEXTOBJ INSPECTDONTSORTFIELDS))
             (SETQ EPROPS (SORT EPROPS))
             (SETQ DPROPS (SORT DPROPS)))
         (APPEND TFIELDS (CONS '--EDITPROPS--)
                EPROPS
                (CONS '--DOCPROPS--)
                DPROPS])

(\TEDIT.TEXTOBJ.PROPFETCHFN
  [LAMBDA (TEXTOBJ PROPNAME)                                 (* ; "Edited  4-Jul-2024 11:53 by rmk")
    (if (EQ PROPNAME '--USERPROPS--)
        then '------
      elseif (MEMB PROPNAME (RECORDFIELDNAMES 'TEXTOBJ))
        then (RECORDACCESS PROPNAME TEXTOBJ (OR (RECLOOK 'TEXTOBJ)
                                                (SYRECLOOK1 'TEXTOBJ)
                                                'FETCH))
      else (GETTEXTPROP TEXTOBJ PROPNAME])

(\TEDIT.TEXTOBJ.PROPSTOREFN
  [LAMBDA (TEXTOBJ PROPNAME VALUE)                           (* ; "Edited  4-Jul-2024 11:49 by rmk")
                                                             (* ; "Edited 30-Jun-2024 08:52 by rmk")
    (if (EQ PROPNAME '--USERPROPS--)
      elseif (MEMB PROPNAME (RECORDFIELDNAMES 'TEXTOBJ))
        then (RECORDACCESS PROPNAME TEXTOBJ (OR (RECLOOK 'TEXTOBJ)
                                                (SYRECLOOK1 'TEXTOBJ))
                    'REPLACE VALUE)
      else (PUTTEXTPROP TEXTOBJ PROPNAME VALUE])
)



(* ; "For TEXTOBJ inspection")

(DECLARE%: DONTCOPY 

(ADDTOVAR INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN 
                               \TEDIT.TEXTOBJ.PROPSTOREFN))
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(\TEDIT.STREAMINIT)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA TEXTPROP)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (36166 66043 (\TEDIT.TEXTBIN 36176 . 46078) (\TEDIT.TEXTPEEKBIN 46080 . 51505) (
\TEDIT.TEXTBACKFILEPTR 51507 . 57214) (\TEDIT.TEXTBOUT 57216 . 61833) (\TEDIT.INSTALL.FILEBUFFER 61835
 . 66041)) (66941 71232 (\TEDIT.TEXTOUTCHARFN 66951 . 68507) (\TEDIT.TEXTINCCODEFN 68509 . 69248) (
\TEDIT.TEXTBACKCCODEFN 69250 . 69842) (\TEDIT.TEXTFORMATBYTESTREAM 69844 . 70681) (
\TEDIT.TEXTFORMATBYTESTRING 70683 . 71230)) (71279 83354 (OPENTEXTSTREAM 71289 . 78265) (
COPYTEXTSTREAM 78267 . 82577) (TEDIT.STREAMCHANGEDP 82579 . 82881) (TXTFILE 82883 . 83352)) (83355 
106581 (\TEDIT.REOPENTEXTSTREAM 83365 . 84717) (\TEDIT.OPENTEXTSTREAM.PIECES 84719 . 89647) (
\TEDIT.OPENTEXTSTREAM.PROPS 89649 . 90751) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 90753 . 96203) (
\TEDIT.OPENTEXTSTREAM.WINDOW 96205 . 98996) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98998 . 100937) (
\TEDIT.OPENTEXTFILE 100939 . 103092) (\TEDIT.CREATE.TEXTSTREAM 103094 . 104241) (\TEDIT.REOPEN.STREAM 
104243 . 106579)) (106582 114914 (\TEDIT.STREAMINIT 106592 . 114731) (TEDIT.IMAGESTREAM.OPEN 114733 . 
114912)) (115102 116290 (\TEDIT.TTYBOUT 115112 . 116288)) (116408 138091 (\TEDIT.TEXTCLOSEF 116418 . 
117742) (\TEDIT.TEXTDSPFONT 117744 . 118942) (\TEDIT.TEXTEOFP 118944 . 120699) (\TEDIT.TEXTGETEOFPTR 
120701 . 121024) (\TEDIT.TEXTSETEOFPTR 121026 . 122313) (\TEDIT.TEXTGETFILEPTR 122315 . 125150) (
\TEDIT.TEXTSETFILEINFO 125152 . 125660) (\TEDIT.TEXTOPENF 125662 . 126593) (\TEDIT.TEXTSETEOF 126595
 . 127211) (\TEDIT.TEXTSETFILEPTR 127213 . 129323) (\TEDIT.TEXTDSPXPOSITION 129325 . 132028) (
\TEDIT.TEXTDSPYPOSITION 132030 . 132771) (\TEDIT.TEXTLEFTMARGIN 132773 . 133364) (\TEDIT.TEXTCOLOR 
133366 . 133949) (\TEDIT.TEXTRIGHTMARGIN 133951 . 137240) (\TEDIT.TEXTDSPCHARWIDTH 137242 . 137546) (
\TEDIT.TEXTDSPSTRINGWIDTH 137548 . 137854) (\TEDIT.TEXTDSPLINEFEED 137856 . 138089)) (138129 150363 (
\TEDIT.NTHCHARCODE 138139 . 139665) (\TEDIT.PIECE.NTHCHARCODE 139667 . 143235) (\TEDIT.RPLCHARCODE 
143237 . 144795) (\TEDIT.PIECE.RPLCHARCODE 144797 . 150008) (\TEDIT.NTHCHARLOOKS 150010 . 150361)) (
151410 172285 (\TEDIT.DELETE.SELPIECES 151420 . 155045) (\TEDIT.INSERTCH 155047 . 162852) (
\TEDIT.INSERTCH.HISTORY 162854 . 166318) (\TEDIT.INSERTEOL 166320 . 168145) (\TEDIT.INSERTCH.INSERTION
 168147 . 170984) (\TEDIT.INSERTCH.EXTEND 170986 . 172283)) (172286 173893 (\TEDIT.NEXTCHANGEABLE.CHNO
 172296 . 173011) (\TEDIT.LASTCHANGEABLE.CHNO 173013 . 173891)) (173894 178683 (\TEDIT.INSTALL.PIECE 
173904 . 178681)) (178721 188187 (TEXTPROP 178731 . 179078) (GETTEXTPROP 179080 . 179324) (PUTTEXTPROP
 179326 . 179583) (GETTEXTPROPS 179585 . 180029) (PUTTEXTPROPS 180031 . 180935) (TEXTPROP.ADD 180937
 . 181200) (\TEDIT.TEXTPROP 181202 . 188185)) (188188 190565 (\TEDIT.TEXTOBJ.PROPNAMES 188198 . 189457
) (\TEDIT.TEXTOBJ.PROPFETCHFN 189459 . 189975) (\TEDIT.TEXTOBJ.PROPSTOREFN 189977 . 190563)))))
STOP
