Cleanup the piece datatype, address a few issues

DUMPDB fixed to use ROOTFILENAME vs. NAMEFIELD (U-CASE vs. actual) to retrieve and dump the source file's FILEDATES, so the .DATABASE can be loaded.

.gitignore

@@ -43,6 +43,9 @@ loadups/gitinfo
 *.sysout
 *.SYSOUT
 
+# GITFNS deleted subdirectory
+deleted/**
+
 #compiled code -- leave in for now
 
 # *.lcom

internal/MEDLEY-UTILS

@@ -1,27 +1,29 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "28-Jan-2026 11:03:17" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;3
 26880  
+
(FILECREATED "16-Apr-2026 22:42:51" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;2
 30564  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS MAKE-INDEX-HTMLS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES
-                       MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES RECOMPILE-ONE 
-                       RECMPL COMPILE-SETUP REMAKEFILES)
+      :CHANGES-TO (FNS HCFILES MAKE-EXPORTS-ALL MAKE-INDEX-HTMLS)
+                  (FUNCTIONS REPORT-AND-GO)
+                  (VARS MEDLEY-UTILSCOMS HC-SKIP-EXTENSIONS)
                   (ADVICE TEDIT.PROMPTPRINT)
 
-      :PREVIOUS-DATE "28-Jan-2026 10:46:02" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;1)
+      :PREVIOUS-DATE "16-Apr-2026 22:27:40" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;1
+)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
 
 (RPAQQ MEDLEY-UTILSCOMS

        [(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
-        (VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
+        (VARS HC-SKIP-EXTENSIONS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
         (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
         (FNS HCFILES MAKE-INDEX-HTMLS)
         (PROP FILETYPE MEDLEY-UTILS)
         (ADVISE TEDIT.PROMPTPRINT)
         (FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
+        (FUNCTIONS REPORT-AND-GO)
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
                                                                              (LAMA])
@@ -140,6 +142,12 @@
     (for
 X in
 (OR DIRS MEDLEY-FIX-DIRS) join
 (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T])
 )
 
+(RPAQQ HC-SKIP-EXTENSIONS

+       (PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT WD WIDTHS MEDLEYDISPLAYFONT 
+            PSCFONT ALL DATABASE 1 MD GZ PRESS IP BITMAP EL ELC XFORMS BUGREPORTS SUITE LISTING AWK 
+            DINFOGRAPH HASHFILE BLTCHAR DOC DOCPOINTERS STATUS NOTEFILE ICO ISS BMP PNG PS1 
+            VENUESYSOUT ACE FMC HKB LGC CMD COMMAND HTM SVG XML EXE))
+
 (RPAQQ MEDLEY-FIX-DIRS
 ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
 
 (RPAQQ OKSOURCES
 (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))
@@ -162,15 +170,18 @@
 (DEFINEQ
 
 (MAKE-EXPORTS-ALL

-  [LAMBDA (OUTFILE)
                                        (* ; "Edited  3-Aug-2023 18:34 by frank")


+  [LAMBDA (OUTFILE)
                                          (* ; "Edited 15-Apr-2026 16:42 by mth")


+                                                           (* ; "Edited  3-Aug-2023 18:34 by frank")


                                                            (* ; "Edited  9-Mar-2021 16:11 by larry")

-                                                             (* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/.  Don't know why it does the CORE/RENAME")

-                                                             (* 
-
          "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")

-                                                             (* 
-
                        "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")

-                                                             (* 
-
                                                             "Edited September 29, 1986 by van Melle")

+
+    (* ;; "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/.  Don't know why it does the CORE/RENAME")

+
+    (* ;; "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")

+
+    (* ;; "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")

+
+    (* ;; "Edited September 29, 1986 by van Melle")

+
     (CNDIR (MEDLEYDIR "sources"))
     (LOAD 'FILESETS)
     (GATHEREXPORTS EXPORTFILES (OR OUTFILE "exports.all"])
@@ -204,7 +215,8 @@
 (DEFINEQ
 
 (HCFILES

-  [LAMBDA (BASE REDO SUBSETS)
                                (* ; "Edited 30-Jun-2024 08:27 by lmm")


+  [LAMBDA (BASE REDO SUBSETS)
                                (* ; "Edited 16-Apr-2026 22:42 by mth")


+                                                             (* ; "Edited 30-Jun-2024 08:27 by lmm")


                                                              (* ; "Edited 23-Apr-2024 23:15 by lmm")


                                                              (* ; "Edited 22-Apr-2024 13:22 by lmm")


                                                              (* ; "Edited  5-Feb-2024 12:16 by lmm")


@@ -213,74 +225,116 @@
 
 (* ;;;; "BASE is the root directory. Doesn't replace PDF files except when REDO")

 
-(* ;;; " SUBSETS is some combinsyion og (:YRDY :HYML :PRETTY and INDEX")

+(* ;;; " SUBSETS is some combination of (:YRDY :HYML :PRETTY and INDEX")

 
-    (LET
-     [[DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
-      (PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
-     (FILESLOAD PDFSTREAM SKETCH)
-     (FONTSET 'STANDARD)
-     (while
 DIRLIST
-        do

-        (SETQ BASE (pop
 DIRLIST))
-        (for
 SRCPATH in
 (DIRECTORY (CONCAT BASE "*.*;"))
-           do
 (PROG* [(SRC (UNPACKFILENAME SRCPATH))
-                      [EXT (U-CASE (LISTGET SRC 'EXTENSION]
-                      (DIR (LISTGET SRC 'DIRECTORY))
-                      FRDY LDGP DEST (NOV (PACKFILENAME `(VERSION NIL ,@SRC]
-                     (CL:FORMAT T "Starting on ~a :~%%" SRCPATH)
-                     (CL:WHEN (DIRECTORYNAMEP SRCPATH)
+    (LET* ([DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
+           [PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
+           (DOTEDIT (MEMB 'TEDIT PHASES))
+           (DOPRETTY (MEMB 'PRETTY PHASES)))
+          (FILESLOAD PDFSTREAM SKETCH)
+          (FONTSET 'STANDARD)
+          (while
 DIRLIST
+             do
 (SETQ BASE (pop
 DIRLIST)) 
 
-                         (* ;; "any directory names, push them off and do them in another phase")

+                (* ;; "Breadth-first processing")

 
-                         (CL:UNLESS (OR (STRPOS ">." NOV)
-                                        (INFILEP (CONCAT NOV ".skip")))
-                             (SETQ DIRLIST (NCONC1 DIRLIST SRCPATH)))
-                         (RETURN))
-                     (CL:WHEN 
-                         (MEMB EXT
-                               '(PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT ALL 
-                                     DATABASE))
+                (for
 SRCPATH in
 (DIRECTORY (CONCAT BASE "*.*;"))
+                   do
 (PROG* ((SRC (UNPACKFILENAME SRCPATH))
+                              [EXT (U-CASE (LISTGET SRC 'EXTENSION]
+                              (DIR (LISTGET SRC 'DIRECTORY))
+                              [NAME (U-CASE (LISTGET SRC 'NAME]
+                              [NOV (PACKFILENAME.STRING `(VERSION NIL ,@SRC]
+                              LSFP DEST)
+                             (CL:WHEN (DIRECTORYNAMEP SRCPATH)
 
-                         (* ;; "ignore any of these extensions")

+                                 (* ;; 
+
                                 "any directory names, push them off and do them in another phase")

 
-                         (RETURN))
+                                 (if
 [NOT (OR (STRPOS "<." NOV)
+                                              (CL:SEARCH "<LOADUPS>" NOV :TEST #'CL:CHAR-EQUAL)
+                                              (STRPOS ">." NOV)
+                                              (INFILEP (CONCAT NOV ".skip"]
+                                     then
 (SETQ DIRLIST (NCONC1 DIRLIST SRCPATH))
+                                          (CL:FORMAT T "~&Deferring to later ~a~%%" SRCPATH)
+                                   else
 (CL:FORMAT T "~&Skipping ~a~%%" SRCPATH))
+                                 (RETURN))
 
-               (* ;; 
-
               " doesnt (yet) implement  / to - translattion. .readme should show up as -.readme.")

+                       (* ;; "Fixup files that start with . and have no other extension")

 
-                     (SETQ DEST (CONCAT NOV ".pdf"))
-                     (CL:WHEN (AND (NOT REDO)
-                                   (INFILEP DEST))
-                         (CL:FORMAT T "~a already there~%%" DEST)
-                         (RETURN))
-                     (CL:WHEN (INFILEP (CONCAT DEST ".skip"))
-                         (PRINTOUT T "Explicit .skip " DEST T)
-                         (RETURN))
-                     (if
 (MEMB 'TEDIT PHASES)
-                         then
 (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
-                                           (CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH]
-                                  (if
 (EQ REDO 'TEST)
-                                      then
 (CL:FORMAT T "Testing open ~a..." SRCPATH)
-                                           (CLOSEF? (OPENTEXTSTREAM SRCPATH))
-                                    else
 (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
-                                                                             )
-                                                            (TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL 
-                                                                   NIL 'PDF]
-                                             (PRINT 'FAIL T)))
-                                  (CL:FORMAT T "DONE")))
-                     (CL:WHEN (AND (MEMB 'PRETTY PHASES)
-                                   (MEMB EXT '(NIL IL))
-                                   [SETQ LSFP (CAR (NLSETQ (LISPSOURCEFILEP SRCPATH]
-                                   (NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*))
-                         (PRINTOUT T "PDF printing " " to " DEST "...")
-                         (OR (NLSETQ (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST))
-                                            (PRETTYFILEINDEX SRCPATH NIL STR)))
-                             (PRINT 'FAIL T))
-                         (PRINTOUT T "DONE" T))])
+                             (CL:WHEN (AND (NULL EXT)
+                                           (EQ (CHCON1 NAME)
+                                               (CHARCODE %.)))
+                                 (SETQ EXT (SUBATOM NAME 2)))
+                             (CL:WHEN (MEMB EXT HC-SKIP-EXTENSIONS)
+
+                                 (* ;; "ignore any of these extensions")

+
+                                 (CL:FORMAT T "~&Ignoring (on extension): ~a~%%" SRCPATH)
+                                 (RETURN))
+
+                       (* ;; 
+
                  " doesn't (yet) implement  / to - translation. .readme should show up as -.readme.")

+
+                             (SETQ DEST (CONCAT NOV ".pdf"))
+                             (CL:WHEN (AND (NOT REDO)
+                                           (INFILEP DEST))
+                                 (CL:FORMAT T "~a is already there~%%" DEST)
+                                 (RETURN))
+                             (CL:WHEN (INFILEP (CONCAT DEST ".skip"))
+                                 (CL:FORMAT T "Explicit .skip ~a~%%" DEST)
+                                 (RETURN))
+                             (CL:FORMAT T "~&Starting on ~a:~%%" SRCPATH)
+                             (CL:WHEN [AND DOTEDIT (OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
+                                                       (CAR (REPORT-AND-GO
 (TEDIT.FORMATTEDFILEP
+                                                                            SRCPATH)
+                                                                   (CL:FORMAT NIL 
+                                                "~~%%~S TEDIT.FORMATTEDFILEP of ~A -- Condition: ~~A"
+                                                                          'FAIL SRCPATH]
+                                 (if
 (EQ REDO 'TEST)
+                                     then
 (CL:FORMAT T "Testing open ~a..." SRCPATH)
+                                          (CLOSEF? (OPENTEXTSTREAM SRCPATH))
+                                   else
 (REPORT-AND-GO
 (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM 
+                                                                                      SRCPATH))
+                                                              (TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL
+                                                                     NIL 'PDF))
+                                               (CL:FORMAT NIL 
+                                               "~~%%~S TEDIT.FORMAT.HARDCOPY of ~A -- Condition: ~~A"
+                                                      'FAIL SRCPATH)))
+                                 (PRIN3 " DONE" T)
+                                 (TERPRI T)
+                                 (RETURN))
+                             (CL:WHEN (AND DOPRETTY (OR (NULL EXT)
+                                                        (EQ EXT 'IL))
+                                           [SETQ LSFP (CAR (REPORT-AND-GO
 (LISPSOURCEFILEP SRCPATH)
+                                                                  (CL:FORMAT NIL 
+                                                     "~~%%~S LISPSOURCEFILEP of ~A -- Condition: ~~A"
+                                                                         'FAIL SRCPATH]
+                                           (NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*))
+
+                                 (* ;; "Why the check for NEQ *COMMON-LISP-READ-ENVIRONMENT* ??")

+
+                                 (PRIN3 "PDF printing " T)
+                                 (PRIN3 SRCPATH T)
+                                 (PRIN3 " to " T)
+                                 (PRIN3 DEST T)
+                                 (PRIN3 " ..." T)
+                                 (REPORT-AND-GO
 (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST))
+                                                       (PRETTYFILEINDEX SRCPATH NIL STR))
+                                        (CL:FORMAT NIL 
+                                               "~~%%~S PRETTYFILEINDEX of ~A -- Condition: ~~A"
+                                               'FAIL SRCPATH))
+                                 (PRIN3 " DONE" T)
+                                 (TERPRI T)
+                                 (RETURN))
+
+                       (* ;; "Everything else")

+
+                             (PRIN3 "No processing." T)
+                             (TERPRI T])
 
 (MAKE-INDEX-HTMLS

-  [LAMBDA (BASE TOP LEVEL ROOT.NAME)
                         (* ; "Edited 28-Jan-2026 11:01 by lmm")


+  [LAMBDA (BASE TOP LEVEL ROOT.NAME)
                         (* ; "Edited 15-Apr-2026 16:33 by mth")


+                                                             (* ; "Edited 28-Jan-2026 11:01 by lmm")


                                                              (* ; "Edited 27-Jan-2026 10:50 by lmm")


                                                              (* ; "Edited 23-Jan-2026 11:59 by lmm")


                                                              (* ; "Edited 29-Apr-2024 14:18 by lmm")


@@ -339,8 +393,8 @@
                                                                then
 2
                                                              else
 1))
                                                         -2)))
-                         (CL:UNLESS (OR (MEMB SHORTNAME '(.git))
-                                        (MEMB SHORTNAME '(.GIT))
+                         (CL:UNLESS (OR (EQ SHORTNAME '.git)
+                                        (EQ SHORTNAME '.GIT)
                                         [AND (STRPOS ".git" (L-CASE FULLNAME))
                                              (NOT (STRPOS ".github" (L-CASE FULLNAME]
                                         (INFILEP (CONCAT FULLNAME ".skip")))
@@ -372,7 +426,8 @@
 
 (PUTPROPS MEDLEY-UTILS
 FILETYPE
 :COMPILE-FILE)
 
-[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T)))
+[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '[(:LAST (PROGN (PRIN3 " " T)
+                                                                 (PRIN3 MSG T]
        :AFTER
        '((:LAST (AND (STRPOS "GETFN" MSG)
                      (HELP MSG]
@@ -463,6 +518,15 @@
                (SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
                (TERPRI])
 )
+
+(DEFMACRO REPORT-AND-GO
 (FORM REPORT-FORMAT)
                 (* ; "Edited 16-Apr-2026 16:02 by mth")

+   `[CL:MULTIPLE-VALUE-BIND (FORM-RESULT ERROR-CONDITION)
+           (IGNORE-ERRORS (CL:VALUES ,FORM))                 (* ; "Only the first value")

+           (COND
+              (ERROR-CONDITION (PRIN3 (CL:FORMAT NIL ,REPORT-FORMAT ERROR-CONDITION)
+                                      T)
+                     NIL)
+              (T (LIST FORM-RESULT])
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 )
@@ -472,9 +536,10 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1312 8246 (GATHER-INFO 1322 . 6704) (MAKE-FULLER-DB 6706 . 7615) (MEDLEY-FIX-LINKS 7617
- . 8010) (MEDLEY-FIX-DATES 8012 . 8244)) (9425 12213 (MAKE-EXPORTS-ALL 9435 . 10494) (
-MAKE-WHEREIS-HASH 10496 . 11685) (MAKE-WHEREIS-LOOPS 11687 . 12211)) (12214 21862 (HCFILES 12224 . 
-16487) (MAKE-INDEX-HTMLS 16489 . 21860)) (22112 26724 (RECOMPILE-ONE 22122 . 24019) (RECMPL 24021 . 
-24624) (COMPILE-SETUP 24626 . 25250) (REMAKEFILES 25252 . 26722)))))
+  (FILEMAP (NIL (1289 8223 (GATHER-INFO 1299 . 6681) (MAKE-FULLER-DB 6683 . 7592) (MEDLEY-FIX-LINKS 7594
+ . 7987) (MEDLEY-FIX-DATES 7989 . 8221)) (9795 12371 (MAKE-EXPORTS-ALL 9805 . 10652) (
+MAKE-WHEREIS-HASH 10654 . 11843) (MAKE-WHEREIS-LOOPS 11845 . 12369)) (12372 24990 (HCFILES 12382 . 
+19514) (MAKE-INDEX-HTMLS 19516 . 24988)) (25324 29936 (RECOMPILE-ONE 25334 . 27231) (RECMPL 27233 . 
+27836) (COMPILE-SETUP 27838 . 28462) (REMAKEFILES 28464 . 29934)) (29938 30408 (REPORT-AND-GO 29938 . 
+30408)))))
 STOP

internal/loadups/LOADUP-FULL

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED " 5-Feb-2026 10:26:39" {WMEDLEY}<internal>loadups>LOADUP-FULL.;36
 5858   
+
(FILECREATED "28-Apr-2026 10:01:06" {WMEDLEY}<internal>loadups>LOADUP-FULL.;47
 5896   
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS LOADUP-FULL)
 
-      :PREVIOUS-DATE "28-Dec-2025 12:06:12" {WMEDLEY}<internal>loadups>LOADUP-FULL.;35)
+      :PREVIOUS-DATE "16-Apr-2026 09:37:27" {WMEDLEY}<internal>loadups>LOADUP-FULL.;46)
 
 
 (PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -16,7 +16,8 @@
 (DEFINEQ
 
 (LOADFULLFONTS

-  [LAMBDA NIL
                                                (* ; "Edited 20-Sep-2025 14:17 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited 16-Apr-2026 09:37 by rmk")


+                                                             (* ; "Edited 20-Sep-2025 14:17 by rmk")


                                                              (* ; "Edited  2-Sep-2025 20:06 by rmk")


                                                              (* ; "Edited 13-Jul-2025 11:40 by rmk")


                                                              (* ; "Edited 30-Jun-2025 00:04 by rmk")


@@ -27,11 +28,8 @@
 
     (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")

 
-    (PRINTOUT T "Loading FULL fonts..." T)
+    (PRINTOUT T T "Loading FULL fonts..." T)
     (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
-
-    (* ;; "Previous code reset the coercion variables to NIL, which would have resulted in glyph-incomplete charsets. With Medley-formatted fonts, the completions have already been installed in the files and there is no need to deal with those variables.")

-
     (for
 FAMILY in
 '(CLASSIC MODERN TERMINAL)
        do
 (PRINTOUT T "  Loading " FAMILY " ")
           [for
 SIZE in
 '(8 10 12)
@@ -47,7 +45,9 @@
     (PRINTOUT T "FULL fonts loaded" T])
 
 (LOADUP-FULL

-  [LAMBDA (DRIBBLEFILE)
                                      (* ; "Edited  5-Feb-2026 10:26 by rmk")


+  [LAMBDA (DRIBBLEFILE)
                                      (* ; "Edited 28-Apr-2026 10:00 by rmk")


+                                                             (* ; "Edited 14-Feb-2026 00:42 by rmk")


+                                                             (* ; "Edited  5-Feb-2026 10:26 by rmk")


                                                              (* ; "Edited 28-Dec-2025 12:06 by rmk")


                                                              (* ; "Edited  1-Sep-2025 11:59 by rmk")


                                                              (* ; "Edited 18-Aug-2025 12:09 by rmk")


@@ -78,7 +78,6 @@
            (DIRECTORYNAME T)
            T T)                                              (* ; "For FONTSAVAILABLE lookup")

     (LOADUP '(POSTSCRIPTSTREAM))                             (* ; " to get PSCFONT.READFONT")

-    (LOADFULLFONTS
)
     (LISTPUT IDLE.PROFILE 'TIMEOUT 0)
     (SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL)
 
@@ -86,8 +85,8 @@
 
     (LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES 
                    GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS 
-                   DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT 
-                   UNIXYCD))
+                   DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT))
+    (LOADFULLFONTS
)
     (COND
        ((WINDOWP *WHO-LINE*)
         (CLOSEW *WHO-LINE*)))
@@ -102,5 +101,5 @@
 
 (FIXMETA
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (456 5820 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5570) (FIXMETA 5572 . 5818)))))
+  (FILEMAP (NIL (456 5858 (LOADFULLFONTS 466 . 2449) (LOADUP-FULL 2451 . 5608) (FIXMETA 5610 . 5856)))))
 STOP

internal/loadups/LOADUP-LISP

@@ -1,13 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "28-Jan-2026 14:30:48" |{DSK}<Users>larry>IL>medley>internal>loadups>LOADUP-LISP.;2|
 7369   
+
(FILECREATED "26-Mar-2026 18:38:22" 
+|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;14|
 7604   
 
-      :EDIT-BY "lmm"
+      :EDIT-BY "briggs"
 
       :CHANGES-TO (FNS LOADUP-LISP)
 
-      :PREVIOUS-DATE "27-Dec-2025 15:02:04" 
-|{DSK}<Users>larry>IL>medley>internal>loadups>LOADUP-LISP.;1|)
+      :PREVIOUS-DATE "22-Feb-2026 14:15:31" 
+|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;13|)
 
 
 (PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -20,7 +21,9 @@
 (DEFINEQ
 
 (LOADUP-LISP

-  (LAMBDA (DRIBBLEFILE)
                                     (* \; "Edited 28-Jan-2026 14:30 by lmm")


+  (LAMBDA (DRIBBLEFILE)
                                  (* \; "Edited 26-Mar-2026 18:38 by briggs")


+                                                            (* \; "Edited 22-Feb-2026 14:15 by rmk")


+                                                            (* \; "Edited 28-Jan-2026 14:30 by lmm")


                                                             (* \; "Edited 27-Dec-2025 15:02 by rmk")


                                                             (* \; "Edited 16-Oct-2025 16:55 by rmk")


                                                             (* \; "Edited 18-Aug-2025 12:08 by rmk")


@@ -95,9 +98,9 @@
 
     (* |;;| "Also, UNICODE is split into UNICODE-TABLES and UNICODE, so the tables are loaded before their MCCS/Uncode client functions are installed.  Functions in UFS now depend on those translations so that filenames can have characters outside of Ascii. ")

 
-    (LOADUP '(UNICODE-TABLES UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU 
-                    WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL 
-                    DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
+    (LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ WINDOWSCROLL 
+                    WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE 
+                    CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
     (LOADUP '(BREAK-AND-TRACE))
     (LOADUP '(FASDUMP XCL-COMPILER ADVISE))
 
@@ -135,6 +138,7 @@
 
     (LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP 
                   NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
+    (RESTART.ETHER)
     (DRIBBLE)
     (SETQ MAKESYSNAME :MEDLEY)))
 )
@@ -147,5 +151,5 @@
 (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (675 7163 (LOADUP-LISP 685 . 7161)))))
+  (FILEMAP (NIL (695 7398 (LOADUP-LISP 705 . 7396)))))
 STOP

internal/loadups/man-page/loadup.1

@@ -111,11 +111,11 @@ output directory called \f[I]gitinfo\f[R] which contains the git commit,
 git branch and git status information for the directory at the time the
 loadup is run.
 .PP
-Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
+Only one instance (per <MEDLEYDIR>) of loadup can be run at a time.
 There is lock file to prevent simultaneous loadups in the work directory
 (named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
-The lock can also be automatically overridden (see the \[en]override
-flag below).
+The lock can also be automatically overridden (see the --override flag
+below).
 Alternatively, if a lock is encountered at run time, the user will be
 asked to choose whether to override or simply exit the loadup.
 .PP
@@ -130,7 +130,7 @@ But Medley can be installed in multiple places on any given machine and
 hence MEDLEYDIR is computed on each invocation of loadup.
 .SH OPTIONS
 .TP
-\f[B]-z [+], --man [+], -man [+], -h [+], \[en]help [+]\f[R]
+\f[B]-z [+], --man [+], -man [+], -h [+], --help [+]\f[R]
 Print this manual page on the screen.
 If the \f[B]+\f[R] parameter is specified, then no pager is used when
 displaying the man page.
@@ -138,7 +138,7 @@ displaying the man page.
 \f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
 Run the sequential loadup procedure until the STAGE is complete,
 starting from the files created by the previously run STAGE specified in
-the \[en]start option.
+the --start option.
 .RS
 .PP
 STAGE can be one of the following:
@@ -175,7 +175,7 @@ Full.sysout is copied into the loadups directory.
 .RS
 .PP
 a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
-Also run the Aux stage as if \[en]aux option had been specified.
+Also run the Aux stage as if --aux option had been specified.
 Apps.sysout and the Aux files are copied into the loadups directory.
 .RE
 .RE
@@ -185,7 +185,7 @@ Apps.sysout and the Aux files are copied into the loadups directory.
 a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
 The Aux stage is not run unless otherwise specified.
 Apps.sysout is copied into the loadups directory.
-Also run the Aux stage as if \[en]aux option had been specified.
+Also run the Aux stage as if --aux option had been specified.
 .RE
 .RE
 .TP
@@ -245,22 +245,22 @@ If this stage complete successfully, these files are copied into
 loadups.
 .TP
 \f[B]-i, --init, -init, -1\f[R]
-Synonym for \[lq]\[en]target init\[rq]
+Synonym for \[lq]--target init\[rq]
 .TP
 \f[B]-m, --mid, -mid, -2\f[R]
-Synonym for \[lq]\[en]target mid\[rq]
+Synonym for \[lq]--target mid\[rq]
 .TP
 \f[B]-l, --lisp, -lisp, -3\f[R]
-Synonym for \[lq]\[en]target lisp\[rq]
+Synonym for \[lq]--target lisp\[rq]
 .TP
 \f[B]-f, --full. -full, -4\f[R]
-Synonym for \[lq]\[en]target full\[rq]
+Synonym for \[lq]--target full\[rq]
 .TP
 \f[B]-a, --apps, -apps, -5\f[R]
-Synonym for \[lq]\[en]target apps\[rq]
+Synonym for \[lq]--target apps\[rq]
 .TP
 \f[B]-a-, --apps-, -apps-, -5-\f[R]
-Synonym for \[lq]\[en]target apps\[rq]
+Synonym for \[lq]--target apps\[rq]
 .TP
 \f[B]-ov, --override, -override\f[R]
 Automatically override the lock that prevents two loadups from running
@@ -300,14 +300,14 @@ contained in the working directory.
 If the \f[B]+\f[R] parameter is used, then instead of deleting just the
 versioned files, all files and subdirectories are deleted except for
 those contained in the working directory.
-If \f[B]+\f[R] is used and there is no working directory and
-\f[I]\[en]tag TAG\f[R] is also specified, then the tagged loadups
-directory (<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
+If \f[B]+\f[R] is used and there is no working directory and \f[I]--tag
+TAG\f[R] is also specified, then the tagged loadups directory
+(<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
 .TP
 \f[B]-th [+], --thin [+], -thin [+]\f[R]
 Equivalent to specifying both -tw [+] and -tl [+].
-If \f[I]\[en]tag TAG\f[R] is also specified and the \f[B]+\f[R]
-parameter is used here, then the tagged loadups directory
+If \f[I]--tag TAG\f[R] is also specified and the \f[B]+\f[R] parameter
+is used here, then the tagged loadups directory
 (<MEDLEYDIR>/loadups/tagged/TAG) is removed.
 .TP
 \f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
@@ -328,38 +328,36 @@ commonly used in running Medley in the absence of an Xwindows server.
 .PP
 The defaults for the Options context-dependent and somewhat complicated
 due to the goal of maintaining compatibility with legacy loadup scripts.
-All of the following defaults rules hold independent of the
-\[en]maikodir (-d) option.
+All of the following defaults rules hold independent of the --maikodir
+(-d) option.
 .IP "1." 3
-If none of \[en]target, \[en]start, \[en]aux, and \[en]db are specified,
-then:
+If none of --target, --start, --aux, and --db are specified, then:
 .RS
 .PP
 1A.
-If neither \[en]thinw nor \[en]thinl are specified, the options default
-to:
+If neither --thinw nor --thinl are specified, the options default to:
 .RE
 .RS
 .RS
 .PP
-\f[B]\[en]target full \[en]start 0 \[en]aux\f[R]
+\f[B]--target full --start 0 --aux\f[R]
 .RE
 .RE
 .RS
 .PP
 1B.
-If either \[en]thinw or \[en]thinl are specified, no loadups are run.
+If either --thinw or --thinl are specified, no loadups are run.
 .RE
 .IP "2." 3
-If neither \[en]start nor \[en]target are specified but either -aux or
--db or both are, then \[en]start defaults to \f[I]full\f[R] and
-\[en]target is irrelevant.
+If neither --start nor --target are specified but either -aux or -db or
+both are, then --start defaults to \f[I]full\f[R] and --target is
+irrelevant.
 .IP "3." 3
-If \[en]start is specified and \[en]target is not, then \[en]target
-defaults to \f[I]full\f[R]
+If --start is specified and --target is not, then --target defaults to
+\f[I]full\f[R]
 .IP "4." 3
-If \[en]target is specified and \[en]start is not, then \[en]start
-defaults to \f[I]0\f[R]
+If --target is specified and --start is not, then --start defaults to
+\f[I]0\f[R]
 .SH EXAMPLES
 .PP
 \f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
@@ -368,14 +366,14 @@ starting from existing Stage 3 outputs (lisp.sysout).
 \f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
 .PP
-\f[B]./loadup -5 \[en]aux\f[R] : run loadup from the beginning thru
-Stage 5 (apps.sysout) then run the Aux \[lq]stage\[rq] to create
+\f[B]./loadup -5 --aux\f[R] : run loadup from the beginning thru Stage 5
+(apps.sysout) then run the Aux \[lq]stage\[rq] to create
 \f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
 .PP
 \f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
 an existing full.sysout; do not run any of the sequential stages.
 .PP
-\f[B]./loadup \[en]maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
+\f[B]./loadup --maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
 from beginning to full plus the loadup Aux stage, while using
 \f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
 running Medley.

internal/loadups/man-page/loadup.1.md

@@ -52,7 +52,7 @@ Loadup does all of its work in a work directory (\<MEDLEYDIR>/loadups/build).  T
 
 If \<MEDLEYDIR> is a git directory, then a file is created in the loadups output directory called *gitinfo* which contains the git commit, git branch and git status information for the directory at the time the loadup is run.
 
-Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time.  There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed.  The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
+Only one instance (per \<MEDLEYDIR>) of loadup can be run at a time.  There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed.  The lock can also be automatically overridden (see the \-\-override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
 
 Note: **MEDLEYDIR** is an environment variable set by the loadup script.  It is set to the top level directory of the Medley installation that contains the specific loadup script that
 is invoked after all symbolic links are resolved.  In the standard global installation this will 
@@ -61,12 +61,12 @@ hence MEDLEYDIR is computed on each invocation of loadup.
 
 OPTIONS
 =======
-**-z [+], \-\-man [+], \-man [+], -h [+], --help [+]**
+**-z [+], \-\-man [+], \-man [+], -h [+], \-\-help [+]**
 : Print this manual page on the screen.  If the **+** parameter is specified, then no pager is used when
 displaying the man page.
 
 **-t STAGE, \-\-target STAGE, -target STAGE**
-: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the --start option.
+: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the \-\-start option.
 
 >STAGE can be one of the following:
  
@@ -78,9 +78,9 @@ displaying the man page.
  
 >>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout).  Full.sysout is copied into the loadups directory.
  
->>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if --aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
+>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if \-\-aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
 
->>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).  The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory.  Also run the Aux stage as if --aux option had been specified.
+>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).  The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory.  Also run the Aux stage as if \-\-aux option had been specified.
 
 
 **-s STAGE \-\-start STAGE, -start STAGE**
@@ -105,22 +105,22 @@ displaying the man page.
 : Run the DB loadup stage, creating the *fuller.database* file.  If this stage complete successfully, these files are copied into loadups.
 
 **-i, \-\-init, -init, -1**
-: Synonym for "--target init"
+: Synonym for "\-\-target init"
 
 **-m, \-\-mid, -mid, -2**
-: Synonym for "--target mid"
+: Synonym for "\-\-target mid"
 
 **-l, \-\-lisp, -lisp, -3**
-: Synonym for "--target lisp"
+: Synonym for "\-\-target lisp"
 
 **-f, \-\-full. -full, -4**
-: Synonym for "--target full"
+: Synonym for "\-\-target full"
 
 **-a, \-\-apps, -apps, -5**
-: Synonym for "--target apps"
+: Synonym for "\-\-target apps"
 
 **-a-, \-\-apps-, -apps-, -5-**
-: Synonym for "--target apps"
+: Synonym for "\-\-target apps"
 
 **-ov, \-\-override, -override**
 : Automatically override the lock that prevents two loadups from running simultaneously.  If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
@@ -149,11 +149,11 @@ working directory (and all files and subdirectories it contains) is deleted.
 files except for those contained in the working directory.
 If the **+** parameter is used, then instead of deleting just the versioned files, all files and
 subdirectories are deleted except for those contained in the working directory.  If **+** is used and
-there is no working directory and *--tag TAG* is also specified,
+there is no working directory and *\-\-tag TAG* is also specified,
 then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG) is also deleted. 
 
 **-th [+], \-\-thin [+], -thin [+]**
-: Equivalent to specifying both -tw [+] and -tl [+].  If *--tag TAG* is also specified and
+: Equivalent to specifying both -tw [+] and -tl [+].  If *\-\-tag TAG* is also specified and
 the **+** parameter is used here, then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG)
 is removed. 
 
@@ -168,21 +168,21 @@ running Medley in the absence of an Xwindows server.
 
 DEFAULTS
 ====
-The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts.  All of the following defaults rules hold independent of the --maikodir (-d) option.
+The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts.  All of the following defaults rules hold independent of the \-\-maikodir (-d) option.
 
-1. If none of --target, --start, --aux, and --db are specified, then:
+1. If none of \-\-target, \-\-start, \-\-aux, and \-\-db are specified, then:
 
->1A.  If neither --thinw nor --thinl are specified,  the options default to:
+>1A.  If neither \-\-thinw nor \-\-thinl are specified,  the options default to:
 
->> **--target full --start 0 --aux**
+>> **\-\-target full \-\-start 0 \-\-aux**
 
->1B.  If either --thinw or --thinl are specified, no loadups are run.
+>1B.  If either \-\-thinw or \-\-thinl are specified, no loadups are run.
 
-2. If neither --start nor --target are specified but either -aux or -db or both are, then --start defaults to *full* and --target is irrelevant.
+2. If neither \-\-start nor \-\-target are specified but either -aux or -db or both are, then \-\-start defaults to *full* and \-\-target is irrelevant.
 
-3. If --start is specified and --target is not, then --target defaults to *full*
+3. If \-\-start is specified and \-\-target is not, then \-\-target defaults to *full*
 
-4. If --target is specified and --start is not, then --start defaults to *0*
+4. If \-\-target is specified and \-\-start is not, then \-\-start defaults to *0*
 
 EXAMPLES
 ====
@@ -190,11 +190,11 @@ EXAMPLES
 
 **./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
 
-**./loadup -5 --aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
+**./loadup -5 \-\-aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
 
 **./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
 
-**./loadup --maikodir ~/il/newmaiko** :   run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
+**./loadup \-\-maikodir ~/il/newmaiko** :   run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
 
 **./loadup -full** : run loadup sequence from beginning thru full
 

internal/loadups/man-page/man_loadup.html

@@ -83,11 +83,11 @@ the work directory after the loadup completes.</p>
 the loadups output directory called <em>gitinfo</em> which contains the
 git commit, git branch and git status information for the directory at
 the time the loadup is run.</p>
-<p>Only one instance (per &lt;MEDLEIDIR&gt;) of loadup can be run at a
+<p>Only one instance (per &lt;MEDLEYDIR&gt;) of loadup can be run at a
 time. There is lock file to prevent simultaneous loadups in the work
 directory (named <strong><em>lock</em></strong>) that can be manually
 removed. The lock can also be automatically overridden (see the
-–override flag below). Alternatively, if a lock is encountered at run
+--override flag below). Alternatively, if a lock is encountered at run
 time, the user will be asked to choose whether to override or simply
 exit the loadup.</p>
 <p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
@@ -99,7 +99,8 @@ installed in multiple places on any given machine and hence MEDLEYDIR is
 computed on each invocation of loadup.</p>
 <h1>OPTIONS</h1>
 <dl>
-<dt><strong>-z [+], --man [+], -man [+], -h [+], –help [+]</strong></dt>
+<dt><strong>-z [+], --man [+], -man [+], -h [+], --help
+[+]</strong></dt>
 <dd>
 <p>Print this manual page on the screen. If the <strong>+</strong>
 parameter is specified, then no pager is used when displaying the man
@@ -109,7 +110,7 @@ page.</p>
 <dd>
 <p>Run the sequential loadup procedure until the STAGE is complete,
 starting from the files created by the previously run STAGE specified in
-the –start option.</p>
+the --start option.</p>
 <p>STAGE can be one of the following:</p>
 <blockquote>
 <p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
@@ -129,13 +130,13 @@ Full.sysout is copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
 <p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
-Also run the Aux stage as if –aux option had been specified. Apps.sysout
-and the Aux files are copied into the loadups directory.</p>
+Also run the Aux stage as if --aux option had been specified.
+Apps.sysout and the Aux files are copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
 <p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
 The Aux stage is not run unless otherwise specified. Apps.sysout is
-copied into the loadups directory. Also run the Aux stage as if –aux
+copied into the loadups directory. Also run the Aux stage as if --aux
 option had been specified.</p>
 </blockquote>
 </dd>
@@ -181,27 +182,27 @@ loadups.</p>
 </dd>
 <dt><strong>-i, --init, -init, -1</strong></dt>
 <dd>
-<p>Synonym for “–target init”</p>
+<p>Synonym for “--target init”</p>
 </dd>
 <dt><strong>-m, --mid, -mid, -2</strong></dt>
 <dd>
-<p>Synonym for “–target mid”</p>
+<p>Synonym for “--target mid”</p>
 </dd>
 <dt><strong>-l, --lisp, -lisp, -3</strong></dt>
 <dd>
-<p>Synonym for “–target lisp”</p>
+<p>Synonym for “--target lisp”</p>
 </dd>
 <dt><strong>-f, --full. -full, -4</strong></dt>
 <dd>
-<p>Synonym for “–target full”</p>
+<p>Synonym for “--target full”</p>
 </dd>
 <dt><strong>-a, --apps, -apps, -5</strong></dt>
 <dd>
-<p>Synonym for “–target apps”</p>
+<p>Synonym for “--target apps”</p>
 </dd>
 <dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
 <dd>
-<p>Synonym for “–target apps”</p>
+<p>Synonym for “--target apps”</p>
 </dd>
 <dt><strong>-ov, --override, -override</strong></dt>
 <dd>
@@ -245,13 +246,13 @@ contained in the working directory. If the <strong>+</strong> parameter
 is used, then instead of deleting just the versioned files, all files
 and subdirectories are deleted except for those contained in the working
 directory. If <strong>+</strong> is used and there is no working
-directory and <em>–tag TAG</em> is also specified, then the tagged
+directory and <em>--tag</em> TAG is also specified, then the tagged
 loadups directory (&lt;MEDLEYDIR&gt;/loadups/tagged/TAG) is also
 deleted.</p>
 </dd>
 <dt><strong>-th [+], --thin [+], -thin [+]</strong></dt>
 <dd>
-<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>–tag
+<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>--tag
 TAG</em> is also specified and the <strong>+</strong> parameter is used
 here, then the tagged loadups directory
 (&lt;MEDLEYDIR&gt;/loadups/tagged/TAG) is removed.</p>
@@ -277,24 +278,24 @@ absence of an Xwindows server.</p>
 <p>The defaults for the Options context-dependent and somewhat
 complicated due to the goal of maintaining compatibility with legacy
 loadup scripts. All of the following defaults rules hold independent of
-the –maikodir (-d) option.</p>
+the --maikodir (-d) option.</p>
 <ol type="1">
-<li><p>If none of –target, –start, –aux, and –db are specified,
+<li><p>If none of --target, --start, --aux, and --db are specified,
 then:</p>
-<p>1A. If neither –thinw nor –thinl are specified, the options default
+<p>1A. If neither --thinw nor --thinl are specified, the options default
 to:</p>
 <blockquote>
-<p><strong>–target full –start 0 –aux</strong></p>
+<p><strong>--target full --start 0 --aux</strong></p>
 </blockquote>
-<p>1B. If either –thinw or –thinl are specified, no loadups are
+<p>1B. If either --thinw or --thinl are specified, no loadups are
 run.</p></li>
-<li><p>If neither –start nor –target are specified but either -aux or
--db or both are, then –start defaults to <em>full</em> and –target is
+<li><p>If neither --start nor --target are specified but either -aux or
+-db or both are, then --start defaults to <em>full</em> and --target is
 irrelevant.</p></li>
-<li><p>If –start is specified and –target is not, then –target defaults
-to <em>full</em></p></li>
-<li><p>If –target is specified and –start is not, then –start defaults
-to <em>0</em></p></li>
+<li><p>If --start is specified and --target is not, then --target
+defaults to <em>full</em></p></li>
+<li><p>If --target is specified and --start is not, then --start
+defaults to <em>0</em></p></li>
 </ol>
 <h1>EXAMPLES</h1>
 <p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
@@ -302,12 +303,12 @@ to <em>0</em></p></li>
 <p><strong>./loadup --target full --start lisp</strong> : run loadup
 thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
 (lisp.sysout).</p>
-<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning
+<p><strong>./loadup -5 --aux</strong> : run loadup from the beginning
 thru Stage 5 (apps.sysout) then run the Aux “stage” to create
 <em>whereis.hash</em> and <em>exports.all</em></p>
 <p><strong>./loadup -db</strong> : just run the DB “stage” starting from
 an existing full.sysout; do not run any of the sequential stages.</p>
-<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup
+<p><strong>./loadup --maikodir ~/il/newmaiko</strong> : run loadup
 sequence from beginning to full plus the loadup Aux stage, while using
 <em>~/il/newmaiko</em> as the location for the lde executables when
 running Medley.</p>

library/CLIPBOARD

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Sep-2025 15:00:01" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;28
 8305   
+
(FILECREATED "23-Feb-2026 12:35:55" {WMEDLEY}<library>CLIPBOARD.;29
 8228   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS PUTCLIPBOARD CLIPBOARD-COPY-STREAM)
+      :CHANGES-TO (VARS CLIPBOARDCOMS)
 
-      :PREVIOUS-DATE "21-Apr-2024 09:12:04" {WMEDLEY}<library>CLIPBOARD.;18)
+      :PREVIOUS-DATE "25-Sep-2025 15:00:01" {WMEDLEY}<library>CLIPBOARD.;28)
 
 
 (PRETTYCOMPRINT CLIPBOARDCOMS)
@@ -18,7 +17,7 @@
              CLIPBOARD-PASTE-STREAM)
         (FNS SEDIT.COPYTOCLIPBOARD)
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
-                                                              UNIXCOMM UNICODE)
+                                                              UNIXCOMM)
                (P (INSTALL-CLIPBOARD)))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
@@ -148,7 +147,7 @@
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY 
 
 (FILESLOAD (SYSLOAD)
-       UNIXCOMM UNICODE)
+       UNIXCOMM)
 
 
 (INSTALL-CLIPBOARD
)
@@ -162,7 +161,7 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1167 6486 (INSTALL-CLIPBOARD 1177 . 2504) (GETCLIPBOARD 2506 . 2880) (PUTCLIPBOARD 2882
- . 4306) (PASTEFROMCLIPBOARD 4308 . 5226) (CLIPBOARD-COPY-STREAM 5228 . 5762) (CLIPBOARD-PASTE-STREAM 
-5764 . 6484)) (6487 8026 (SEDIT.COPYTOCLIPBOARD 6497 . 8024)))))
+  (FILEMAP (NIL (1098 6417 (INSTALL-CLIPBOARD 1108 . 2435) (GETCLIPBOARD 2437 . 2811) (PUTCLIPBOARD 2813
+ . 4237) (PASTEFROMCLIPBOARD 4239 . 5157) (CLIPBOARD-COPY-STREAM 5159 . 5693) (CLIPBOARD-PASTE-STREAM 
+5695 . 6415)) (6418 7957 (SEDIT.COPYTOCLIPBOARD 6428 . 7955)))))
 STOP

library/DATABASEFNS

@@ -1,16 +1,17 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "20-Feb-2024 23:45:56" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4
 18445  
+
(FILECREATED " 2-May-2026 17:38:46" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;4
 18684  
 
       :EDIT-BY "mth"
 
       :CHANGES-TO (FNS DUMPDB)
 
-      :PREVIOUS-DATE "19-Feb-2024 16:29:44" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
+      :PREVIOUS-DATE "29-Apr-2026 17:43:56" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;2
+)
 
 
 (* ; "
-Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
+Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -164,7 +165,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
 (DEFINEQ
 
 (DUMPDB

-  [LAMBDA (FILE PROPFLG)
                                     (* ; "Edited 20-Feb-2024 23:45 by mth")


+  [LAMBDA (FILE PROPFLG)
                                     (* ; "Edited  2-May-2026 17:32 by mth")


+                                                             (* ; "Edited 29-Apr-2026 17:42 by mth")


+                                                             (* ; "Edited 20-Feb-2024 23:45 by mth")


                                                              (* ; "Edited  7-Feb-2024 18:26 by mth")


                                                            (* ; "Edited 27-Oct-2021 10:51 by larry")


                                                             (* ; "Edited 24-Oct-2021 16:24 by rmk:")

@@ -180,7 +183,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
         (LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
               (SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
              (CL:UNWIND-PROTECT
-                 (PROG (DBFILE
 DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
+                 (PROG (DBFILE
 DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
                               (FNS (FILEFNSLST FILE)))
                        (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
                        (SETQ DBROOTFN (ROOTFILENAME DBFN))
@@ -230,7 +233,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
                             (PRETTYDEF NIL DBFN
                                    `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
                                                (ERROR!)))
-                                     (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
+                                     (E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
                                         (DUMPDATABASE ',FNS]
                            [COND
                               (PROPFLG (PRINT (FULLNAME DBFILE)
@@ -375,9 +378,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
 
 (RESETSAVE DWIMIFYCOMPFLG T)
 )
-(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
+(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024 2026))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
- . 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB 
-11875 . 16750) (MAKEDB 16752 . 17836)))))
+  (FILEMAP (NIL (1783 6808 (DBFILE 1793 . 3438) (DBFILE1 3440 . 4950) (DBFILE2 4952 . 6174) (LOAD 6176
+ . 6406) (LOADFROM 6408 . 6596) (MAKEFILE 6598 . 6806)) (6864 18072 (DUMPDB 6874 . 12107) (LOADDB 
+12109 . 16984) (MAKEDB 16986 . 18070)))))
 STOP

library/GRAPHER

@@ -1,21 +1,18 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "14-Mar-2021 20:40:30" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>GRAPHER.;5
 214171 
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-      changes to%:  (VARS GRAPHERCOMS)
+
(FILECREATED "14-Apr-2026 22:19:19" {DSK}<home>frank>il>medley>library>GRAPHER.;3
 215302 
 
-      previous date%: "14-May-2018 10:24:38" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>GRAPHER.;4)
+      :EDIT-BY "FGH"
 
+      :CHANGES-TO (FNS DISPLAYLINK/RL DISPLAYLINK/LR DISPLAYLINK/BT DISPLAYLINK/TB)
+
+      :PREVIOUS-DATE "14-Mar-2021 20:40:30" {DSK}<home>frank>il>medley>library>GRAPHER.;1)
 
-(* ; "
-Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT GRAPHERCOMS)
 
 (RPAQQ GRAPHERCOMS

-       [(COMS                                                (* ; "Graph Editing")

+       [(COMS                                                (* ; "Graph Editing")

               (FNS ADD/AND/DISPLAY/LINK APPLYTOSELECTEDNODE CALL.MOVENODEFN CHANGE.NODEFONT.SIZE 
                    DEFAULT.ADDNODEFN DELETE/AND/DISPLAY/LINK DISPLAY/NAME DISPLAYGRAPH DISPLAYLINK 
                    DISPLAYLINK/BT DISPLAYLINK/LR DISPLAYLINK/RL DISPLAYLINK/TB DISPLAYNODE 
@@ -38,18 +35,18 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
                  (CL:WHEN (GETD 'MODERNWINDOW.SETUP)
                      (MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE))]
               
-              (* ;; "Support for EDITSUBGRAPH and EDITREGION")

+              (* ;; "Support for EDITSUBGRAPH and EDITREGION")

 
               (FNS EDITMOVEREGION EDITMOVESUBTREE NOT.TRACKCURSOR RECURSIVE.COLLECTDESCENDENTS 
                    MOVEDESCENDENTS COLLECT.CHILD.NODES CREATE.NEW.NODEPOSITION 
                    GETBOXPOSITION.FROMINITIALREGION COLLECTDESCENDENTS))
-        (COMS                                                (* ; 
-
                                                   "functions for finding larger and smaller fonts")

+        (COMS                                                (* ; 
+
                                                     "functions for finding larger and smaller fonts")

               (FNS NEXTSIZEFONT DECREASING.FONT.LIST SCALE.FONT)
               [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DECREASING.FONT.LIST (DECREASING.FONT.LIST]
               (GLOBALVARS DECREASING.FONT.LIST))
-                                                             (* ; 
-
                                                      "functions for LAYOUTGRAPH And LAYOUTLATTICE")

+                                                             (* ; 
+
                                                        "functions for LAYOUTGRAPH And LAYOUTLATTICE")

         (FNS BRH/LAYOUT BRH/LAYOUT/DAUGHTERS BRH/OFFSET BRHC/INTERTREE/SPACE BRHC/LAYOUT 
              BRHC/LAYOUT/DAUGHTERS BRHC/LAYOUT/TERMINAL BRHC/OFFSET BRHL/LAYOUT BRHL/LAYOUT/DAUGHTERS
              BRHL/MOVE/RIGHT BROWSE/LAYOUT/HORIZ BROWSE/LAYOUT/HORIZ/COMPACTLY BROWSE/LAYOUT/LATTICE
@@ -95,7 +92,7 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
         (LOCALVARS . T)
         (RECORDS GRAPHNODE GRAPH)
         (DECLARE%: DONTCOPY (MACROS HALF))
-        (COMS                                                (* ; "Grapher image objects")

+        (COMS                                                (* ; "Grapher image objects")

               (FNS GRAPHERIMAGEFNS)
               (FNS GRAPHERCOPYBUTTONEVENTFN GRAPHOBJ.FINDGRAPH)
               (FNS ALIGNMENTNODE GRAPHOBJ.CHECKALIGN)
@@ -303,96 +300,112 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
                 NIL])
 
 (DISPLAYLINK/BT

-  [LAMBDA (TRANS GNB GNT WIDTH OPERATION STREAM PARAMS)

+  [LAMBDA (TRANS GNB GNT WIDTH OPERATION STREAM PARAMS)
      (* ; "Edited 14-Apr-2026 22:08 by FGH")


                                                           (* ; "Edited 29-Apr-94 13:59 by sybalsky")

 
-         (* draws a line from the bottom edge of GNB to the top edge of GNT translated 
-
       by TRANS)

+         (* draws a line from the bottom edge of GNB to the top edge of GNT translated by 
+
         TRANS)

 
-    (APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
-                'DRAWLINE)
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNB)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (SUB1 (GN/BOTTOM
 GNB)))
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNT)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (ADD1 (GN/TOP
 GNT)))
-           (OR (LISTGET PARAMS 'LINEWIDTH)
-               WIDTH 1)
-           OPERATION STREAM (LISTGET PARAMS 'COLOR)
-           (LISTGET PARAMS 'DASHING)
-           PARAMS])
+    (LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
+           (DFN (AND FN (GETD FN]
+          (if
 (AND FN (NOT DFN))
+              then
 (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
+          (APPLY* (OR (AND DFN FN)
+                      'DRAWLINE)
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNB)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (SUB1 (GN/BOTTOM
 GNB)))
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNT)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (ADD1 (GN/TOP
 GNT)))
+                 (OR (LISTGET PARAMS 'LINEWIDTH)
+                     WIDTH 1)
+                 OPERATION STREAM (LISTGET PARAMS 'COLOR)
+                 (LISTGET PARAMS 'DASHING)
+                 PARAMS])
 
 (DISPLAYLINK/LR

-  [LAMBDA (TRANS GNL GNR WIDTH OPERATION STREAM PARAMS)

+  [LAMBDA (TRANS GNL GNR WIDTH OPERATION STREAM PARAMS)
      (* ; "Edited 14-Apr-2026 22:09 by FGH")


                                                           (* ; "Edited 29-Apr-94 13:59 by sybalsky")

 
-         (* draws a line from the left edge of GNL to the right edge of GNR, translated 
-
       by TRANS)

+         (* draws a line from the left edge of GNL to the right edge of GNR, translated by 
+
         TRANS)

 
-    (APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
-                'DRAWLINE)
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (SUB1 (GN/LEFT
 GNL)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNL)))
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (ADD1 (GN/RIGHT
 GNR)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNR)))
-           (OR (LISTGET PARAMS 'LINEWIDTH)
-               WIDTH 1)
-           OPERATION STREAM (LISTGET PARAMS 'COLOR)
-           (LISTGET PARAMS 'DASHING)
-           PARAMS])
+    (LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
+           (DFN (AND FN (GETD FN]
+          (if
 (AND FN (NOT DFN))
+              then
 (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
+          (APPLY* (OR (AND DFN FN)
+                      'DRAWLINE)
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (SUB1 (GN/LEFT
 GNL)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNL)))
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (ADD1 (GN/RIGHT
 GNR)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNR)))
+                 (OR (LISTGET PARAMS 'LINEWIDTH)
+                     WIDTH 1)
+                 OPERATION STREAM (LISTGET PARAMS 'COLOR)
+                 (LISTGET PARAMS 'DASHING)
+                 PARAMS])
 
 (DISPLAYLINK/RL

-  [LAMBDA (TRANS GNR GNL WIDTH OPERATION STREAM PARAMS)

+  [LAMBDA (TRANS GNR GNL WIDTH OPERATION STREAM PARAMS)
      (* ; "Edited 14-Apr-2026 22:09 by FGH")


                                                           (* ; "Edited 29-Apr-94 13:59 by sybalsky")

 
-         (* draws a line from the right edge of GNR, to the left edge of GNL translated 
-
       by TRANS)

+         (* draws a line from the right edge of GNR, to the left edge of GNL translated by 
+
         TRANS)

 
-    (APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
-                'DRAWLINE)
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (ADD1 (GN/RIGHT
 GNR)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNR)))
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (SUB1 (GN/LEFT
 GNL)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNL)))
-           (OR (LISTGET PARAMS 'LINEWIDTH)
-               WIDTH 1)
-           OPERATION STREAM (LISTGET PARAMS 'COLOR)
-           (LISTGET PARAMS 'DASHING)
-           PARAMS])
+    (LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
+           (DFN (AND FN (GETD FN]
+          (if
 (AND FN (NOT DFN))
+              then
 (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
+          (APPLY* (OR (AND DFN FN)
+                      'DRAWLINE)
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (ADD1 (GN/RIGHT
 GNR)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNR)))
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (SUB1 (GN/LEFT
 GNL)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (fetch
 YCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNL)))
+                 (OR (LISTGET PARAMS 'LINEWIDTH)
+                     WIDTH 1)
+                 OPERATION STREAM (LISTGET PARAMS 'COLOR)
+                 (LISTGET PARAMS 'DASHING)
+                 PARAMS])
 
 (DISPLAYLINK/TB

-  [LAMBDA (TRANS GNT GNB WIDTH OPERATION STREAM PARAMS)

+  [LAMBDA (TRANS GNT GNB WIDTH OPERATION STREAM PARAMS)
      (* ; "Edited 14-Apr-2026 22:09 by FGH")


                                                           (* ; "Edited 29-Apr-94 13:59 by sybalsky")

 
-         (* draws a line from the top edge of GNT to the bottom edge of GNR, translated 
-
       by TRANS)

+         (* draws a line from the top edge of GNT to the bottom edge of GNR, translated by 
+
         TRANS)

 
-    (APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
-                'DRAWLINE)
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNT)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (ADD1 (GN/TOP
 GNT)))
-           (IPLUS (fetch
 XCOORD of
 TRANS)
-                  (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNB)))
-           (IPLUS (fetch
 YCOORD of
 TRANS)
-                  (SUB1 (GN/BOTTOM
 GNB)))
-           (OR (LISTGET PARAMS 'LINEWIDTH)
-               WIDTH 1)
-           OPERATION STREAM (LISTGET PARAMS 'COLOR)
-           (LISTGET PARAMS 'DASHING)
-           PARAMS])
+    (LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
+           (DFN (AND FN (GETD FN]
+          (if
 (AND FN (NOT DFN))
+              then
 (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
+          (APPLY* (OR (AND DFN FN)
+                      'DRAWLINE)
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNT)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (ADD1 (GN/TOP
 GNT)))
+                 (IPLUS (fetch
 XCOORD of
 TRANS)
+                        (fetch
 XCOORD of
 (fetch
 (GRAPHNODE NODEPOSITION) of
 GNB)))
+                 (IPLUS (fetch
 YCOORD of
 TRANS)
+                        (SUB1 (GN/BOTTOM
 GNB)))
+                 (OR (LISTGET PARAMS 'LINEWIDTH)
+                     WIDTH 1)
+                 OPERATION STREAM (LISTGET PARAMS 'COLOR)
+                 (LISTGET PARAMS 'DASHING)
+                 PARAMS])
 
 (DISPLAYNODE

   [LAMBDA (NODE TRANS STREAM G TOSONLY)
                  (* kvl "10-Aug-84 19:08")

@@ -2014,7 +2027,7 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
                                                                                 of
 N])
 )
 
-                                                             (* Was MODERNIZE loaded before?)

+                                                             (* Was MODERNIZE loaded before?)

 
 (CL:WHEN (GETD 'MODERNWINDOW.SETUP)
     (MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE))
@@ -3075,7 +3088,7 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
 (RPAQQ GRAPH/HARDCOPY/FORMAT
 (MODE PORTRAIT PAGENUMBERS T TRANS NIL))
 
 (RPAQ? DEFAULT.GRAPH.WINDOWSIZE
 (LIST (TIMES SCREENWIDTH 0.7)
-                                          (TIMES SCREENHEIGHT 0.4)))
+                                      (TIMES SCREENHEIGHT 0.4)))
 
 (RPAQ? EDITGRAPHMENUCOMMANDS

        '((Move% Node 'MOVENODE "Moves a single node in the graph." (SUBITEMS (|Move Single Node|
@@ -3113,19 +3126,19 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
 (DECLARE%: EVAL@COMPILE
 
 (RECORD GRAPHNODE
 (NODEID NODEPOSITION NODELABELBITMAP NIL NODELABELSHADE NODEWIDTH NODEHEIGHT 
-                             TONODES FROMNODES NODEFONT NODELABEL NODEBORDER)
-                      NODEBORDER _ DEFAULT.GRAPH.NODEBORDER NODELABELSHADE _ 
-                      DEFAULT.GRAPH.NODELABELSHADE NODEFONT _ DEFAULT.GRAPH.NODEFONT)
+                         TONODES FROMNODES NODEFONT NODELABEL NODEBORDER)
+                  NODEBORDER _ DEFAULT.GRAPH.NODEBORDER NODELABELSHADE _ DEFAULT.GRAPH.NODELABELSHADE
+                  NODEFONT _ DEFAULT.GRAPH.NODEFONT)
 
-(RECORD GRAPH
 (GRAPHNODES SIDESFLG DIRECTEDFLG GRAPH.MOVENODEFN GRAPH.ADDNODEFN 
-                         GRAPH.DELETENODEFN GRAPH.ADDLINKFN GRAPH.DELETELINKFN GRAPH.FONTCHANGEFN 
-                         GRAPH.INVERTBORDERFN GRAPH.INVERTLABELFN GRAPH.CHANGELABELFN . GRAPH.PROPS))
+(RECORD GRAPH
 (GRAPHNODES SIDESFLG DIRECTEDFLG GRAPH.MOVENODEFN GRAPH.ADDNODEFN GRAPH.DELETENODEFN 
+                     GRAPH.ADDLINKFN GRAPH.DELETELINKFN GRAPH.FONTCHANGEFN GRAPH.INVERTBORDERFN 
+                     GRAPH.INVERTLABELFN GRAPH.CHANGELABELFN . GRAPH.PROPS))
 )
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS HALF
 MACRO
 ((X)
-                              (LRSH X 1)))
+                      (LRSH X 1)))
 )
 )
 
@@ -3789,61 +3802,59 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
 )
 
 (ADDTOVAR IMAGEOBJGETFNS
 (GRAPHOBJ.GETFN))
-(PUTPROPS GRAPHER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
-1992 1993 1994 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7195 111244 (ADD/AND/DISPLAY/LINK 7205 . 7907) (APPLYTOSELECTEDNODE 7909 . 8397) (
-CALL.MOVENODEFN 8399 . 8748) (CHANGE.NODEFONT.SIZE 8750 . 10062) (DEFAULT.ADDNODEFN 10064 . 10862) (
-DELETE/AND/DISPLAY/LINK 10864 . 12431) (DISPLAY/NAME 12433 . 12604) (DISPLAYGRAPH 12606 . 14977) (
-DISPLAYLINK 14979 . 17532) (DISPLAYLINK/BT 17534 . 18556) (DISPLAYLINK/LR 18558 . 19581) (
-DISPLAYLINK/RL 19583 . 20606) (DISPLAYLINK/TB 20608 . 21631) (DISPLAYNODE 21633 . 21981) (
-ERASE/GRAPHNODE 21983 . 23090) (DISPLAYNODE 23092 . 23440) (DISPLAYNODELINKS 23442 . 24586) (
-DRAW/GRAPHNODE/BORDER 24588 . 25507) (DRAWAREABOX 25509 . 26710) (EDITADDLINK 26712 . 27110) (
-EDITADDNODE 27112 . 29201) (EDITAPPLYTOLINK 29203 . 31282) (EDITCHANGEFONT 31284 . 32456) (
-EDITCHANGELABEL 32458 . 33999) (EDITDELETELINK 34001 . 34407) (EDITDELETENODE 34409 . 37110) (
-EDITGRAPH 37112 . 37179) (EDITGRAPH1 37181 . 37939) (EDITGRAPH2 37941 . 39672) (EDITMOVENODE 39674 . 
-41251) (EDITTOGGLEBORDER 41253 . 42549) (EDITTOGGLELABEL 42551 . 43848) (FILL/GRAPHNODE/LABEL 43850 . 
-44678) (FIX/SCALE 44680 . 45236) (FLIPNODE 45238 . 45842) (FONTNAMELIST 45844 . 46063) (FROMLINKS 
-46065 . 46235) (GETNODEFROMID 46237 . 47256) (GN/BOTTOM 47258 . 47534) (GN/LEFT 47536 . 47809) (
-GN/RIGHT 47811 . 48202) (GN/TOP 48204 . 48628) (GRAPHADDLINK 48630 . 49189) (GRAPHADDNODE 49191 . 
-49980) (GRAPHBUTTONEVENTFN 49982 . 52162) (GRAPHCHANGELABEL 52164 . 52607) (GRAPHDELETELINK 52609 . 
-53917) (GRAPHDELETENODE 53919 . 54451) (GRAPHEDITCOMMANDFN 54453 . 55837) (GRAPHEDITEVENTFN 55839 . 
-56550) (GRAPHER/CENTERPRINTINAREA 56552 . 57316) (GRAPHERPROP 57318 . 57862) (GRAPHNODE/BORDER/WIDTH 
-57864 . 58385) (GRAPHREGION 58387 . 59556) (HARDCOPYGRAPH 59558 . 66940) (INTERSECT/REGIONP/LBWH 66942
- . 68218) (INVERTED/GRAPHNODE/BORDER 68220 . 68804) (INVERTED/SHADE/FOR/GRAPHER 68806 . 69438) (
-LAYOUT/POSITION 69440 . 69619) (LINKPARAMETERS 69621 . 70073) (MAX/RIGHT 70075 . 70277) (MAX/TOP 70279
- . 70477) (MEASUREGRAPHNODE 70479 . 70928) (MEMBTONODES 70930 . 71455) (MIN/BOTTOM 71457 . 71838) (
-MIN/LEFT 71840 . 72215) (MOVENODE 72217 . 73460) (NODECREATE 73462 . 74242) (NODELST/AS/MENU 74244 . 
-75844) (NODEREGION 75846 . 76306) (PRINTDISPLAYNODE 76308 . 81366) (PROMPTINWINDOW 81368 . 84177) (
-READ/NODE 84179 . 85293) (REDISPLAYGRAPH 85295 . 85737) (REMOVETONODES 85739 . 86260) (
-RESET/NODE/BORDER 86262 . 88049) (RESET/NODE/LABELSHADE 88051 . 89566) (SCALE/GRAPH 89568 . 95854) (
-SCALE/GRAPHNODE/BORDER 95856 . 96551) (SCALE/TONODES 96553 . 97434) (SET/LABEL/SIZE 97436 . 100382) (
-SET/LAYOUT/POSITION 100384 . 100869) (SHOWGRAPH 100871 . 102670) (SIZE/GRAPH/WINDOW 102672 . 106156) (
-TOGGLE/DIRECTEDFLG 106158 . 106788) (TOGGLE/SIDESFLG 106790 . 107278) (TOLINKS 107280 . 107446) (
-TRACKCURSOR 107448 . 108855) (TRACKNODE 108857 . 109493) (TRANSGRAPH 109495 . 111242)) (111485 128102 
-(EDITMOVEREGION 111495 . 115298) (EDITMOVESUBTREE 115300 . 117077) (NOT.TRACKCURSOR 117079 . 120057) (
-RECURSIVE.COLLECTDESCENDENTS 120059 . 121547) (MOVEDESCENDENTS 121549 . 123611) (COLLECT.CHILD.NODES 
-123613 . 124729) (CREATE.NEW.NODEPOSITION 124731 . 125271) (GETBOXPOSITION.FROMINITIALREGION 125273 . 
-126745) (COLLECTDESCENDENTS 126747 . 128100)) (128166 130455 (NEXTSIZEFONT 128176 . 129366) (
-DECREASING.FONT.LIST 129368 . 129694) (SCALE.FONT 129696 . 130453)) (130679 169831 (BRH/LAYOUT 130689
- . 132433) (BRH/LAYOUT/DAUGHTERS 132435 . 133381) (BRH/OFFSET 133383 . 134061) (BRHC/INTERTREE/SPACE 
-134063 . 135381) (BRHC/LAYOUT 135383 . 137239) (BRHC/LAYOUT/DAUGHTERS 137241 . 140195) (
-BRHC/LAYOUT/TERMINAL 140197 . 140878) (BRHC/OFFSET 140880 . 141776) (BRHL/LAYOUT 141778 . 144002) (
-BRHL/LAYOUT/DAUGHTERS 144004 . 145762) (BRHL/MOVE/RIGHT 145764 . 146907) (BROWSE/LAYOUT/HORIZ 146909
- . 147633) (BROWSE/LAYOUT/HORIZ/COMPACTLY 147635 . 150441) (BROWSE/LAYOUT/LATTICE 150443 . 151299) (
-BRV/OFFSET 151301 . 152164) (EXTEND/TRANSITION/CHAIN 152166 . 153437) (FOREST/BREAK/CYCLES 153439 . 
-154369) (INIT/NODES/FOR/LAYOUT 154371 . 155866) (INTERPRET/MARK/FORMAT 155868 . 157135) (
-LATTICE/BREAK/CYCLES 157137 . 157841) (LAYOUTFOREST 157843 . 158544) (LAYOUTGRAPH 158546 . 162013) (
-LAYOUTLATTICE 162015 . 163468) (LAYOUTSEXPR 163470 . 164541) (LAYOUTSEXPR1 164543 . 165245) (
-MARK/GRAPH/NODE 165247 . 165977) (NEW/INSTANCE/OF/GRAPHNODE 165979 . 167348) (RAISE/TRANSITION/CHAIN 
-167350 . 167751) (REFLECT/GRAPH/DIAGONALLY 167753 . 168482) (REFLECT/GRAPH/HORIZONTALLY 168484 . 
-169010) (REFLECT/GRAPH/VERTICALLY 169012 . 169536) (SWITCH/NODE/HEIGHT/WIDTH 169538 . 169829)) (173177
- 174528 (GRAPHERIMAGEFNS 173187 . 174526)) (174529 176257 (GRAPHERCOPYBUTTONEVENTFN 174539 . 175518) (
-GRAPHOBJ.FINDGRAPH 175520 . 176255)) (176258 178878 (ALIGNMENTNODE 176268 . 177690) (
-GRAPHOBJ.CHECKALIGN 177692 . 178876)) (178879 194729 (GRAPHEROBJ 178889 . 180635) (
-GRAPHOBJ.BUTTONEVENTINFN 180637 . 182064) (GRAPHOBJ.COPYBUTTONEVENTFN 182066 . 182503) (
-GRAPHOBJ.COPYFN 182505 . 183429) (GRAPHOBJ.DISPLAYFN 183431 . 186246) (GRAPHOBJ.GETALIGN 186248 . 
-186987) (GRAPHOBJ.GETFN 186989 . 188494) (GRAPHOBJ.IMAGEBOXFN 188496 . 192512) (GRAPHOBJ.PUTALIGN 
-192514 . 193344) (GRAPHOBJ.PUTFN 193346 . 194727)) (194730 213882 (COPYGRAPH 194740 . 196288) (
-DUMPGRAPH 196290 . 206546) (READGRAPH 206548 . 213880)))))
+  (FILEMAP (NIL (7149 112538 (ADD/AND/DISPLAY/LINK 7159 . 7861) (APPLYTOSELECTEDNODE 7863 . 8351) (
+CALL.MOVENODEFN 8353 . 8702) (CHANGE.NODEFONT.SIZE 8704 . 10016) (DEFAULT.ADDNODEFN 10018 . 10816) (
+DELETE/AND/DISPLAY/LINK 10818 . 12385) (DISPLAY/NAME 12387 . 12558) (DISPLAYGRAPH 12560 . 14931) (
+DISPLAYLINK 14933 . 17486) (DISPLAYLINK/BT 17488 . 18845) (DISPLAYLINK/LR 18847 . 20205) (
+DISPLAYLINK/RL 20207 . 21565) (DISPLAYLINK/TB 21567 . 22925) (DISPLAYNODE 22927 . 23275) (
+ERASE/GRAPHNODE 23277 . 24384) (DISPLAYNODE 24386 . 24734) (DISPLAYNODELINKS 24736 . 25880) (
+DRAW/GRAPHNODE/BORDER 25882 . 26801) (DRAWAREABOX 26803 . 28004) (EDITADDLINK 28006 . 28404) (
+EDITADDNODE 28406 . 30495) (EDITAPPLYTOLINK 30497 . 32576) (EDITCHANGEFONT 32578 . 33750) (
+EDITCHANGELABEL 33752 . 35293) (EDITDELETELINK 35295 . 35701) (EDITDELETENODE 35703 . 38404) (
+EDITGRAPH 38406 . 38473) (EDITGRAPH1 38475 . 39233) (EDITGRAPH2 39235 . 40966) (EDITMOVENODE 40968 . 
+42545) (EDITTOGGLEBORDER 42547 . 43843) (EDITTOGGLELABEL 43845 . 45142) (FILL/GRAPHNODE/LABEL 45144 . 
+45972) (FIX/SCALE 45974 . 46530) (FLIPNODE 46532 . 47136) (FONTNAMELIST 47138 . 47357) (FROMLINKS 
+47359 . 47529) (GETNODEFROMID 47531 . 48550) (GN/BOTTOM 48552 . 48828) (GN/LEFT 48830 . 49103) (
+GN/RIGHT 49105 . 49496) (GN/TOP 49498 . 49922) (GRAPHADDLINK 49924 . 50483) (GRAPHADDNODE 50485 . 
+51274) (GRAPHBUTTONEVENTFN 51276 . 53456) (GRAPHCHANGELABEL 53458 . 53901) (GRAPHDELETELINK 53903 . 
+55211) (GRAPHDELETENODE 55213 . 55745) (GRAPHEDITCOMMANDFN 55747 . 57131) (GRAPHEDITEVENTFN 57133 . 
+57844) (GRAPHER/CENTERPRINTINAREA 57846 . 58610) (GRAPHERPROP 58612 . 59156) (GRAPHNODE/BORDER/WIDTH 
+59158 . 59679) (GRAPHREGION 59681 . 60850) (HARDCOPYGRAPH 60852 . 68234) (INTERSECT/REGIONP/LBWH 68236
+ . 69512) (INVERTED/GRAPHNODE/BORDER 69514 . 70098) (INVERTED/SHADE/FOR/GRAPHER 70100 . 70732) (
+LAYOUT/POSITION 70734 . 70913) (LINKPARAMETERS 70915 . 71367) (MAX/RIGHT 71369 . 71571) (MAX/TOP 71573
+ . 71771) (MEASUREGRAPHNODE 71773 . 72222) (MEMBTONODES 72224 . 72749) (MIN/BOTTOM 72751 . 73132) (
+MIN/LEFT 73134 . 73509) (MOVENODE 73511 . 74754) (NODECREATE 74756 . 75536) (NODELST/AS/MENU 75538 . 
+77138) (NODEREGION 77140 . 77600) (PRINTDISPLAYNODE 77602 . 82660) (PROMPTINWINDOW 82662 . 85471) (
+READ/NODE 85473 . 86587) (REDISPLAYGRAPH 86589 . 87031) (REMOVETONODES 87033 . 87554) (
+RESET/NODE/BORDER 87556 . 89343) (RESET/NODE/LABELSHADE 89345 . 90860) (SCALE/GRAPH 90862 . 97148) (
+SCALE/GRAPHNODE/BORDER 97150 . 97845) (SCALE/TONODES 97847 . 98728) (SET/LABEL/SIZE 98730 . 101676) (
+SET/LAYOUT/POSITION 101678 . 102163) (SHOWGRAPH 102165 . 103964) (SIZE/GRAPH/WINDOW 103966 . 107450) (
+TOGGLE/DIRECTEDFLG 107452 . 108082) (TOGGLE/SIDESFLG 108084 . 108572) (TOLINKS 108574 . 108740) (
+TRACKCURSOR 108742 . 110149) (TRACKNODE 110151 . 110787) (TRANSGRAPH 110789 . 112536)) (112779 129396 
+(EDITMOVEREGION 112789 . 116592) (EDITMOVESUBTREE 116594 . 118371) (NOT.TRACKCURSOR 118373 . 121351) (
+RECURSIVE.COLLECTDESCENDENTS 121353 . 122841) (MOVEDESCENDENTS 122843 . 124905) (COLLECT.CHILD.NODES 
+124907 . 126023) (CREATE.NEW.NODEPOSITION 126025 . 126565) (GETBOXPOSITION.FROMINITIALREGION 126567 . 
+128039) (COLLECTDESCENDENTS 128041 . 129394)) (129460 131749 (NEXTSIZEFONT 129470 . 130660) (
+DECREASING.FONT.LIST 130662 . 130988) (SCALE.FONT 130990 . 131747)) (131973 171125 (BRH/LAYOUT 131983
+ . 133727) (BRH/LAYOUT/DAUGHTERS 133729 . 134675) (BRH/OFFSET 134677 . 135355) (BRHC/INTERTREE/SPACE 
+135357 . 136675) (BRHC/LAYOUT 136677 . 138533) (BRHC/LAYOUT/DAUGHTERS 138535 . 141489) (
+BRHC/LAYOUT/TERMINAL 141491 . 142172) (BRHC/OFFSET 142174 . 143070) (BRHL/LAYOUT 143072 . 145296) (
+BRHL/LAYOUT/DAUGHTERS 145298 . 147056) (BRHL/MOVE/RIGHT 147058 . 148201) (BROWSE/LAYOUT/HORIZ 148203
+ . 148927) (BROWSE/LAYOUT/HORIZ/COMPACTLY 148929 . 151735) (BROWSE/LAYOUT/LATTICE 151737 . 152593) (
+BRV/OFFSET 152595 . 153458) (EXTEND/TRANSITION/CHAIN 153460 . 154731) (FOREST/BREAK/CYCLES 154733 . 
+155663) (INIT/NODES/FOR/LAYOUT 155665 . 157160) (INTERPRET/MARK/FORMAT 157162 . 158429) (
+LATTICE/BREAK/CYCLES 158431 . 159135) (LAYOUTFOREST 159137 . 159838) (LAYOUTGRAPH 159840 . 163307) (
+LAYOUTLATTICE 163309 . 164762) (LAYOUTSEXPR 164764 . 165835) (LAYOUTSEXPR1 165837 . 166539) (
+MARK/GRAPH/NODE 166541 . 167271) (NEW/INSTANCE/OF/GRAPHNODE 167273 . 168642) (RAISE/TRANSITION/CHAIN 
+168644 . 169045) (REFLECT/GRAPH/DIAGONALLY 169047 . 169776) (REFLECT/GRAPH/HORIZONTALLY 169778 . 
+170304) (REFLECT/GRAPH/VERTICALLY 170306 . 170830) (SWITCH/NODE/HEIGHT/WIDTH 170832 . 171123)) (174438
+ 175789 (GRAPHERIMAGEFNS 174448 . 175787)) (175790 177518 (GRAPHERCOPYBUTTONEVENTFN 175800 . 176779) (
+GRAPHOBJ.FINDGRAPH 176781 . 177516)) (177519 180139 (ALIGNMENTNODE 177529 . 178951) (
+GRAPHOBJ.CHECKALIGN 178953 . 180137)) (180140 195990 (GRAPHEROBJ 180150 . 181896) (
+GRAPHOBJ.BUTTONEVENTINFN 181898 . 183325) (GRAPHOBJ.COPYBUTTONEVENTFN 183327 . 183764) (
+GRAPHOBJ.COPYFN 183766 . 184690) (GRAPHOBJ.DISPLAYFN 184692 . 187507) (GRAPHOBJ.GETALIGN 187509 . 
+188248) (GRAPHOBJ.GETFN 188250 . 189755) (GRAPHOBJ.IMAGEBOXFN 189757 . 193773) (GRAPHOBJ.PUTALIGN 
+193775 . 194605) (GRAPHOBJ.PUTFN 194607 . 195988)) (195991 215143 (COPYGRAPH 196001 . 197549) (
+DUMPGRAPH 197551 . 207807) (READGRAPH 207809 . 215141)))))
 STOP

library/UNICODE-TABLES

@@ -1,19 +1,19 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
 
-
(FILECREATED "22-Oct-2025 23:28:42" {WMEDLEY}<library>UNICODE-TABLES.;4
 34028  
+
(FILECREATED "31-Mar-2026 09:01:05" {WMEDLEY}<library>UNICODE-TABLES.;22
 44782  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS UNICODE-TABLESCOMS)
+      :CHANGES-TO (VARS XCCS-CHARSETS)
 
-      :PREVIOUS-DATE "16-Oct-2025 16:47:54" {WMEDLEY}<library>UNICODE-TABLES.;3)
+      :PREVIOUS-DATE "22-Feb-2026 10:44:33" {WMEDLEY}<library>UNICODE-TABLES.;20)
 
 
 (PRETTYCOMPRINT UNICODE-TABLESCOMS)
 
 (RPAQQ UNICODE-TABLESCOMS

        [
-        (* ;; "Read Unicode mapping tables.  A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ.  This file has to come before UNICODE in the loadup sequence.")

+        (* ;; "This is code for reading/writing the XCCS-to-UNICODE mapping tables.  It runs offline, when UNICODE-UTF8 is modified.  ")

 
         (COMS                                                (* ; "Read Unicode mapping files")

               (INITVARS (UNICODEDIRECTORIES NIL))
@@ -22,22 +22,32 @@
               (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING))
         (COMS                                                (* ; 
 
                                                  "Make translation tables for  UTF external formats")

-              (FNS MAKE-UNICODE-TRANSLATION-TABLES XCCSTOMCCS-MAPPING 
-                   MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION?)
+              (FNS MAKE-UNICODE-TRANSLATION-TABLES GET-MCCS-UNICODE-MAPPING INVERT-UNICODE-MAPPING 
+                   XCCSTOMCCS-MAPPING)
               (FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
-              (INITVARS (*MCCSTOUNICODE*)
-                     (*UNICODETOMCCS*)
-                     (*MCCS-LOADED-CHARSETS*)
-                     (*UNICODE-LOADED-CHARSETS*)
-                     (*LARGEUNICODES*))
-              [DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL]
+              (COMS                                          (* ; "Write Unicode mapping files")

+                    (FNS WRITE-UNICODE-MAPPING WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER 
+                         WRITE-UNICODE-MAPPING-FILENAME)
+                    (FNS XCCS-UTF8-AFTER-OPEN)
+                    
+                    (* ;; "Automate dumping of a documentation prefix")

+
+                    [DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE"
+                                                                                    :RADIX 16))
+                                                            (UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" 
+                                                                                  :RADIX 16]
+                    (VARS UNICODE-MAPPING-HEADER))
+              (FNS UTF8HEXSTRING)
+              (COMS                                          (* ; "debugging")

+                    (FNS SHOWCHARS)
+                    (DECLARE%: DOEVAL@LOAD DONTCOPY (MACROS HEXCHAR OCTALCHAR)))
               (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
                                                       UNICODE-EXPORTS])
 
 
 
 (* ;; 
-"Read Unicode mapping tables.  A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ.  This file has to come before UNICODE in the loadup sequence."
+"This is code for reading/writing the XCCS-to-UNICODE mapping tables.  It runs offline, when UNICODE-UTF8 is modified.  "
 )

 
 
@@ -65,8 +75,9 @@
         (RUNIC-GOTHIC "51")
         (MORE-CYRILLIC "52")
         (UNKNOWN1 "56")
+        (DECORATED-RULES "56")
         (UNKNOWN2 "57")
-        (JIS "60-166")
+        (VERTICAL-JAPANESE "57")
         (ARABIC "340")
         (HEBREW "341")
         (IPA "342")
@@ -88,13 +99,15 @@
         (ACCENTED-GREEK2 "364")
         (MORE-ARABIC "365")
         (GRAPHIC-VARIANTS "375")
+        (JAPANESE HIRAGANA KATAKANA JIS)
         (DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1 
                JAPANESE-SYMBOLS2)
-        (JAPANESE HIRAGANA KATAKANA JIS)))
+        (JIS "60-166")))
 (DEFINEQ
 
 (READ-UNICODE-MAPPING-FILENAMES

-  [LAMBDA (FILESPEC)
                                         (* ; "Edited 16-Oct-2025 16:43 by rmk")


+  [LAMBDA (FILESPEC)
                                         (* ; "Edited 21-Feb-2026 18:14 by rmk")


+                                                             (* ; "Edited 16-Oct-2025 16:43 by rmk")


                                                              (* ; "Edited  4-Sep-2025 00:11 by rmk")


                                                              (* ; "Edited 27-Jan-2025 16:46 by rmk")


                                                              (* ; "Edited 21-Jan-2025 22:51 by rmk")


@@ -107,51 +120,47 @@
 
     (* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or a list of those. Maps those into the names of files that contain the indicated Unicode mappings.")

 
-    (CL:REMOVE-DUPLICATES [for
 F X CSI inside
 (if
 (EQ FILESPEC 'ALL)
-                                                  then
 
-                                                       (* ;; 
+    (for
 F X CSI inside
 (if
 (EQ FILESPEC 'ALL)
+                            then
 
+                                 (* ;; 
 
          "Perhaps should figure out which files in the directories and subdirectories are relevant?")

 
-                                                       (for
 N in
 XCCS-CHARSETS
-                                                          collect
 (CAR N))
-                                                else
 FILESPEC)
-                             join
 
-                                  (* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)")

+                                 (for
 N in
 XCCS-CHARSETS collect
 (CAR N))
+                          else
 FILESPEC)
+       join
 
+            (* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)")

 
-                                  (OR (CL:WHEN (CHARCODEP F) (* ; 
+            [OR (CL:WHEN (CHARCODEP F)                       (* ; 
 
                                                        "An XCCS code can retrieve its character set")

-                                          (for
 D FN (FOCTAL _ (OCTALSTRING (LRSH F 8))) inside
 
-                                                                                   UNICODEDIRECTORIES
-                                             when
 (SETQ FN (FILDIR (PACKFILENAME 'DIRECTORY D
-                                                                          'BODY
-                                                                          (CONCAT 'XCCS- FOCTAL
-                                                                                 '=*)
-                                                                          'EXTENSION
-                                                                          'TXT
-                                                                          'VERSION "")))
-                                             do
 (RETURN FN)))
-                                      (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT
-                                                               'VERSION "")
-                                                     T UNICODEDIRECTORIES))
-                                      (for
 D inside
 UNICODEDIRECTORIES
-                                         when
 [SETQ $$VAL (OR (FILDIR (PACKFILENAME 'NAME
-                                                                             (CONCAT "XCCS-*=" F)
-                                                                             'EXTENSION
-                                                                             'TXT
-                                                                             'VERSION "" 'BODY D))
-                                                              (FILDIR (PACKFILENAME 'NAME
-                                                                             (CONCAT "XCCS-" F "=*")
-                                                                             'EXTENSION
-                                                                             'TXT
-                                                                             'VERSION "" 'BODY D]
-                                         do
 (RETURN $$VAL))
-                                      (AND (SETQ CSI (ASSOC F XCCS-CHARSETS))
-                                           (READ-UNICODE-MAPPING-FILENAMES
 (CDR CSI)))
-                                      (for
 D inside
 UNICODEDIRECTORIES
-                                         when
 (DIRECTORYNAMEP (SETQ D (CONCAT D ">" F ">")))
-                                         join
 (FILDIR (CONCAT D ">*.TXT;"]
-           :TEST
-           (FUNCTION STRING.EQUAL])
+                    (for
 D FN (FOCTAL ← (OCTALSTRING (LRSH F 8))) inside
 UNICODEDIRECTORIES
+                       when
 (SETQ FN (DIRECTORY (PACKFILENAME 'DIRECTORY D 'BODY (CONCAT 'XCCS- 
+                                                                                        FOCTAL
+                                                                                        '=*)
+                                                       'EXTENSION
+                                                       'TXT
+                                                       'VERSION ""))) do
 (RETURN FN)))
+                (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT 'VERSION "")
+                               T UNICODEDIRECTORIES))
+                (for
 D inside
 UNICODEDIRECTORIES
+                   when
 [SETQ $$VAL (OR (DIRECTORY (PACKFILENAME 'NAME (CONCAT "XCCS-*=" F)
+                                                          'EXTENSION
+                                                          'TXT
+                                                          'VERSION "" 'BODY D))
+                                        (DIRECTORY (PACKFILENAME 'NAME (CONCAT "XCCS-" F "=*")
+                                                          'EXTENSION
+                                                          'TXT
+                                                          'VERSION "" 'BODY D]
+                   do
 (RETURN $$VAL))
+                (AND (SETQ CSI (ASSOC F XCCS-CHARSETS))
+                     (READ-UNICODE-MAPPING-FILENAMES
 (CDR CSI)))
+                (for
 D inside
 UNICODEDIRECTORIES when
 (DIRECTORYNAMEP (SETQ D
+                                                                       (CONCAT D ">" F ">")))
+                   join
 (DIRECTORY (CONCAT D ">*.TXT;"]
+       finally
                                               (* ; 
+
                                                     "CL:REMOVE-DUPLICATES doesn't exist in MAKEINIT")

+             (RETURN (for
 FTAIL on
 $$VAL unless
 (thereis
 FF in
 (CDR FTAIL)
+                                                   suchthat
 (STRING-EQUAL (CAR FTAIL)
+                                                                   FF)) collect
 (CAR FTAIL])
 
 (READ-UNICODE-MAPPING

   [LAMBDA (FILESPEC PRINT NOERROR)
                           (* ; "Edited 16-Oct-2025 11:25 by rmk")


@@ -179,7 +188,7 @@
     (* ;; "")

 
     (RESETLST
-        (for
 FILE STREAM [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] in
 (
+        (for
 FILE STREAM [SEPBITTABLE ← (MAKEBITTABLE (CHARCODE (TAB SPACE] in
 (
 
                                                                       READ-UNICODE-MAPPING-FILENAMES

                                                                                 FILESPEC)
            join
 
@@ -221,7 +230,8 @@
 (DEFINEQ
 
 (MAKE-UNICODE-TRANSLATION-TABLES

-  [LAMBDA (MAPPING REINSTALL)
                                (* ; "Edited 11-Oct-2025 11:54 by rmk")


+  [LAMBDA (MAPPING REINSTALL)
                                (* ; "Edited 21-Feb-2026 22:42 by rmk")


+                                                             (* ; "Edited 11-Oct-2025 11:54 by rmk")


                                                              (* ; "Edited  4-Sep-2025 00:30 by rmk")


                                                              (* ; "Edited 24-Apr-2025 15:47 by rmk")


                                                              (* ; "Edited 31-Jan-2025 17:46 by rmk")


@@ -232,26 +242,13 @@
                                                              (* ; "Edited  3-Feb-2024 00:24 by rmk")


                                                              (* ; "Edited 30-Jan-2024 09:54 by rmk")


                                                             (* ; "Edited 21-Aug-2021 13:12 by rmk:")

+    (SETQ MAPPING (GET-MCCS-UNICODE-MAPPING
 MAPPING))
 
-    (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to XCCS-to-Unicode mapping files. This applies the XCCS-to-MCCS translations, and then updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")

-
                                                            (* ; "Edited 17-Aug-2020 08:46 by rmk:")

-    (CL:UNLESS [AND (LISTP MAPPING)
-                    (FOR
 PAIR R IN
 MAPPING AS
 I TO
 10
-                       ALWAYS
 (AND (LISTP PAIR)
-                                   (CHARCODEP (CAR PAIR))
-                                   [FIXP (SETQ R (CAR (MKLIST (CADR PAIR]
-                                   (CHARCODEP (IABS R]
-
-        (* ;; "Seems like the argument is not already a list of mapping pairs (perhaps with a combiner), presumably a list of charsets to be read.")

-
-        (SETQ MAPPING (READ-UNICODE-MAPPING
 MAPPING)))
-    (SETQ MAPPING (XCCSTOMCCS-MAPPING
 MAPPING))
-
-    (* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).")

+    (* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS  to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")

 
     (* ;; "")

 
-    (* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *XCCSTOUNICODE* and *UNICODETOXCCS* global variables.  Otherwise we create new tables (mostly for comparison and debugging).")

+    (* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *MCCSTOUNICODE* and *UNICODETOMCCS* global variables.  Otherwise we create new tables (mostly for comparison and debugging).")

 
     (* ;; "")

 
@@ -270,6 +267,55 @@
                (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
            (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING])
 
+(GET-MCCS-UNICODE-MAPPING

+  [LAMBDA (MAPPING)
                                          (* ; "Edited 22-Feb-2026 00:29 by rmk")

+
+    (* ;; "MAPPING is the list of numeric code correspondence pairs mapping MCCS-to-Unicode, or a specification of XCCS-to-Unicode files to be read and converted to MCCS-to-UNICODE.")

+
+    (SORT (if
 [AND (LISTP MAPPING)
+                   (for
 PAIR R in
 MAPPING as
 I to
 10
+                      always
 (AND (LISTP PAIR)
+                                  (CHARCODEP (CAR PAIR))
+                                  [FIXP (SETQ R (CAR (MKLIST (CADR PAIR]
+                                  (CHARCODEP (IABS R]
+              then
 
+                   (* ;; "The argument is already a list of MCCS-to-UNICODE mapping pairs")

+
+                   MAPPING
+            else
 
+                 (* ;; "Mapping files are is read as XCCS-UNICODE, make it MCCS")

+
+                 (XCCSTOMCCS-MAPPING
 (READ-UNICODE-MAPPING
 MAPPING)))
+          T])
+
+(INVERT-UNICODE-MAPPING

+  [LAMBDA (MAPPING)
                                          (* ; "Edited 22-Feb-2026 00:39 by rmk")

+
+    (* ;; "MAPPING is a list of pairs that map domain codes to range codes (presumably MCCS to UNICODE).  This produces an inverted list of pairs that map the range into the domain (Unicode to MCCS)   ")

+
+    (LET (INVERTED)
+         (SETQ INVERTED (SORT (for
 P D R OLDR in
 MAPPING eachtime
 (SETQ D (CAR P))
+                                                               (SETQ R (CADR P)) 
+
+                                                               (* ;; 
+
                                            "We don't do combiners, but we are allowing non-SMALLP's")

+ unless
 (OR (LISTP D)
+            (LISTP R)) collect
 (LIST R D))
+                              T))
+
+         (* ;; "If MAPPING contains two pairs that map to the same U (e.g. (M1 U) and (M2 U)), we want the inverse table to collect them into a single pair (U M1 M2) instead of two pairs (U M1) (U M2), with the lowest M code first. Those pairs represent alternative inverse mappings. There are no duplicates/alternative table entries in the M-to-U direction.")

+
+         (* ;; "The SORT above means that multiple inverted pairs for the same U will be next to each other in the list.")

+
+         [for
 PTAIL PTAIL2 U MS on
 INVERTED eachtime
 (SETQ U (CAAR PTAIL))
+            when
 (SETQ MS (for
 old
 PTAIL2 P2 on
 PTAIL eachtime
 (SETQ P2 (CADR PTAIL2))
+                             while
 (EQ U (CAR P2)) collect
 (CADR P2)))
+            do
 (RPLACD PTAIL (CDR PTAIL2))
+               (RPLACD (CAR PTAIL)
+                      (SORT (CONS (CADR (CAR PTAIL))
+                                  MS]
+         INVERTED])
+
 (XCCSTOMCCS-MAPPING

   [LAMBDA (XTOUMAPPING)
                                      (* ; "Edited 11-Oct-2025 12:57 by rmk")

 
@@ -292,152 +338,12 @@
                                                          XTOMCODES)))
              finally
 (push
 XTOUMAPPING (CHARCODE (DEL DEL)))
                    (RETURN XTOUMAPPING])
-
-(MERGE-UNICODE-TRANSLATION-TABLES

-  [LAMBDA (INVERSE MAPPING TABLE INVERSETABLE)
               (* ; "Edited 11-Oct-2025 10:24 by rmk")


-                                                             (* ; "Edited 24-Apr-2025 15:28 by rmk")


-                                                             (* ; "Edited  1-Feb-2025 21:42 by rmk")


-                                                             (* ; "Edited 26-Jan-2025 12:58 by rmk")


-                                                             (* ; "Edited 22-Jan-2025 08:20 by rmk")


-                                                             (* ; "Edited 19-Jan-2025 15:58 by rmk")


-                                                             (* ; "Edited 18-Jan-2025 11:49 by rmk")


-                                                             (* ; "Edited 27-Mar-2024 12:10 by rmk")


-                                                             (* ; "Edited  3-Feb-2024 12:46 by rmk")


-                                                             (* ; "Edited 31-Jan-2024 10:06 by rmk")

-
-    (* ;; "MAPPINGS is a list of pairs that map domain codes to range codes.  TABLE and INVERSETABLE default to *MCCSTOUNICODE* *UNICODETOMCCS* respectively.   ")

-
-    (CL:UNLESS TABLE
-        [SETQ TABLE (OR *MCCSTOUNICODE* (SETQ *MCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING])
-    (CL:UNLESS INVERSETABLE
-        [SETQ INVERSETABLE (OR *UNICODETOMCCS* (SETQ *UNICODETOMCCS* (HASHARRAY (LENGTH MAPPING])
-    (for
 M D R OLDR in
 MAPPING first
 (CL:IF INVERSE (swap
 TABLE INVERSETABLE))
-       eachtime
 (SETQ D (CAR M))
-             (SETQ R (CADR M)) 
-
-             (* ;; "We don't do combiners, but we are allowing non-SMALLP's")

- unless
 (OR (LISTP D)
-            (LISTP R)) do
 
-                          (* ;; "The (CONS R OLDR) deals with alternatives:  (U X1) (U X2) => (U (X1 X2)), lowest code first.  Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.")

-
-                          (SETQ OLDR (GETHASH D TABLE))
-                          (CL:UNLESS (MEMB R OLDR)
-                              (PUTHASH D (SORT (CONS R OLDR))
-                                     TABLE))
-                          (swap
 D R)
-                          (SETQ OLDR (GETHASH D INVERSETABLE))
-                          (CL:UNLESS (MEMB R OLDR)
-                              (PUTHASH D (SORT (CONS R OLDR))
-                                     INVERSETABLE)))
-    (LIST TABLE INVERSETABLE])
-
-(UNICODE.UNMAPPED

-  [LAMBDA (CODE TABLE DONTFAKE)
                              (* ; "Edited 24-Apr-2025 15:48 by rmk")


-                                                             (* ; "Edited 22-Jan-2025 08:19 by rmk")


-                                                             (* ; "Edited 19-Jan-2025 22:02 by rmk")


-                                                             (* ; "Edited 18-Jan-2025 12:02 by rmk")


-                                                             (* ; "Edited  2-Feb-2024 23:52 by rmk")


-                                                             (* ; "Edited 31-Jan-2024 10:07 by rmk")


-                                                            (* ; "Edited 11-Aug-2020 20:23 by rmk:")

-
-    (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODE has no fast mapping in TRANSLATION-TABLE.")

-
-    (* ;; "")

-
-    (* ;; "If we have not already installed the mapping segment for that code, we try to retrieve it from the numberic file.  If that segment mapping doesn't exist or doesn't have an entry for CODE, we fake up a mapping with a negative range in both directions. One way or the other, there will be an entry for that segment in both mapping vectors.")

-
-    (* ;; "")

-
-    (PROG ((INVERSE (EQ TABLE *UNICODETOMCCS*))
-           RANGE HASH)
-
-     (* ;; "If we already looked up CODE's character set in a file, then we have already filled in its information in the translation table.  If it didn't have a code for a particular character, then we fake it here.  Faked codes are negative, so we can detect them easily, and interpret them with IABS.")

-
-          (CL:WHEN (AND (UNICODE-EXTEND-TRANSLATION?
 CODE TABLE)
-                        (SETQ RANGE (GETHASH CODE TABLE)))
-
-              (* ;; "We might have gotten the segment that didn't have an entry for CODE.")

-
-              (RETURN RANGE))
-
-     (* ;; "")

-
-          (CL:UNLESS DONTFAKE
-
-              (* ;; "Our attempt at extending the known tables did not provide a mapping for CODE.  So we fake it up with the next unused private code in the code space.  ")

-
-              (* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the MCCS character space is pretty sparse.  The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables.  The last available codes are constants.")

-
-              (CL:WHEN (IEQP *NEXT-PRIVATE-MCCSCODE* LAST-PRIVATE-MCCSCODE)
-                                                             (* ; 
-
                                                           "Same number of available codes both ways")

-                  (ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES"))
-              (if
 INVERSE
-                  then
 (SETQ RANGE *NEXT-PRIVATE-MCCSCODE*)
-                       (add
 *NEXT-PRIVATE-MCCSCODE* 1)
-                else
 (SETQ RANGE *NEXT-PRIVATE-UNICODE*)
-                     (add
 *NEXT-PRIVATE-UNICODE* 1))
-              (MERGE-UNICODE-TRANSLATION-TABLES
 INVERSE (CONS (LIST CODE RANGE)))
-
-              (* ;; "CONS because of LIST convention so we can eventually distinguish combiners.")

-
-              (RETURN (CONS RANGE)))])
-
-(UNICODE-EXTEND-TRANSLATION?

-  [LAMBDA (CODE TABLE)
                                       (* ; "Edited 11-Oct-2025 09:49 by rmk")


-                                                             (* ; "Edited  4-Sep-2025 00:34 by rmk")


-                                                             (* ; "Edited 29-Jun-2025 16:44 by rmk")


-                                                             (* ; "Edited 24-Apr-2025 15:49 by rmk")


-                                                             (* ; "Edited 26-Jan-2025 11:26 by rmk")


-                                                             (* ; "Edited 21-Jan-2025 22:31 by rmk")


-                                                             (* ; "Edited 18-Jan-2025 12:40 by rmk")


-                                                             (* ; "Edited 13-Jan-2025 23:50 by rmk")


-                                                             (* ; "Edited 26-Aug-2024 16:49 by rmk")


-                                                             (* ; "Edited 27-Mar-2024 23:02 by rmk")


-                                                             (* ; "Edited  5-Feb-2024 13:48 by rmk")


-                                                             (* ; "Edited  3-Feb-2024 12:40 by rmk")

-
-    (* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an MCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ")

-
-    (* ;; "We record which character sets we have already expanded so we don't do them again.")

-
-    (LET ((CHARSET (\CHARSET CODE))
-          (INVERSE (EQ TABLE *UNICODETOMCCS*))
-          MAPPING FILE)
-
-         (* ;; "If we already looked for CHARSET in the file and found anything, it has already been merged. Otherwise, it would just fail again")

-
-         (CL:UNLESS (MEMB CHARSET (CL:IF INVERSE
-                                      *UNICODE-LOADED-CHARSETS*
-                                      *MCCS-LOADED-CHARSETS*))
-
-             (* ;; "Don't try this charset again.")

-
-             (CL:IF INVERSE
-                 (push
 *UNICODE-LOADED-CHARSETS* CHARSET)
-                 (push
 *MCCS-LOADED-CHARSETS* CHARSET))
-             (SETQ FILE (FINDFILE (CL:IF INVERSE
-                                      'UNICODE-TO-MCCS-MAPPINGS
-                                      'MCCS-TO-UNICODE-MAPPINGS)
-                               T UNICODEDIRECTORIES))
-
-             (* ;; "The mappings files are indexed by CHARSET.")

-
-             (CL:WHEN [AND FILE (SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT)
-                                                     (CL:WHEN (FILEPOS (CONCAT "[" CHARSET " ")
-                                                                     STREAM NIL NIL NIL T)
-                                                            (READ STREAM]
-
-                 (* ;; 
-
                 "Merge MAPPING into both tables, respecting the direction indicated by TABLE. ")

-
-                 (MERGE-UNICODE-TRANSLATION-TABLES
 INVERSE MAPPING)
-                 T))])
 )
 (DEFINEQ
 
 (ALL-UNICODE-MAPPINGS

-  [LAMBDA (INVERTED FILE)
                                    (* ; "Edited 24-Apr-2025 15:51 by rmk")


+  [LAMBDA (INVERTED FILE)
                                    (* ; "Edited 22-Feb-2026 10:42 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:51 by rmk")


                                                              (* ; "Edited 31-Jan-2025 17:46 by rmk")


                                                              (* ; "Edited 26-Jan-2025 13:40 by rmk")


                                                              (* ; "Edited 22-Jan-2025 14:07 by rmk")


@@ -453,38 +359,32 @@
     (* ;; "The first index level segments all the domain codes according to their character sets.  The segments are sorted by character set, the pairs within each segment are sorted by their domain codes.  ")

 
     (* ;; 
-
    "E.g. if INVERTED=NIL and given a XCCS code, the lookup for the corresponding Unicode(s) is")

+
    "E.g. if INVERTED=NIL and given a MCCS code, the lookup for the corresponding Unicode(s) is")

 
-    (* ;; "    (CADR (ASSOC MCCSCODE (\CHARSET MCCSCODE) INDEX)))).")

+    (* ;; "   (CAR (GETMULTI  INDEX  (\CHARSET MCCSCODE)  MCCSCODE).")

 
     (* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.")

 
-    (LET (INDEX)
-         (for
 PAIR DOMAIN RANGE CHARSET in
 (READ-UNICODE-MAPPING
 'ALL) eachtime
 (SETQ DOMAIN
-                                                                                 (CAR PAIR))
-                                                                             (SETQ RANGE (CADR PAIR))
-                                                                             
-                                                                             (* ;; 
-
                                                      "(LISTP RANGE) is a combiner, ignored for now.")

- unless
 (LISTP RANGE) do
 (CL:WHEN INVERTED (SWAP
 DOMAIN RANGE)) 
+    (LET [INDEX (MAPPING (GET-MCCS-UNICODE-MAPPING
 'ALL]
+         (for
 PAIR in
 (CL:IF INVERTED
+                          (INVERT-UNICODE-MAPPING
 MAPPING)
+                          MAPPING) unless
 (LISTP (CADR PAIR)) do
 
+                                                                 (* ;; 
+
                                                 "(LISTP (CADR PAIR) is a combiner, ignored for now.")

 
-                         (* ;; 
+                                                     (* ;; 
 
       "One segment for each high-byte character set.   This aligns with UNICODE-EXTEND.TRANSLATION?")

 
-                         [SETQ CHARSET (OR (ASSOC (\CHARSET DOMAIN)
-                                                  INDEX)
-                                           (CAR (push
 INDEX (CONS (\CHARSET DOMAIN] 
+                                 (* ;; "For alternative mappings (in the U-to-M direction) we end up with  (D R1 R2 ...).  (CAR (GETMULTI)) is the first (and almost always) the only one.")

 
-                         (* ;; "For alternative mappings (in the U-to-M direction) we end up with  (D R1 R2 ...).  (CADR is the first (and almost always) the only one.")

-
-                         (pushnew
 [CDR (OR (ASSOC DOMAIN (CDR CHARSET))
-                                           (CAR (push
 (CDR CHARSET)
-                                                      (CONS DOMAIN]
-                                RANGE))
+                                                                 (PUSHMULTI-NEW INDEX
+                                                                        (\CHARSET (CAR PAIR))
+                                                                        (CAR PAIR)
+                                                                        (CADR PAIR)))
 
          (* ;; "Push the charset mappings down an extra CONS, so that a subsequent READ will get them all after a FILEPOS search for super-paren [")

 
-         [for
 CS in
 INDEX do
 (for
 M in
 (CDR CS) when
 (CDDR M) do
 
+         (for
 CS in
 INDEX do
 (for
 M in
 (CDR CS) when
 (CDDR M) do
 
                                                                  (* ;; 
 
                                                                "Sort the range alternatives, if any")

 
@@ -494,7 +394,7 @@
                              (* ;; "Sort by domain codes and push down a level")

 
                              (change
 (CDR CS)
-                                    (CONS (SORT DATUM T]
+                                    (SORT DATUM T)))
          (SETQ INDEX (SORT INDEX T))                         (* ; "Sort character sets")

          (if
 FILE
              then
 (SETQ FILE (PACKFILENAME 'BODY (if
 (NEQ FILE T)
@@ -544,18 +444,347 @@
                                 (FULLNAME STREAM))))])
 )
 
-(RPAQ? *MCCSTOUNICODE*
 )
 
-(RPAQ? *UNICODETOMCCS*
 )
 
-(RPAQ? *MCCS-LOADED-CHARSETS*
 )
+(* ; "Write Unicode mapping files")

 
-(RPAQ? *UNICODE-LOADED-CHARSETS*
 )
+(DEFINEQ
 
-(RPAQ? *LARGEUNICODES*
 )
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
+(WRITE-UNICODE-MAPPING

+  [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK)
             (* ; "Edited  4-Jan-2024 22:44 by rmk")


+                                                            (* ; "Edited 16-Aug-2020 16:56 by rmk:")

 
-(MAKE-UNICODE-TRANSLATION-TABLES
 'ALL)
+    (* ;; "Writes a symbol unicode mapping file.  Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.")

+
+    (* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.")

+
+    (* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab>#  Unicode-char")

+
+    (* ;; 
+
    "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.")

+
+    (* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.")

+
+    (IF
 (AND (EQ INCLUDECHARSETS T)
+             (NULL FILE))
+        THEN
 (IF
 MAPPING
+                 THEN
 (FOR
 CSI F IN
 XCCS-SET-NAMES WHEN
 (SETQ F (WRITE-UNICODE-MAPPING
 MAPPING
+                                                                       (CAR CSI)
+                                                                       NIL T)) COLLECT
 F)
+               ELSE
 (PRINTOUT T "THERE ARE NO MAPPINGS" T)
+                    NIL)
+      ELSE

+      (LET
+       (IMAPPING CSETINFO RANGES)
+       (CL:MULTIPLE-VALUE-SETQ (IMAPPING CSETINFO RANGES)
+              (WRITE-UNICODE-INCLUDED
 MAPPING INCLUDECHARSETS))
+       (IF
 IMAPPING
+           THEN
 (CL:WITH-OPEN-FILE
+                 (STREAM (WRITE-UNICODE-MAPPING-FILENAME
 FILE CSETINFO RANGES)
+                        :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :EXTERNAL-FORMAT :UTF-8-RAW)
+                 (WRITE-UNICODE-MAPPING-HEADER
 STREAM CSETINFO RANGES)
+                 (SORT IMAPPING T)
+                 (FOR
 M CSET LEFTC FIRSTRIGHTC CSI IN
 IMAPPING
+                    DO
 (SETQ LEFTC (CAR M))
+                       (SETQ FIRSTRIGHTC (CADR M))
+                       (CL:UNLESS (EQ CSET (LRSH LEFTC 8))
+                           (SETQ CSET (LRSH LEFTC 8))
+                           (SETQ CSI (ASSOC CSET CSETINFO))
+                           (PRINTOUT STREAM T "#  " .P2 (CADR CSI)
+                                  " "
+                                  (CADDR CSI)
+                                  T))
+                       (PRINTOUT STREAM "0x" (HEXSTRING LEFTC 4)
+                              %#
+                              (FOR
 RIGHTC IN
 (CDR M) DO
 (PRINTOUT NIL "	" "0x" (HEXSTRING RIGHTC 4)))
+                              "	#  "
+                              (SELECTC FIRSTRIGHTC
+                                  (UNDEFINEDCODE 
+                                                 (* ;; "FFFF")

+
+                                                 "UNDEFINED")
+                                  (MISSINGCODE 
+                                               (* ;; "FFFE")

+
+                                               "MISSING")
+                                  (IF
 (ILESSP FIRSTRIGHTC 32)
+                                      THEN
                   (* ; "Control chars")

+                                           [CONCAT "↑" (CHARACTER (IPLUS FIRSTRIGHTC (CHARCODE @]
+                                    ELSE
 (CHARACTER FIRSTRIGHTC)))
+                              T))
+                 (FULLNAME STREAM))
+         ELSEIF
 (NOT EMPTYOK)
+           THEN
 (PRINTOUT T "THERE ARE NO MAPPINGS")
+                (CL:WHEN INCLUDECHARSETS
+                    (PRINTOUT T " FOR " .PPVTL (MKLIST INCLUDECHARSETS)
+                           T))
+                NIL])
+
+(WRITE-UNICODE-INCLUDED

+  [LAMBDA (MAPPING INCLUDECHARSETS)
                         (* ; "Edited  4-Aug-2020 17:47 by rmk:")

+
+    (* ;; "CSETINFO is a list of (num string name) for each included character set.")

+
+    (LET (CHARSETS CSETINFO RANGES ICSETS IMAPPING)
+
+         (* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings")

+
+         [SETQ ICSETS (FOR
 C POS KNOWN INSIDE
 (OR INCLUDECHARSETS (FOR
 CSI IN
 XCCS-SET-NAMES
+                                                                     COLLECT
 (CAR CSI)))
+                         JOIN
 [SETQ KNOWN (OR (SASSOC C XCCS-SET-NAMES)
+                                              (FIND
 N IN
 XCCS-SET-NAMES
+                                                 SUCHTHAT
 (EQ C (CADR N)))
+                                              (HELP "UNKNOWN CHARACTER SET" (OCTALSTRING C]
+                              (IF
 (SETQ POS (STRPOS "-" (CAR KNOWN)))
+                                  THEN
 (FOR
 I FROM
 (CL:PARSE-INTEGER (SUBSTRING (CAR KNOWN)
+                                                                            1
+                                                                            (SUB1 POS))
+                                                          :RADIX 8)
+                                          TO
 (CL:PARSE-INTEGER (SUBSTRING (CAR KNOWN)
+                                                                      (ADD1 POS))
+                                                    :RADIX 8) COLLECT
 (LIST I (OCTALSTRING I)
+                                                                            (CADR KNOWN)))
+                                ELSE
 (CONS (CONS (CL:PARSE-INTEGER (CAR KNOWN)
+                                                        :RADIX 8)
+                                                 KNOWN]
+         (SETQ IMAPPING (FOR
 M CSI IN
 MAPPING WHEN
 (SETQ CSI (ASSOC (LRSH (CAR M)
+                                                                          8)
+                                                                    ICSETS))
+                           COLLECT
 
+
+                                 (* ;; "The attested subset of INCLUDED")

+
+                                 (CL:UNLESS (MEMB CSI CSETINFO)
+                                        (PUSH
 CSETINFO CSI))
+                                 M))
+
+         (* ;; "Sort as numbers, not octal strings, then group into consecutive ranges")

+
+         (SETQ CSETINFO (SORT CSETINFO T))
+         [SETQ RANGES (FOR
 CTAIL C START END ON
 (FOR
 CSI IN
 CSETINFO COLLECT
 (CAR CSI)) WHILE
 CTAIL
+                         COLLECT
 (SETQ START (CAR CTAIL))
+                               (SETQ END START)
+                               (CONS START (WHILE
 [AND (CDR CTAIL)
+                                                       (EQ END (SUB1 (CADR CTAIL]
+                                              COLLECT
 (SETQ CTAIL (CDR CTAIL))
+                                                    (SETQ END (CAR CTAIL]
+
+         (* ;; "Split out groups of less than 3.  But if a range exhaustively covers a known subset (like JIS), replace by the name")

+
+         [SETQ RANGES (FOR
 R STR KNOWN LAST IN
 RANGES
+                         JOIN
 (SETQ LAST (CAR (LAST R)))
+                              (IF
 (EQ (CAR R)
+                                      LAST)
+                                  THEN
 (CONS (OCTALSTRING (CAR R)))
+                                ELSEIF
 (SETQ KNOWN (SASSOC (SETQ STR (CONCAT (OCTALSTRING
+                                                                              (CAR R))
+                                                                            "-"
+                                                                            (OCTALSTRING LAST)))
+                                                          XCCS-SET-NAMES))
+                                  THEN
 (CONS (CADR KNOWN))
+                                ELSEIF
 (CDDR R)
+                                  THEN
 (CONS STR)
+                                ELSE
 (LIST (OCTALSTRING (CAR R))
+                                           (OCTALSTRING LAST]
+         (CL:VALUES IMAPPING CSETINFO RANGES])
+
+(WRITE-UNICODE-MAPPING-HEADER

+  [LAMBDA (STREAM CSETINFO RANGES)
                           (* ; "Edited  5-Jan-2024 13:24 by rmk")


+                                                            (* ; "Edited  4-Aug-2020 17:38 by rmk:")

+
+    (* ;; "Writes the standard per-file header information")

+
+    (FOR
 LINE IN
 UNICODE-MAPPING-HEADER
+       DO
 (PRINTOUT STREAM "#" 2)
+          (SELECTQ LINE
+              (XCCSCHARACTERSETS 
+                   (PRINTOUT STREAM "        XCCS charset")
+                   (IF
 (CDR CSETINFO)
+                       THEN
 (PRINTOUT STREAM "s:" -4)
+                            (FOR
 R IN
 RANGES DO
 (PRINTOUT STREAM R " "))
+                     ELSE
                                    (* ; "Singleton")

+                          (PRINTOUT STREAM ": " -4 (CADAR CSETINFO)
+                                 " "
+                                 (CADDAR CSETINFO)))
+                   (TERPRI STREAM))
+              (DATE (PRINTOUT STREAM "        Date:" -13 (DATE (DATEFORMAT NO.TIME NO.LEADING.SPACES)
+                                                               )
+                           T))
+              (PRINTOUT STREAM LINE T)))
+    (TERPRI STREAM])
+
+(WRITE-UNICODE-MAPPING-FILENAME

+  [LAMBDA (FILE CSETINFO RANGES)
                            (* ; "Edited  4-Aug-2020 19:34 by rmk:")

+    (PACKFILENAME 'BODY [OR FILE (CONCATLIST
+                                  (CONS 'XCCS- (IF
 (CDR CSETINFO)
+                                                   THEN
 (FOR
 RTAIL R ON
 RANGES
+                                                           JOIN
 (SETQ R (CAR RTAIL))
+                                                                (SETQ R (CL:IF (LISTP R)
+                                                                            (LIST (CAR R)
+                                                                                  "-"
+                                                                                  (CDR R))
+                                                                            (CONS R)))
+                                                                (CL:IF (CDR RTAIL)
+                                                                       (NCONC1 R ","))
+                                                                R)
+                                                 ELSE
 (LIST (CADAR CSETINFO)
+                                                            "="
+                                                            (CADDAR CSETINFO]
+           'DIRECTORY
+           (CAR UNICODEDIRECTORIES)
+           'EXTENSION
+           'TXT])
+)
+(DEFINEQ
+
+(XCCS-UTF8-AFTER-OPEN

+  [LAMBDA (STREAM ACCESS PARAMETERS)
                         (* ; "Edited  3-Jan-2024 10:27 by rmk")


+                                                            (* ; "Edited 13-Aug-2020 11:54 by rmk:")

+
+    (* ;; 
+
    "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF-8. For development")

+
+    (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
+                  [EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM)
+                                          'EXTENSION]
+                  (NOT (ASSOC 'EXTERNALFORMAT PARAMETERS)))
+        (STREAMPROP STREAM 'EXTERNALFORMAT :UTF-8))])
+)
+
+
+
+(* ;; "Automate dumping of a documentation prefix")

+
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQ MISSINGCODE
 (CL:PARSE-INTEGER "FFFE" :RADIX 16))
+
+(RPAQ UNDEFINEDCODE
 (CL:PARSE-INTEGER "FFFF" :RADIX 16))
+
+
+(CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE" :RADIX 16))
+       (UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16)))
+)
+)
+
+(RPAQQ UNICODE-MAPPING-HEADER

+       ("" "        Name:             XCCS (Version 2.0) to Unicode" "        Unicode version:  3.0"
+           XCCSCHARACTERSETS "        Table version:    0.1" "        Table format:     Format A" 
+           DATE "        Author:           Ron Kaplan <Ron.Kaplan@post.harvard.edu>" "" 
+           "This file contains mappings from the Xerox Character Code Standard (version" 
+           "2.0, 1990) into Unicode 3.0. standard codes.  That is an extension of the" 
+           "version of XCCS corresponding to the fonts in the Medley system." "" 
+           "The format of this file conforms to the format of the other Unicode-supplied" 
+           "mapping files:" "   Three white-space (tab or spaces) separated columns:" 
+           "     Column 1 is the XCCS code (as hex 0xXXXX)" 
+           "     Column 2 is the corresponding Unicode (as hex 0xXXXX)" 
+           "     Column 3 (after #) is a comment column. For convenience, it contains the" 
+           "        Unicode character itself and the Unicode character names when available." 
+           "Unicode FFFF is used for undefined XCCS codes (Column 3 = UNDEFINED" 
+           "Unicode FFFE is used for XCCS codes that have not yet been filled in." 
+           "(Column 3 = MISSING)" "" "This file is encoded in UTF-8, so that the Unicode characters"
+           "are properly displayed in Column 3 and can be edited by standard" 
+           "Unicode-enabled editors (e.g. Mac Textedit)." "" 
+           "This file can also be read by the function" 
+           "READ-UNICODE-MAPPING in the UNICODE Medley library package." "" 
+           "The entries are in XCCS order and grouped by character sets.  In front of" 
+           "the mappings, for convenience, there is a line with the octal XCCS" 
+           "character set, after #." "" 
+           "Note that a given XCCS code might map to codes in several different Unicode" 
+           "positions, since there are repetitions in the Unicode standard." "" 
+           "For more details, see the associated README.TXT file." "" 
+           "Any comments or problems, contact <ron.kaplan@post.harvard.edu>"))
+(DEFINEQ
+
+(UTF8HEXSTRING

+  [LAMBDA (CHARCODE)
                                        (* ; "Edited 10-Aug-2020 08:33 by rmk:")

+
+    (* ;; "Utility to produces the UTF8 hexstring representing CODE")

+
+    (HEXSTRING (IF
 (ILESSP CHARCODE 128)
+                   THEN
 CHARCODE
+                 ELSEIF
 (ILESSP CHARCODE 2048)
+                   THEN
                                      (* ; "x800")

+                        (LOGOR (LLSH (LOGOR (LLSH 3 6)
+                                            (LRSH CHARCODE 6))
+                                     8)
+                               (LOGOR (LLSH 2 6)
+                                      (LOADBYTE CHARCODE 0 6)))
+                 ELSEIF
 (ILESSP CHARCODE 65536)
+                   THEN
                                      (* ; "x10000")

+                        (LOGOR (LLSH (LOGOR (LLSH 7 5)
+                                            (LRSH CHARCODE 12))
+                                     16)
+                               (LLSH (LOGOR (LLSH 2 6)
+                                            (LOADBYTE CHARCODE 6 6))
+                                     8)
+                               (LOGOR (LLSH 2 6)
+                                      (LOADBYTE CHARCODE 0 6)))
+                 ELSEIF
 (ILESSP CHARCODE 2097152)
+                   THEN
                                      (* ; "x200000")

+                        (LOGOR (LLSH (LOGOR (LLSH 15 4)
+                                            (LRSH CHARCODE 18))
+                                     24)
+                               (LLSH (LOGOR (LLSH 2 6)
+                                            (LOADBYTE CHARCODE 12 6))
+                                     16)
+                               (LLSH (LOGOR (LLSH 2 6)
+                                            (LOADBYTE CHARCODE 6 6))
+                                     8)
+                               (LOGOR (LLSH 2 6)
+                                      (LOADBYTE CHARCODE 0 6)))
+                 ELSE
 (ERROR "CHARCODE too big for UTF8" CHARCODE])
+)
+
+
+
+(* ; "debugging")

+
+(DEFINEQ
+
+(SHOWCHARS

+  [LAMBDA (FONT FROMCHAR TOCHAR ONELINE)
                     (* ; "Edited  5-Oct-2025 17:41 by rmk")


+                                                             (* ; "Edited  7-Sep-2025 20:29 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 10:26 by rmk")


+                                                             (* ; "Edited 24-Jul-2025 11:30 by rmk")


+                                                             (* ; "Edited  8-Jun-2025 20:05 by rmk")


+                                                             (* ; "Edited 26-Jan-2024 14:18 by mth")


+                                                            (* ; "Edited  1-Aug-2020 09:27 by rmk:")

+    [SETQ FONT (FONTCREATE (OR FONT '(CLASSIC 12]
+    (RESETLST
+        [LET ((OLDFONT (DSPFONT NIL T))
+              CHARS)
+             (CL:UNLESS (CHARCODEP FROMCHAR)
+                 (SETQ FROMCHAR (OR (CHARCODE.DECODE FROMCHAR T)
+                                    FROMCHAR)))
+             (SETQ CHARS (if
 (LISTP FROMCHAR)
+                           elseif
 (CHARCODEP FROMCHAR)
+                             then
 (CL:UNLESS (CHARCODEP TOCHAR)
+                                      (SETQ TOCHAR (OR (CHARCODE.DECODE TOCHAR)
+                                                       FROMCHAR)))
+                                  (for
 C from
 FROMCHAR to
 TOCHAR collect
 C)
+                           else
 (CHCON FROMCHAR)))
+             [RESETSAVE OLDFONT '(PROGN (DSPFONT OLDVALUE]
+             (TERPRI)
+             (for
 C in
 CHARS do
 (PRINTOUT T .FONT OLDFONT (CONCAT (OCTALSTRING (\CHARSET C))
+                                                                 ","
+                                                                 (OCTALSTRING (\CHAR8CODE C)))
+                                       10 .FONT FONT (CHARACTER C))
+                                (CL:UNLESS ONELINE (PRINTOUT T T])
+    (TERPRI])
+)
+(DECLARE%: DOEVAL@LOAD DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS HEXCHAR
 MACRO
 ((CODE)
+                         (HEXSTRING CODE)))
+
+(PUTPROPS OCTALCHAR
 MACRO
 [(CODE)
+                           (CONCAT (OCTALSTRING (\CHARSET CODE))
+                                  ","
+                                  (OCTALSTRING (LOGAND CODE 255])
+)
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
@@ -563,9 +792,12 @@
        UNICODE-EXPORTS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3341 12542 (READ-UNICODE-MAPPING-FILENAMES 3351 . 8301) (READ-UNICODE-MAPPING 8303 . 
-12540)) (12609 26839 (MAKE-UNICODE-TRANSLATION-TABLES 12619 . 16379) (XCCSTOMCCS-MAPPING 16381 . 17598
-) (MERGE-UNICODE-TRANSLATION-TABLES 17600 . 20253) (UNICODE.UNMAPPED 20255 . 23579) (
-UNICODE-EXTEND-TRANSLATION? 23581 . 26837)) (26840 33676 (ALL-UNICODE-MAPPINGS 26850 . 32339) (
-XCCSJAPANESECHARSETS 32341 . 33674)))))
+  (FILEMAP (NIL (3929 12651 (READ-UNICODE-MAPPING-FILENAMES 3939 . 8408) (READ-UNICODE-MAPPING 8410 . 
+12649)) (12718 19526 (MAKE-UNICODE-TRANSLATION-TABLES 12728 . 15488) (GET-MCCS-UNICODE-MAPPING 15490
+ . 16510) (INVERT-UNICODE-MAPPING 16512 . 18305) (XCCSTOMCCS-MAPPING 18307 . 19524)) (19527 26150 (
+ALL-UNICODE-MAPPINGS 19537 . 24813) (XCCSJAPANESECHARSETS 24815 . 26148)) (26195 36957 (
+WRITE-UNICODE-MAPPING 26205 . 29949) (WRITE-UNICODE-INCLUDED 29951 . 34263) (
+WRITE-UNICODE-MAPPING-HEADER 34265 . 35513) (WRITE-UNICODE-MAPPING-FILENAME 35515 . 36955)) (36958 
+37634 (XCCS-UTF8-AFTER-OPEN 36968 . 37632)) (40159 42248 (UTF8HEXSTRING 40169 . 42246)) (42275 44317 (
+SHOWCHARS 42285 . 44315)))))
 STOP

library/UNIXUTILS

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "19-Jan-2026 14:09:03" {WMEDLEY}<library>UNIXUTILS.;55
 20711  
+
(FILECREATED "28-Apr-2026 09:59:13" {WMEDLEY}<library>UNIXUTILS.;61
 22079  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS UNIX-FILE-NAME)
+      :CHANGES-TO (VARS UNIXUTILSCOMS)
 
-      :PREVIOUS-DATE "17-Jan-2026 23:16:17" {WMEDLEY}<library>UNIXUTILS.;54)
+      :PREVIOUS-DATE "27-Apr-2026 11:10:07" {MEDLEY}<library>UNIXUTILS.;60)
 
 
 (PRETTYCOMPRINT UNIXUTILSCOMS)
@@ -23,6 +23,7 @@
                         (ShellOpener NIL RESET)))
         (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME 
              UNIX-TMP-FILE-NAME)
+        (COMMANDS "cd" cdm "ls" "pwd")
         (PROPS (UNIXUTILS FILETYPE))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
@@ -148,7 +149,8 @@
                                                   "true"])
 
 (ShellOpen

-  [LAMBDA (FilenameOrURL)
                                    (* ; "Edited 28-Dec-2025 18:26 by rmk")


+  [LAMBDA (FilenameOrURL)
                                    (* ; "Edited 27-Apr-2026 11:08 by FGH")


+                                                             (* ; "Edited 28-Dec-2025 18:26 by rmk")


                                                              (* ; "Edited 10-Sep-2025 15:29 by rmk")


                                                              (* ; "Edited  4-May-2025 11:14 by rmk")

 
@@ -210,7 +212,8 @@
                                                        'NAME NEWNAME 'EXTENSION EXTENSION))
                                (TARGETFILE.UNIX (SLASHIT
 (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY 
                                                                 TMPDIR 'NAME NEWNAME 'EXTENSION 
-                                                                EXTENSION)))
+                                                                EXTENSION)
+                                                       NIL NIL NIL T))
                                (UNIXFILE NIL))
                               (DECLARE
 (SPECVARS UNIXFILE))
                               (if
 (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
@@ -245,7 +248,8 @@
                                                  0))) DO
 (BLOCK) FINALLY
 (RETURN CODE])
 
 (SLASHIT

-  [LAMBDA (X LCASEDIRS NOHOST KEEPDOT)
                       (* ; "Edited 17-Jan-2026 23:15 by rmk")


+  [LAMBDA (X LCASEDIRS NOHOST KEEPDOT NO.QUOTE.SPACE)
        (* ; "Edited 27-Apr-2026 11:00 by FGH")


+                                                             (* ; "Edited 17-Jan-2026 23:15 by rmk")


                                                              (* ; "Edited  4-Nov-2025 10:10 by rmk")


                                                              (* ; "Edited 22-Oct-2025 13:05 by rmk")


                                                              (* ; "Edited 25-Sep-2025 09:57 by rmk")


@@ -258,7 +262,10 @@
     (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file.  For now, this just involves replacing directory brackets with /, removing the host, perhaps lower-casing the directory, and perhaps removing a final dot.  It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")

 
     (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
-                                               0]
+                                               0)))
+                (REPLACE.SPACE (if
 NO.QUOTE.SPACE
+                                   then
 (CONS (CHARCODE SPACE))
+                                 else
 (CHARCODE (\ SPACE]
          [SETQ SLASHED (CONCATCODES (for
 I C from
 DIRPOS while
 (SETQ C (NTHCHARCODE X I))
                                        join
 (SELCHARQ C
                                                  ((< >) 
@@ -266,7 +273,7 @@
                                                       (CONS (CHARCODE /)))
                                                  (/ (SETQ LASTDIRPOS I)
                                                     (CONS C))
-                                                 (SPACE (APPEND (CHARCODE (\ SPACE))))
+                                                 (SPACE (APPEND REPLACE.SPACE))
                                                  (CONS C]
          (CL:WHEN (AND LCASEDIRS LASTDIRPOS)
              (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
@@ -287,7 +294,9 @@
          SLASHED])
 
 (UNIX-FILE-NAME

-  [LAMBDA (FILE ACCESS COPY EXTENSION)
                       (* ; "Edited 19-Jan-2026 14:05 by rmk")


+  [LAMBDA (FILE ACCESS COPY EXTENSION)
                       (* ; "Edited 31-Mar-2026 00:13 by rmk")


+                                                             (* ; "Edited 29-Mar-2026 00:26 by rmk")


+                                                             (* ; "Edited 19-Jan-2026 14:05 by rmk")


                                                              (* ; "Edited 17-Jan-2026 22:32 by rmk")


                                                              (* ; "Edited 11-Jan-2026 23:54 by rmk")


                                                              (* ; "Edited 27-Dec-2025 21:24 by rmk")


@@ -317,8 +326,13 @@
                                FILE))
                      (DSK [LET ((VERSION (FILENAMEFIELD FILE 'VERSION))
                                 (UNAME (PACKFILENAME 'VERSION NIL 'BODY FILE)))
-                               (CL:UNLESS (EQ VERSION 1)
-                                   (CONCAT UNAME (CONCAT "~" VERSION "~")))])
+                               (CL:IF (EQ VERSION 1)
+                                   UNAME
+                                   (CONCAT UNAME (CONCAT (CL:IF (EQ (CHARCODE %.)
+                                                                    (NTHCHARCODE UNAME -1))
+                                                             ""
+                                                             ".")
+                                                        "~" VERSION "~")))])
                      (LET (UNAME)
 
                           (* ;; "Catch the streams as well as other devices (CORE, servers)")

@@ -358,10 +372,20 @@
        unless
 (INFILEP UNAME) do
 (RETURN (SLASHIT
 (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW])
 )
 
+(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))
+
+(DEFCOMMAND cdm (SUBDIR) (/CNDIR (CL:IF SUBDIR
+                                     (CONCAT '{MEDLEY}/ SUBDIR)
+                                     '{MEDLEY})))
+
+(DEFCOMMAND "ls" (FIRST
 . REST) (DODIR (CONS FIRST REST)))
+
+(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))
+
 (PUTPROPS UNIXUTILS
 FILETYPE
 CL:COMPILE-FILE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1170 1543 (ShellCommand 1170 . 1543)) (1545 1942 (ShellWhich 1545 . 1942)) (2052 20633 
-(ShellBrowser 2062 . 3834) (ShellBrowse 3836 . 4521) (ShellOpener 4523 . 6211) (ShellOpen 6213 . 11982
-) (PROCESS-COMMAND 11984 . 12597) (SLASHIT 12599 . 15623) (UNIX-FILE-NAME 15625 . 18952) (
-UNIX-TMP-FILE-NAME 18954 . 20631)))))
+  (FILEMAP (NIL (1208 1581 (ShellCommand 1208 . 1581)) (1583 1980 (ShellWhich 1583 . 1980)) (2090 21695 
+(ShellBrowser 2100 . 3872) (ShellBrowse 3874 . 4559) (ShellOpener 4561 . 6249) (ShellOpen 6251 . 12198
+) (PROCESS-COMMAND 12200 . 12813) (SLASHIT 12815 . 16127) (UNIX-FILE-NAME 16129 . 20014) (
+UNIX-TMP-FILE-NAME 20016 . 21693)))))
 STOP

library/tedit/TEDIT

@@ -1,13 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED " 4-Feb-2026 16:02:02" {WMEDLEY}<library>TEDIT>TEDIT.;852
 146779 
+
(FILECREATED "10-Mar-2026 18:07:31" {WMEDLEY}<library>tedit>TEDIT.;855
 146853 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.MAP.OBJECTS TEDIT.PARAGRAPH.BOUNDARIES)
-                  (VARS TEDITCOMS)
+      :CHANGES-TO (FNS TDRIBBLE)
 
-      :PREVIOUS-DATE "31-Jan-2026 11:49:19" {WMEDLEY}<library>TEDIT>TEDIT.;849)
+      :PREVIOUS-DATE " 2-Mar-2026 18:32:06" {WMEDLEY}<library>tedit>TEDIT.;853)
 
 
 (PRETTYCOMPRINT TEDITCOMS)
@@ -29,9 +28,7 @@
 
                      (EXPORT (FILES (FROM LOADUPS)
                                     EXPORTS.ALL)))
-              (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
-              (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
-                                                      UNICODE)))
+              (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)))
         [DECLARE%: EVAL@COMPILE DONTCOPY 
 
                (* ;; "Assertions go to comments if not being checked, so we see value-warnings")

@@ -158,11 +155,6 @@
 (FILESLOAD TEDIT-EXPORTS.ALL)
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
-
-(FILESLOAD (LOADCOMP)
-       UNICODE)
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS TEDIT-ASSERT
 MACRO
 [ARGS (COND
@@ -751,17 +743,21 @@
 (DEFINEQ
 
 (TDRIBBLE

-  [LAMBDA NIL
                                                (* ; "Edited 31-Mar-2025 12:03 by rmk")


+  [LAMBDA (TITLE WINDOW)
                                     (* ; "Edited 10-Mar-2026 17:39 by rmk")


+                                                             (* ; "Edited 31-Mar-2025 12:03 by rmk")


                                                              (* ; "Edited 16-Mar-2025 21:47 by rmk")


                                                              (* ; "Edited 27-Nov-2024 23:20 by rmk")


                                                              (* ; "Edited 17-Nov-2024 14:10 by rmk")


                                                              (* ; "Edited 15-Nov-2024 21:13 by rmk")


                                                              (* ; "Edited 22-Oct-2024 21:23 by rmk")

-    (LET [(TSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL `(HISTORY OFF FONT DEFAULTFONT]
+    (LET [(TSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL `(TITLE ,(CONCAT (OR TITLE "Tedit Dribble")
+                                                                   "   "
+                                                                   (DATE))
+                                                           HISTORY OFF FONT DEFAULTFONT]
          [WHENCLOSE TSTREAM 'BEFORE
                 (FUNCTION (LAMBDA (TSTREAM)
                             [TEDIT
 TSTREAM 'Dribble NIL
-                                   `(TITLE ,(CONCAT "Tedit Dribble   " (DATE))
+                                   `(TITLE ,(TEXTPROP TSTREAM 'TITLE)
                                            LEAVETTY T APPEND QUIET PARABREAKCHARS NIL HISTORY OFF 
                                            OPENWIDTH ,(fetch
 (REGION WIDTH)
                                                          of
 (WINDOWPROP (WFROMDS T)
@@ -2353,27 +2349,27 @@
 
 (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT
 TEDIT.TO.IMAGEFILE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4936 7330 (MAKE-TEDIT-EXPORTS.ALL 4946 . 5492) (UPDATE-TEDIT 5494 . 6423) (EDIT-TEDIT 
-6425 . 7328)) (8760 37759 (TEDIT 8770 . 11384) (TEXTSTREAM 11386 . 13275) (TEXTSTREAMP 13277 . 13661) 
-(COERCETEXTSTREAM 13663 . 17874) (TEDIT.CONCAT 17876 . 21178) (TEDITSTRING 21180 . 22094) (TEDIT-SEE 
-22096 . 22780) (TEDIT.COPY 22782 . 24927) (TEDIT.DELETE 24929 . 26290) (TEDIT.INSERT 26292 . 29261) (
-TEDIT.TERPRI 29263 . 30377) (TEDIT.KILL 30379 . 31361) (TEDIT.QUIT 31363 . 32729) (TEDIT.MOVE 32731 . 
-33619) (TEDIT.STRINGWIDTH 33621 . 34292) (TEDIT.CHARWIDTH 34294 . 36536) (TEDIT.PARAGRAPH.BOUNDARIES 
-36538 . 37757)) (37760 39701 (TEXTOBJ 37770 . 38235) (COERCETEXTOBJ 38237 . 39699)) (41101 42751 (
-TDRIBBLE 41111 . 42749)) (42792 54772 (TEDIT.INSERT.OBJECT 42802 . 46509) (TEDIT.EDIT.OBJECT 46511 . 
-49451) (TEDIT.OBJECT.CHANGED 49453 . 52643) (TEDIT.MAP.OBJECTS 52645 . 54300) (\TEDIT.FIRST.OBJPIECE 
-54302 . 54535) (\TEDIT.NEXT.OBJPIECE 54537 . 54770)) (54795 62238 (\TEDIT.CONCAT.PAGEFRAMES 54805 . 
-59872) (\TEDIT.GET.PAGE.HEADINGS 59874 . 60903) (\TEDIT.CONCAT.INSTALL.HEADINGS 60905 . 62236)) (62239
- 65846 (\TEDIT.MOVE.MSG 62249 . 64330) (\TEDIT.READONLY 64332 . 65844)) (65847 71738 (TEDIT.NCHARS 
-65857 . 66230) (TEDIT.RPLCHARCODE 66232 . 69222) (TEDIT.NTHCHARCODE 69224 . 71267) (TEDIT.NTHCHAR 
-71269 . 71736)) (71784 128828 (\TEDIT1 71794 . 73871) (\TEDIT.INSERT 73873 . 79986) (\TEDIT.MOVE 79988
- . 88086) (\TEDIT.COPY 88088 . 92694) (\TEDIT.REPLACE.SELPIECES 92696 . 97232) (
-\TEDIT.INSERT.SELPIECES 97234 . 100231) (\TEDIT.RESTARTFN 100233 . 102738) (\TEDIT.CHARDELETE 102740
- . 105669) (\TEDIT.COPYPIECE 105671 . 110833) (\TEDIT.APPLY.OBJFN 110835 . 113921) (\TEDIT.DELETE 
-113923 . 118291) (\TEDIT.DIFFUSE.PARALOOKS 118293 . 120564) (\TEDIT.WORDDELETE 120566 . 122181) (
-\TEDIT.WORDDELETE.FORWARD 122183 . 123972) (\TEDIT.FINISHEDIT? 123974 . 128826)) (128829 129488 (
-\TEDIT.THELP 128839 . 129486)) (129522 138653 (\TEDIT.PARAPIECES 129532 . 131506) (\TEDIT.PARACHNOS 
-131508 . 132400) (\TEDIT.PARA.FIRST 132402 . 135503) (\TEDIT.PARA.LAST 135505 . 138651)) (138654 
-145749 (\TEDIT.WORD.FIRST 138664 . 142668) (\TEDIT.WORD.LAST 142670 . 145747)) (145950 146227 (
-TEDITSYSTEMDATE 145960 . 146225)) (146363 146570 (TEDIT.IMAGESOURCEP 146373 . 146568)))))
+  (FILEMAP (NIL (4736 7130 (MAKE-TEDIT-EXPORTS.ALL 4746 . 5292) (UPDATE-TEDIT 5294 . 6223) (EDIT-TEDIT 
+6225 . 7128)) (8485 37484 (TEDIT 8495 . 11109) (TEXTSTREAM 11111 . 13000) (TEXTSTREAMP 13002 . 13386) 
+(COERCETEXTSTREAM 13388 . 17599) (TEDIT.CONCAT 17601 . 20903) (TEDITSTRING 20905 . 21819) (TEDIT-SEE 
+21821 . 22505) (TEDIT.COPY 22507 . 24652) (TEDIT.DELETE 24654 . 26015) (TEDIT.INSERT 26017 . 28986) (
+TEDIT.TERPRI 28988 . 30102) (TEDIT.KILL 30104 . 31086) (TEDIT.QUIT 31088 . 32454) (TEDIT.MOVE 32456 . 
+33344) (TEDIT.STRINGWIDTH 33346 . 34017) (TEDIT.CHARWIDTH 34019 . 36261) (TEDIT.PARAGRAPH.BOUNDARIES 
+36263 . 37482)) (37485 39426 (TEXTOBJ 37495 . 37960) (COERCETEXTOBJ 37962 . 39424)) (40826 42825 (
+TDRIBBLE 40836 . 42823)) (42866 54846 (TEDIT.INSERT.OBJECT 42876 . 46583) (TEDIT.EDIT.OBJECT 46585 . 
+49525) (TEDIT.OBJECT.CHANGED 49527 . 52717) (TEDIT.MAP.OBJECTS 52719 . 54374) (\TEDIT.FIRST.OBJPIECE 
+54376 . 54609) (\TEDIT.NEXT.OBJPIECE 54611 . 54844)) (54869 62312 (\TEDIT.CONCAT.PAGEFRAMES 54879 . 
+59946) (\TEDIT.GET.PAGE.HEADINGS 59948 . 60977) (\TEDIT.CONCAT.INSTALL.HEADINGS 60979 . 62310)) (62313
+ 65920 (\TEDIT.MOVE.MSG 62323 . 64404) (\TEDIT.READONLY 64406 . 65918)) (65921 71812 (TEDIT.NCHARS 
+65931 . 66304) (TEDIT.RPLCHARCODE 66306 . 69296) (TEDIT.NTHCHARCODE 69298 . 71341) (TEDIT.NTHCHAR 
+71343 . 71810)) (71858 128902 (\TEDIT1 71868 . 73945) (\TEDIT.INSERT 73947 . 80060) (\TEDIT.MOVE 80062
+ . 88160) (\TEDIT.COPY 88162 . 92768) (\TEDIT.REPLACE.SELPIECES 92770 . 97306) (
+\TEDIT.INSERT.SELPIECES 97308 . 100305) (\TEDIT.RESTARTFN 100307 . 102812) (\TEDIT.CHARDELETE 102814
+ . 105743) (\TEDIT.COPYPIECE 105745 . 110907) (\TEDIT.APPLY.OBJFN 110909 . 113995) (\TEDIT.DELETE 
+113997 . 118365) (\TEDIT.DIFFUSE.PARALOOKS 118367 . 120638) (\TEDIT.WORDDELETE 120640 . 122255) (
+\TEDIT.WORDDELETE.FORWARD 122257 . 124046) (\TEDIT.FINISHEDIT? 124048 . 128900)) (128903 129562 (
+\TEDIT.THELP 128913 . 129560)) (129596 138727 (\TEDIT.PARAPIECES 129606 . 131580) (\TEDIT.PARACHNOS 
+131582 . 132474) (\TEDIT.PARA.FIRST 132476 . 135577) (\TEDIT.PARA.LAST 135579 . 138725)) (138728 
+145823 (\TEDIT.WORD.FIRST 138738 . 142742) (\TEDIT.WORD.LAST 142744 . 145821)) (146024 146301 (
+TEDITSYSTEMDATE 146034 . 146299)) (146437 146644 (TEDIT.IMAGESOURCEP 146447 . 146642)))))
 STOP

library/tedit/TEDIT-ABBREV

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "23-Jan-2026 15:49:26" {WMEDLEY}<library>TEDIT>TEDIT-ABBREV.;58
 18256  
+
(FILECREATED "30-Apr-2026 11:55:15" {MEDLEY}<library>tedit>TEDIT-ABBREV.;59
 18372  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
 
-      :PREVIOUS-DATE "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55)
+      :PREVIOUS-DATE "23-Jan-2026 15:49:26" {MEDLEY}<library>tedit>TEDIT-ABBREV.;58)
 
 
 (PRETTYCOMPRINT TEDIT-ABBREVCOMS)
@@ -86,7 +86,8 @@
 (DEFINEQ
 
 (\TEDIT.ABBREV.EXPAND

-  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 23-Jan-2026 15:49 by rmk")


+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 30-Apr-2026 11:53 by rmk")


+                                                             (* ; "Edited 23-Jan-2026 15:49 by rmk")


                                                              (* ; "Edited 20-Jan-2026 09:56 by rmk")


                                                              (* ; "Edited 13-Jan-2026 17:51 by rmk")


                                                              (* ; "Edited  8-Jan-2026 09:08 by rmk")


@@ -118,7 +119,7 @@
               (SETQ BACKSLASH T)                             (* ; 
 
                                                             "Started with backslash, extend match")

               (SETQ POINTSELECTION NIL)
-              (for
 I CH from
 (SUB1 LASTCHNO) by
 -1 as
 J from
 1 to
 25
+              (for
 I CH from
 (SUB1 LASTCHNO) by
 -1 to
 1 as
 J from
 1 to
 25
                  do
 (SETQ CH (TEDIT.NTHCHARCODE TSTREAM I))  (* ; "Don't cross over an image obj")

                     (if
 (IMAGEOBJP CH)
                         then
 (RETURN)
@@ -363,7 +364,7 @@
          ("DATE" \TEDIT.EXPAND.DATE)
          (">>DATE<<" \TEDIT.EXPAND.DATE)))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4348 15152 (\TEDIT.ABBREV.EXPAND 4358 . 9123) (\TEDIT.ABBREV.EXPANSION 9125 . 12189) (
-\TEDIT.ABBREV.TREE 12191 . 13322) (\TEDIT.ABBREV.PARSE 13324 . 14476) (\TEDIT.ABBREV.PARSE.CHARCODE 
-14478 . 15150)) (15153 15798 (\TEDIT.EXPAND.DATE 15163 . 15796)))))
+  (FILEMAP (NIL (4346 15268 (\TEDIT.ABBREV.EXPAND 4356 . 9239) (\TEDIT.ABBREV.EXPANSION 9241 . 12305) (
+\TEDIT.ABBREV.TREE 12307 . 13438) (\TEDIT.ABBREV.PARSE 13440 . 14592) (\TEDIT.ABBREV.PARSE.CHARCODE 
+14594 . 15266)) (15269 15914 (\TEDIT.EXPAND.DATE 15279 . 15912)))))
 STOP

library/tedit/TEDIT-BUTTONS

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "25-Jan-2026 09:14:04" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;230
 123301 
+
(FILECREATED "29-Apr-2026 17:57:09" {MEDLEY}<library>TEDIT>TEDIT-BUTTONS.;233
 123809 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-BUTTONSCOMS)
+      :CHANGES-TO (FNS MB.NWAY.SIZEFN)
 
-      :PREVIOUS-DATE "19-Oct-2025 10:44:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;229)
+      :PREVIOUS-DATE "17-Mar-2026 00:38:38" {MEDLEY}<library>TEDIT>TEDIT-BUTTONS.;231)
 
 
 (PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
@@ -922,11 +922,12 @@
                  SOBJ STREAM])
 
 (MB.NWAY.SIZEFN

-  [LAMBDA (OBJ STREAM CURX RIGHTMARGIN)
                      (* ; "Edited 20-Aug-2024 15:12 by rmk")


+  [LAMBDA (OBJ STREAM CURX RIGHTMARGIN)
                      (* ; "Edited 29-Apr-2026 17:56 by rmk")


+                                                             (* ; "Edited 20-Aug-2024 15:12 by rmk")


                                                              (* ; "Edited 22-Jul-2024 11:31 by rmk")

                                                              (* jds " 6-Sep-84 14:19")

                                                              (* ; "Tell the size of an n-way menu")

-    (OR (IMAGEOBJPROP OBJ 'BOUNDBOX)
+    (OR (AND NIL (IMAGEOBJPROP OBJ 'BOUNDBOX))
         (LET ((OLDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX))
               (SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS))
               (MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE))
@@ -935,7 +936,9 @@
               (BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT))
               (SPACING (IMAGEOBJPROP OBJ 'ITEMSPACE))
               (SLACK (IDIFFERENCE RIGHTMARGIN CURX))
-              BOX XSIZE YSIZE LINES)
+              (XSIZE 0)
+              (YSIZE 0)
+              BOX YSIZE LINES)
              [if
 (AND (IGEQ SLACK MAXWIDTH)
                       (EQ MAXITEMS/LINE (LENGTH SUBOBJECTS)))
                  then
                                        (* ; 
@@ -950,8 +953,11 @@
                                                        (IMAGEOBJPROP SO 'Y 0))
                elseif
 (ILEQ SLACK (IMAGEOBJPROP OBJ 'MINWIDTH))
                  then
                                        (* ; "Stack them vertically.")

-                      (for
 SO (Y _ (ITIMES BUTTONHEIGHT (LENGTH SUBOBJECTS))) in
 SUBOBJECTS
+                      (SETQ YSIZE (ITIMES BUTTONHEIGHT (LENGTH SUBOBJECTS)))
+                      (SETQ XSIZE SPACING)
+                      (for
 SO (Y _ YSIZE) in
 SUBOBJECTS
                          do
 (add
 Y (IMINUS BUTTONHEIGHT))
+                            [SETQ XSIZE (IMAX XSIZE (fetch
 XSIZE of
 (IMAGEOBJPROP SO 'BOUNDBOX]
                             (IMAGEOBJPROP SO 'Y Y)
                             (IMAGEOBJPROP SO 'X 0))
                else
                                          (* ; "Divide them into lines")

@@ -1749,7 +1755,8 @@
           ENDPC])
 
 (MB.FIELD.SETSTATEFN

-  [LAMBDA (PREFIXPC NEWVALUE TSTREAM)
                        (* ; "Edited  6-Apr-2025 12:23 by rmk")


+  [LAMBDA (PREFIXPC NEWVALUE TSTREAM)
                        (* ; "Edited 17-Mar-2026 00:38 by rmk")


+                                                             (* ; "Edited  6-Apr-2025 12:23 by rmk")


                                                              (* ; "Edited  9-Dec-2024 22:14 by rmk")


                                                              (* ; "Edited  4-Dec-2024 20:31 by rmk")


                                                              (* ; "Edited 20-Oct-2024 17:20 by rmk")


@@ -1805,8 +1812,9 @@
                                     (\TEDIT.INSERT NEWVALUE FSEL TSTREAM T T)
                                     (NCHARS NEWVALUE)))
            (\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT)
-           (\TEDIT.CHANGE.CHARLOOKS TSTREAM (IMAGEOBJPROP PREFIXOBJ 'FIELDLOOKS)
-                  FSEL)
+           (CL:UNLESS (EQ 0 (GETSEL FSEL DCH))
+               (\TEDIT.CHANGE.CHARLOOKS TSTREAM (IMAGEOBJPROP PREFIXOBJ 'FIELDLOOKS)
+                      FSEL))
            (IMAGEOBJPROP PREFIXOBJ 'FIELDLENGTH FIELDLENGTH)
            (IMAGEOBJPROP PREFIXOBJ 'STATE NEWVALUE)
 
@@ -1937,25 +1945,25 @@
 (MB.FIELD.INIT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3188 19324 (MB.ADD 3198 . 9910) (MB.DELETE 9912 . 10286) (MB.GET 10288 . 17058) (
-MB.GET.MBARG 17060 . 18729) (TEDIT.BACKTOMAIN 18731 . 19322)) (19368 39304 (MB.BUTTONEVENTINFN 19378
- . 20946) (MB.DISPLAYFN 20948 . 23007) (MB.SETIMAGE 23009 . 24177) (MB.SIZEFN 24179 . 25727) (
-MB.WHENOPERATEDONFN 25729 . 27678) (MB.COPYFN 27680 . 28138) (MB.GETFN 28140 . 29101) (MB.PUTFN 29103
- . 30203) (MB.SHOWSELFN 30205 . 31714) (MB.CREATE 31716 . 35739) (MB.CHANGENAME 35741 . 36223) (
-MB.INIT 36225 . 37686) (MB.TRACK.UNTIL 37688 . 38383) (MB.DON'T 38385 . 38681) (MB.SPEC.REMAINDER 
-38683 . 39302)) (39466 49471 (MB.3STATE.CREATE 39476 . 40340) (MB.3STATE.DISPLAYFN 40342 . 41328) (
-MB.3STATE.SHOWSELFN 41330 . 43641) (MB.3STATE.INIT 43643 . 45054) (MB.3STATE.SETSTATEFN 45056 . 45714)
- (MB.3STATE.BUTTONEVENTINFN 45716 . 49469)) (49626 78530 (MB.NWAY.CREATE 49636 . 55819) (
-MB.NWAY.DISPLAYFN 55821 . 56684) (MB.NWAY.SIZEFN 56686 . 60622) (MB.NWAY.SELECT 60624 . 64194) (
-MB.NWAY.BUTTONEVENTINFN 64196 . 67408) (MB.NWAY.NEWMENUBUTTON 67410 . 68122) (MB.NWAY.COPYFN 68124 . 
-69091) (MB.NWAY.INIT 69093 . 70584) (MB.NWAY.ARRANGEBUTTONS 70586 . 72557) (MB.NWAY.ADDITEM 72559 . 
-76708) (MB.NWAY.FINDSUBOBJ 76710 . 77224) (MB.NWAY.SETSTATEFN 77226 . 78528)) (78609 90608 (
-MB.TOGGLE.CREATE 78619 . 79614) (MB.TOGGLE.DISPLAYFN 79616 . 81099) (MB.TOGGLE.INIT 81101 . 82900) (
-MB.SET.TOGGLE 82902 . 84103) (MB.TOGGLE.SETSTATEFN 84105 . 84945) (MB.TOGGLE.BUTTONEVENTINFN 84947 . 
-89263) (MB.TOGGLE.WHENOPERATEDONFN 89265 . 90606)) (90689 123222 (MB.FIELD.CREATE 90699 . 96150) (
-MB.FIELD.DISPLAYFN 96152 . 96943) (MB.FIELD.IMAGEBOXFN 96945 . 98427) (MB.FIELD.PREFIXCREATE 98429 . 
-102365) (MB.FIELD.SUFFIXCREATE 102367 . 104027) (MB.FIELD.INIT 104029 . 105796) (
-MB.FIELD.WHENOPERATEDONFN 105798 . 107069) (MB.FIELD.GETSTATEFN 107071 . 111005) (MB.FIELD.SETSTATEFN 
-111007 . 115811) (MB.FIELD.BUTTONEVENTINFN 115813 . 118118) (MB.FIELD.SIZEFN 118120 . 118360) (
-MB.FIELD.INSURETYPE 118362 . 123220)))))
+  (FILEMAP (NIL (3182 19318 (MB.ADD 3192 . 9904) (MB.DELETE 9906 . 10280) (MB.GET 10282 . 17052) (
+MB.GET.MBARG 17054 . 18723) (TEDIT.BACKTOMAIN 18725 . 19316)) (19362 39298 (MB.BUTTONEVENTINFN 19372
+ . 20940) (MB.DISPLAYFN 20942 . 23001) (MB.SETIMAGE 23003 . 24171) (MB.SIZEFN 24173 . 25721) (
+MB.WHENOPERATEDONFN 25723 . 27672) (MB.COPYFN 27674 . 28132) (MB.GETFN 28134 . 29095) (MB.PUTFN 29097
+ . 30197) (MB.SHOWSELFN 30199 . 31708) (MB.CREATE 31710 . 35733) (MB.CHANGENAME 35735 . 36217) (
+MB.INIT 36219 . 37680) (MB.TRACK.UNTIL 37682 . 38377) (MB.DON'T 38379 . 38675) (MB.SPEC.REMAINDER 
+38677 . 39296)) (39460 49465 (MB.3STATE.CREATE 39470 . 40334) (MB.3STATE.DISPLAYFN 40336 . 41322) (
+MB.3STATE.SHOWSELFN 41324 . 43635) (MB.3STATE.INIT 43637 . 45048) (MB.3STATE.SETSTATEFN 45050 . 45708)
+ (MB.3STATE.BUTTONEVENTINFN 45710 . 49463)) (49620 78873 (MB.NWAY.CREATE 49630 . 55813) (
+MB.NWAY.DISPLAYFN 55815 . 56678) (MB.NWAY.SIZEFN 56680 . 60965) (MB.NWAY.SELECT 60967 . 64537) (
+MB.NWAY.BUTTONEVENTINFN 64539 . 67751) (MB.NWAY.NEWMENUBUTTON 67753 . 68465) (MB.NWAY.COPYFN 68467 . 
+69434) (MB.NWAY.INIT 69436 . 70927) (MB.NWAY.ARRANGEBUTTONS 70929 . 72900) (MB.NWAY.ADDITEM 72902 . 
+77051) (MB.NWAY.FINDSUBOBJ 77053 . 77567) (MB.NWAY.SETSTATEFN 77569 . 78871)) (78952 90951 (
+MB.TOGGLE.CREATE 78962 . 79957) (MB.TOGGLE.DISPLAYFN 79959 . 81442) (MB.TOGGLE.INIT 81444 . 83243) (
+MB.SET.TOGGLE 83245 . 84446) (MB.TOGGLE.SETSTATEFN 84448 . 85288) (MB.TOGGLE.BUTTONEVENTINFN 85290 . 
+89606) (MB.TOGGLE.WHENOPERATEDONFN 89608 . 90949)) (91032 123730 (MB.FIELD.CREATE 91042 . 96493) (
+MB.FIELD.DISPLAYFN 96495 . 97286) (MB.FIELD.IMAGEBOXFN 97288 . 98770) (MB.FIELD.PREFIXCREATE 98772 . 
+102708) (MB.FIELD.SUFFIXCREATE 102710 . 104370) (MB.FIELD.INIT 104372 . 106139) (
+MB.FIELD.WHENOPERATEDONFN 106141 . 107412) (MB.FIELD.GETSTATEFN 107414 . 111348) (MB.FIELD.SETSTATEFN 
+111350 . 116319) (MB.FIELD.BUTTONEVENTINFN 116321 . 118626) (MB.FIELD.SIZEFN 118628 . 118868) (
+MB.FIELD.INSURETYPE 118870 . 123728)))))
 STOP

library/tedit/TEDIT-FILE

@@ -1,13 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "15-Feb-2026 23:45:51" {WMEDLEY}<library>tedit>TEDIT-FILE.;666
 175062 
+
(FILECREATED "29-Apr-2026 23:49:14" {MEDLEY}<library>tedit>TEDIT-FILE.;684
 174888 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.PUT.MCCS.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW)
-                  (VARS TEDIT-FILECOMS)
+      :CHANGES-TO (FNS \TEDIT.INTERPRET.MCCS.SHIFTS)
 
-      :PREVIOUS-DATE "14-Feb-2026 10:32:44" {WMEDLEY}<library>tedit>TEDIT-FILE.;659)
+      :PREVIOUS-DATE "24-Apr-2026 21:09:13" {MEDLEY}<library>tedit>TEDIT-FILE.;683)
 
 
 (PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -39,8 +38,8 @@
                     (P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
               (FNS \TEDIT.GET.PIECES3 \TEDIT.GET.PROPS3 \TEDIT.MAKE.STRINGPIECE)
               (FNS \TEDIT.GET.UNFORMATTED.FILE.MCCS \TEDIT.INTERPRET.MCCS.SHIFTS 
-                   \TEDIT.CONVERT.XCCSTOMCCS)
-                                                             (* ; "XCCS")

+                   \TEDIT.CONVERT.XCCSTOMCCS \TEDIT.RUN.TO.STRINGPIECE)
+                                                             (* ; "MCCS")

               (FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
                                                              (* ; "UTF-8")

               (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.CHARLOOKS 
@@ -643,7 +642,8 @@
              TSTREAM)])
 
 (\TEDIT.GET.UNFORMATTED.FILE

-  [LAMBDA (STREAM TSTREAM START END PROPS)
                   (* ; "Edited 28-Jul-2025 23:46 by rmk")


+  [LAMBDA (STREAM TSTREAM START END PROPS)
                   (* ; "Edited 10-Apr-2026 09:33 by rmk")


+                                                             (* ; "Edited 28-Jul-2025 23:46 by rmk")


                                                              (* ; "Edited 24-Apr-2025 17:21 by rmk")


                                                              (* ; "Edited  8-Feb-2025 20:21 by rmk")


                                                              (* ; "Edited 17-Mar-2024 00:21 by rmk")


@@ -669,7 +669,7 @@
              (CL:WHEN (AND (EQ FORMAT :STRING)
                            (\IOMODEP STREAM 'OUTPUT T))
                  (SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
-             [SETQ PIECES
+             (SETQ PIECES
               (SELECTQ FORMAT
                   ((:MCCS :XCCS)                             (* ; "XCCS is done later")

                        (\TEDIT.GET.UNFORMATTED.FILE.MCCS
 STREAM START END DEFAULTCHARLOOKS 
@@ -703,8 +703,7 @@
                          PPARALAST _ NIL
                          PPARALOOKS _ DEFAULTPARALOOKS
                          PTYPE _ THINFILE.PTYPE
-                         PBYTESPERCHAR _ 1
-                         PBINABLE _ (fetch
 (STREAM BINABLE) of
 STREAM]
+                         PBYTESPERCHAR _ 1)))
              (\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
 
 (\TEDIT.GET.FORMATTED.FILE

@@ -940,7 +939,9 @@
 (DEFINEQ
 
 (\TEDIT.GET.PIECES3

-  [LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END)
            (* ; "Edited 29-Jul-2025 09:30 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT CURTEXTBYTE# END)
            (* ; "Edited 15-Apr-2026 12:06 by rmk")


+                                                             (* ; "Edited  9-Apr-2026 13:45 by rmk")


+                                                             (* ; "Edited 29-Jul-2025 09:30 by rmk")


                                                              (* ; "Edited 24-Apr-2025 17:20 by rmk")


                                                              (* ; "Edited  8-Feb-2025 20:21 by rmk")


                                                              (* ; "Edited 30-Aug-2024 15:44 by rmk")


@@ -962,7 +963,7 @@
     (SETFILEPTR TEXT (\DWIN
 TEXT))                           (* ; "Pieceinfo byte #")

     (for
 PCNO PC BYTELEN PREVPC FIRSTPC PARALOOKSMAP CHARLOOKSMAP DEFAULTCHARLOOKS OLDPARALOOKS
          (TEXTOBJ _ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
-         (ORIGBYTE# _ CURFILEBYTE#) from
 1 to
 PCCOUNT first
 (SETQ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ
+         (ORIGBYTE# _ CURTEXTBYTE#) from
 1 to
 PCCOUNT first
 (SETQ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ
                                                                                           
                                                                                      DEFAULTCHARLOOKS
                                                                                           ))
@@ -981,17 +982,15 @@
                    (SETQ PC
                     (create
 PIECE
                            PCONTENTS _ TEXT
-                           PFPOS _ CURFILEBYTE#
+                           PFPOS _ CURTEXTBYTE#
                            PLEN _ BYTELEN
-                           PBYTELEN _ BYTELEN
                            PPARALOOKS _ OLDPARALOOKS
                            PTYPE _ THINFILE.PTYPE
-                           PCHARSET _ 0
                            PBYTESPERCHAR _ 1
                            PREVPIECE _ PREVPC))
                    (\TEDIT.GET.CHARLOOKS.INDEX
 PC TEXT)      (* ; 
 
                                                             "Get its looks and character-pointers")

-                   (add
 CURFILEBYTE# BYTELEN))
+                   (add
 CURTEXTBYTE# BYTELEN))
               (\PieceDescriptorPARA                          (* ; 
 
                                                             "Reading a new set of paragraph looks.")

                    (CL:WHEN PREVPC (FSETPC PREVPC PPARALAST T))
@@ -1010,14 +1009,13 @@
                    (SETQ PC
                     (create
 PIECE
                            PCONTENTS _ TEXT
-                           PFPOS _ CURFILEBYTE#
-                           PBYTELEN _ BYTELEN
+                           PFPOS _ CURTEXTBYTE#
                            PLEN _ 1
                            PPARALOOKS _ OLDPARALOOKS
                            PTYPE _ OBJECT.PTYPE
                            PREVPIECE _ PREVPC))
-                   (\TEDIT.GET.OBJECT
 TSTREAM PC TEXT CURFILEBYTE#)
-                   (add
 CURFILEBYTE# BYTELEN)
+                   (\TEDIT.GET.OBJECT
 TSTREAM PC TEXT CURTEXTBYTE#)
+                   (add
 CURTEXTBYTE# BYTELEN)
                    (FSETPC PC PCHARLOOKS (if
 (ZEROP (BIN TEXT))
                                              then
 
 
@@ -1142,7 +1140,9 @@
                     PROPS)))])
 
 (\TEDIT.MAKE.STRINGPIECE

-  [LAMBDA (PC STRING)
                                        (* ; "Edited 23-Jan-2024 14:32 by rmk")


+  [LAMBDA (PC STRING)
                                        (* ; "Edited 12-Apr-2026 21:30 by rmk")


+                                                             (* ; "Edited 10-Apr-2026 09:33 by rmk")


+                                                             (* ; "Edited 23-Jan-2024 14:32 by rmk")


                                                              (* ; "Edited 16-Jan-2024 11:15 by rmk")


                                                              (* ; "Edited 12-Jan-2024 16:34 by rmk")

 
@@ -1155,15 +1155,10 @@
          (SETQ SPIECE (if
 (fetch
 (STRINGP FATSTRINGP) of
 STRING)
                           then
 (create
 PIECE using
 PC PTYPE _ FATSTRING.PTYPE PCONTENTS _ STRING PLEN
                                                    _ (NCHARS STRING)
-                                                   PBYTESPERCHAR _ 2 PBINABLE _ NIL PBYTELEN _
-                                                   (UNFOLD (NCHARS STRING)
-                                                          2)
-                                                   PREVPIECE _ PC PUTF8BYTESPERCHAR _ 2 PFPOS _ 0)
+                                                   PBYTESPERCHAR _ 2 PREVPIECE _ PC)
                         else
 (create
 PIECE using
 PC PTYPE _ THINSTRING.PTYPE PCONTENTS _ STRING PLEN
                                                  _ (NCHARS STRING)
-                                                 PBYTESPERCHAR _ 1 PBINABLE _ T PBYTELEN _
-                                                 (NCHARS STRING)
-                                                 PREVPIECE _ PC PUTF8BYTESPERCHAR _ 1 PFPOS _ 0)))
+                                                 PBYTESPERCHAR _ 1 PREVPIECE _ PC)))
          (CL:WHEN (NEXTPIECE PC)
              (FSETPC (NEXTPIECE PC)
                     PREVPIECE SPIECE))
@@ -1173,111 +1168,114 @@
 (DEFINEQ
 
 (\TEDIT.GET.UNFORMATTED.FILE.MCCS

-  [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS)
 (* ; "Edited 28-Jul-2025 23:45 by rmk")


-                                                             (* ; "Edited 21-Jan-2024 09:40 by rmk")


-                                                             (* ; "Edited 12-Jan-2024 13:13 by rmk")


-                                                             (* ; "Edited 10-Jan-2024 11:19 by rmk")


-                                                             (* ; "Edited  8-Jan-2024 13:15 by rmk")

+  [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS)
 (* ; "Edited 12-Apr-2026 21:34 by rmk")


+                                                             (* ; "Edited 10-Apr-2026 09:33 by rmk")

 
-    (* ;; "We build a chain of pieces  for the NS stringlets, some of which are divided at CR/LF.  ")

+    (* ;; 
+
    "We build a chain of pieces  for the MCCS stringlets, some of which are subdivided at CR/LF.  ")

 
     (* ;; "We assume that caller has positioned the stream at the intended start byte and has set the ENDOFSTREAMOP to return NIL on EOF. ")

 
-    (* ;; "CRBEFORE and the LF test are used to ensure that potential EOL's are normalized to EOL and appear at the end of their pieces, whether or not they we decide to make them PPARALAST on input.  LF's after CR are discarded, LF's by themselves are converted to singleton EOLstring pieces.")

+    (* ;; "This does not set PPARALAST on EOL pieces.  Maybe double EOL's?")

 
-    (bind
 (NEXTFILEPOS _ START)
-          (CHARSET _ 0)
-          (FIRSTPC _ (create
 PIECE
-                            PCHARLOOKS _ DEFAULTCHARLOOKS
-                            PPARALOOKS _ DEFAULTPARALOOKS))
-          (CODESIZE _ 1)
-          (SBINABLE _ (fetch
 (STREAM BINABLE) of
 STRM))
-          EOLC PC BYTE CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE SHIFTNEXT first
 (SETQ PREVPC FIRSTPC
-                                                                                  ) 
-                                                             (* ; "FIRSTPC is a throwaway")

-       do
 (SETQ FILEPOS NEXTFILEPOS)                         (* ; "Start of next file piece")

+    (* ;; "If a shift at the EOF is ill-formed, it is ignored--no error.")

 
-          (* ;; "In thin or fat mode, we have to look at the first byte of the next character, to see if it is a shift. If not a shift, we have to decode the byte configuration to make sure we can detect CR or LF.")

+    (* ;; 
+
    " LF's after CR are discarded, LF's by themselves are converted to singleton EOLstring pieces.")

 
-          (do
 (CL:WHEN (IGEQ NEXTFILEPOS END)
-                     (RETURN))
-              (SETQ BYTE (\PEEKBIN STRM T))
-              (CL:WHEN (SETQ SHIFTNEXT (EQ NSCHARSETSHIFT BYTE))
-                  (SETQ CHAR NIL)                            (* ; 
-
                                                             "Suppress CR/LF checking on real shift")

-                  (RETURN))
-              (BIN STRM)                                     (* ; "Not a shift, read the peeked byte")

-              (SETQ CHAR (if
 (EQ CODESIZE 2)
-                             then
                            (* ; 
-
                                                             "Return T if this takes us over the end")

-                                  (LOGOR (LLSH BYTE 8)
-                                         (CL:IF (AND (ILEQ NEXTFILEPOS END)
-                                                     (SETQ BYTE (BIN STRM)))
-                                             BYTE
-                                             (RETURN)))
-                           else
 (LOGOR (LLSH CHARSET 8)
-                                       BYTE)))
-              (add
 NEXTFILEPOS CODESIZE)
-              (CL:WHEN (MEMB CHAR (CHARCODE (CR LF)))
-                     (RETURN))) 
+    (bind
 PREVPC PC CHAR TWOBYTE CHARLIST PLEN STARTPOS STRING (FIRSTPIECE _ (create
 PIECE))
+          (CHARSET _ 0) first
 (SETQ PREVPC FIRSTPIECE)
+       do
 (SETQ PLEN 0)
+          (SETQ STARTPOS (GETFILEPTR STRM))
+          [while
 (SETQ CHAR (BIN STRM)) until
 (EQ CHAR NSCHARSETSHIFT)
+             do
 (CL:WHEN TWOBYTE
+                    (SETQ CHARSET (LLSH CHAR 8))
+                    (CL:UNLESS (SETQ CHAR (BIN STRM))        (* ; "Ill-formed at EOF, skip last byte")

+                        (RETURN)))
+                (SETQ CHAR (LOGOR CHARSET CHAR))
+                (CL:UNLESS (OR TWOBYTE (EQ CHARSET 0))       (* ; "Collect characters for fatstring")

+                    (push
 CHARLIST CHAR))
+                (add
 PLEN 1) repeatuntil
 (MEMB CHAR (CHARCODE (CR LF] 
 
-          (* ;; "NEXTFILEPOS and file are positioned at beginning of the next piece, possibly after CR and LF have been read.")

+          (* ;; "Reached the end of the current (sub) run")

 
-          (SETQ RUNLEN (IDIFFERENCE NEXTFILEPOS FILEPOS))
-          (CL:WHEN (EQ CHAR (CHARCODE LF))                   (* ; "We never produce raw LF's")

-              (add
 RUNLEN (IMINUS CODESIZE)))
-          (CL:WHEN (IGREATERP RUNLEN 0)
-              (SETQ PTYPE (if
 (EQ CODESIZE 2)
-                              then
 FATFILE2.PTYPE
-                            elseif
 (EQ CHARSET 0)
-                              then
 THINFILE.PTYPE
-                            else
 FATFILE1.PTYPE))
+          (CL:UNLESS (EQ PLEN 0)                             (* ; "Make subrun's piece")

+              (SELCHARQ CHAR
+                   (CR                                       (* ; "Skip following LF")

+                       (if
 TWOBYTE
+                           then
 (CL:WHEN (EQ 0 (\PEEKCCODE STRM T))
+                                    (BIN STRM)
+                                    (CL:IF (EQ (CHARCODE LF)
+                                               (\PEEKCCODE STRM T))
+                                        (BIN STRM)
+                                        (\BACKFILEPTR STRM)))
+                         elseif
 (EQ (CHARCODE LF)
+                                    (\PEEKCCODE STRM T))
+                           then
 (BIN STRM)))
+                   (LF                                       (* ; 
+
                                      "Prefix bcomes a separate piece, LF a singleton coerced to EOL")

+                       (if
 (EQ PLEN 1)
+                           then
 (SETQ CHARLIST (CHARCODE (EOL))) 
+                                                             (* ; "Let it be fat below")

+                         else
 (add
 PLEN -1)                  (* ; 
+
                                              "Back up to split the LF off into a separate EOL piece")

+                              (\BACKFILEPTR STRM)
+                              (CL:WHEN TWOBYTE (\BACKFILEPTR STRM))))
+                   NIL)
               (SETQ PC
-               (create
 PIECE
-                      PTYPE _ PTYPE
-                      PCONTENTS _ STRM
-                      PFPOS _ FILEPOS
-                      PLEN _ (IQUOTIENT RUNLEN CODESIZE)
-                      PCHARLOOKS _ DEFAULTCHARLOOKS
-                      PPARALOOKS _ DEFAULTPARALOOKS
-                      PCHARSET _ CHARSET
-                      PBYTESPERCHAR _ CODESIZE
-                      PBYTELEN _ RUNLEN
-                      PREVPIECE _ PREVPC
-                      PBINABLE _ (AND (EQ PTYPE THINFILE.PTYPE)
-                                      SBINABLE)))
-              (SETQ PREVPC (FSETPC PREVPC NEXTPIECE PC)))
-          (CL:WHEN (EQ CHAR (CHARCODE LF))
-              [if
 CRBEFORE
-                  then
 (SETQ EOLC CRLF.EOLC)
-                else
 
-                     (* ;; "Linefeed not preceded by CR, replace by string piece")

+               (if
 CHARLIST
+                   then
 (SETQ STRING (ALLOCSTRING (LENGTH CHARLIST)
+                                            NIL NIL T))
+                        (for
 C in
 CHARLIST as
 I from
 PLEN by
 -1 do
 (RPLCHARCODE STRING I C))
+                        (SETQ CHARLIST NIL)
+                        (create
 PIECE
+                               PTYPE _ FATSTRING.PTYPE
+                               PCONTENTS _ STRING
+                               PLEN _ PLEN
+                               PBYTESPERCHAR _ 2)
+                 elseif
 TWOBYTE
+                   then
 (create
 PIECE
+                               PTYPE _ FATFILE2.PTYPE
+                               PCONTENTS _ STRM
+                               PFPOS _ STARTPOS
+                               PLEN _ PLEN
+                               PBYTESPERCHAR _ 2)
+                 else
 (create
 PIECE
+                             PTYPE _ THINFILE.PTYPE
+                             PCONTENTS _ STRM
+                             PFPOS _ STARTPOS
+                             PLEN _ PLEN
+                             PBYTESPERCHAR _ 1)))
+              (FSETPC PC PCHARLOOKS DEFAULTCHARLOOKS)
+              (FSETPC PC PPARALOOKS DEFAULTPARALOOKS)
+              (FSETPC PC PREVPIECE PREVPC)
+              (FSETPC PREVPC NEXTPIECE PC)
+              (SETQ PREVPC PC)) 
 
-                     (SETQ EOLC LF.EOLC)
-                     (SETQ PREVPC (\TEDIT.MAKE.STRINGPIECE
 PREVPC (CHARCODE EOL])
-          (CL:WHEN SHIFTNEXT                                 (* ; 
-
                                           "Interpret and bump NEXTFILEPOS for the shifting bytes.  ")

-              (BIN STRM)                                     (* ; "Read the original peeked byte")

-              (SETQ CHARSET (BIN STRM))
-              (if
 (EQ CHARSET \NORUNCODE)
-                  then
 (CL:UNLESS (MEMB (BIN STRM)
-                                        '(0 NIL))
-                              (ERROR "EXPECTED PLANE 0 XCCS CHARACTER IS ILL-FORMED"))
-                       (SETQ CHARSET 0)
-                       (SETQ CODESIZE 2)
-                else
 (SETQ CODESIZE 1))
-              (add
 NEXTFILEPOS (ADD1 CODESIZE))
-              (SETQ SHIFTNEXT NIL))
-          (CL:WHEN (IGEQ NEXTFILEPOS END)
-              (CL:WHEN EOLC                                  (* ; 
-
                                                             "Record the last one we encountered")

-                  (replace
 (STREAM EOLCONVENTION) of
 STRM with
 EOLC))
-              (RETURN (NEXTPIECE FIRSTPC)))
-          (CL:WHEN (SETQ CRBEFORE (EQ CHAR (CHARCODE CR)))
-                 (SETQ EOLC CR.EOLC])
+          (* ;; "Switch to next run, end, or continue with next subrun")

+
+          (SELECTC CHAR
+              (NSCHARSETSHIFT                                (* ; "Switch to next run")

+                   (SETQ CHARSET (BIN STRM))
+                   (CL:UNLESS CHARSET                        (* ; "Ill-formed")

+                       (RETURN (NEXTPIECE FIRSTPIECE)))
+                   (SETQ TWOBYTE (CL:WHEN (EQ CHARSET \NORUNCODE)
+                                     (SETQ CHARSET (BIN STRM))
+                                     (CL:UNLESS CHARSET      (* ; "Ill-formed")

+                                         (RETURN (NEXTPIECE FIRSTPIECE)))
+                                     (CL:UNLESS (EQ CHARSET 0)
+                                            (\MCCS.24BITENCODING.ERROR STRM))
+                                     T))
+                   (SETQ CHARSET (LLSH CHARSET 8)))
+              (NIL                                           (* ; "End of file")

+                   (RETURN (NEXTPIECE FIRSTPIECE)))
+              NIL])
 
 (\TEDIT.INTERPRET.MCCS.SHIFTS

-  [LAMBDA (PIECES PFILE)
                                     (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (PIECES PFILE)
                                     (* ; "Edited 29-Apr-2026 23:48 by rmk")


+                                                             (* ; "Edited 24-Apr-2026 21:08 by rmk")


+                                                             (* ; "Edited 10-Apr-2026 09:33 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 14-May-2024 18:39 by rmk")


                                                              (* ; "Edited 21-Jan-2024 00:02 by rmk")


                                                              (* ; "Edited 19-Jan-2024 10:34 by rmk")


@@ -1285,58 +1283,44 @@
                                                              (* ; "Edited  6-Jan-2024 15:02 by rmk")


                                                              (* ; "Edited 19-Dec-2023 13:13 by rmk")

 
-    (* ;; "This is called after a GET or PUT, when the file pieces are known all to reside in PFILE.PIECES is a chain of pieces read from a formatted XCCS file but not yet inserted into the BTREE.  Each file piece has PFILE, PFPOS, and PBYTELEN.  This function interprets any XCCS shift characters that prefix the actual characters, coercing the piece properties and bumping the PFPOS/PLEN to hide the shifts. ")

+    (* ;; "This is called after by \TEDIT.GET.PIECES, after a GET, when the pieces are known all to reside in PFILE. PIECES is a chain of pieces read from a formatted MCCS (or XCCS) file but not yet inserted into the BTREE.  Each file piece has PFILE and PFPOS.  This function makes sure that no shift bytes are included in the pieces, by coercing the piece properties and bumping the PFPOS/PLEN to hide the shifts. This also coerces non-charset 0 one-byte pieces to fatstrings.")

 
     (* ;; "We run this before the pieces are inistalled in a stream, since this may change the character lengths.")

 
+    (* ;; "This also has some EOL normalization.")

+
     (for
 PC BYTE EOLC inpieces
 PIECES when
 (EQ PFILE (PCONTENTS PC))
        do
 (\SETFILEPTR PFILE (PFPOS PC))
           (SETQ BYTE (BIN PFILE))
-          [if
 (EQ NSCHARSETSHIFT BYTE)
+          (if
 (EQ NSCHARSETSHIFT BYTE)
               then
 (SELECTC (SETQ BYTE (BIN PFILE))
-                       (0                                    (* ; "Runlength of charset 0")

-                          (add
 (PBYTELEN PC)
-                               -2)                           (* ; 
-
                                                             "The shift characters really disappear")

-                          (FSETPC PC PLEN (PBYTELEN PC))
-                          (FSETPC PC PTYPE THINFILE.PTYPE)
-                          (FSETPC PC PBINABLE T)
-                          (FSETPC PC PCHARSET 0)
-                          (add
 (PFPOS PC)
-                               2))
-                       (\NORUNCODE                           (* ; "Going for 3 byte characters")

+                       (0 (add
 (PFPOS PC)
+                               2)
+                          (add
 (PLEN PC)
+                               -2))
+                       (\NORUNCODE                           (* ; "Going for 2 byte characters")

                                    (CL:UNLESS (EQ 0 (BIN PFILE))
-                                          (\TEDIT.THELP "XCCS CHARACTER NOT IN PLANE 0"))
+                                       (\TEDIT.THELP "MCCS CHARACTER NOT IN PLANE 0, FILEPOS = "
+                                              (IDIFFERENCE (GETFILEPTR PFILE)
+                                                     2)))
                                    (FSETPC PC PTYPE FATFILE2.PTYPE)
-                                   (FSETPC PC PBYTESPERCHAR 2)
                                    (add
 (PFPOS PC)
                                         3)
-                                   (add
 (PBYTELEN PC)
-                                        -3)
-                                   (FSETPC PC PLEN (FOLDLO (PBYTELEN PC)
-                                                          2)))
+                                   (change
 (PLEN PC)
+                                          (FOLDLO (IDIFFERENCE DATUM 3)
+                                                 2)))
                        (PROGN 
-                              (* ;; "A run in a non-zero charset.  Convert it to FATFILE1. Could also read into a FATSTRING instead, get rid of on-file FATFILE1. A string piece could hold adjacent  substrings in different charsets")

+                              (* ;; "A run in a non-zero charset.  Convert it to FATSTRING so we don't have  to maintain code to interpret XCCS stringlet pieces.  After all, space efficiency is far worse for our ultimate goal of UTF-8 codes.")

 
-                              (add
 (PBYTELEN PC)
-                                   -2)
-                              (add
 (PFPOS PC)
-                                   2)
-                              (FSETPC PC PLEN (PBYTELEN PC))
-                              (FSETPC PC PBINABLE NIL)
-                              (FSETPC PC PTYPE FATFILE1.PTYPE)
-                              (FSETPC PC PBYTESPERCHAR 1)
-                              (FSETPC PC PCHARSET BYTE)))
-            elseif
 (EQ 2 (PBYTESPERCHAR PC))
-              then
 (FSETPC PC PTYPE FATFILE2.PTYPE)          (* ; "This is the continuation of an XCCS 2-byte run that was broken up presumably for looks or paragraphs")

-                   (FSETPC PC PCHARSET \NORUNCODE)
-                   (FSETPC PC PLEN (FOLDLO (PBYTELEN PC)
-                                          2))
-            else
 (FSETPC PC PCHARSET 0)                      (* ; "A charset 0 1-byte run")

-                 (FSETPC PC PBINABLE T)
-                 (FSETPC PC PBYTESPERCHAR 1)
-                 [\SETFILEPTR PFILE (IPLUS (PFPOS PC)
-                                           (SUB1 (PLEN PC]
+                              (\TEDIT.RUN.TO.STRINGPIECE
 PC BYTE PFILE)))
+            elseif
 (EQ FATFILE2.PTYPE (PTYPE PC))
+              then
                                           (* ; "This is the continuation of an MCCS 2-byte run that was broken up presumably for looks or paragraphs")

+                   (change
 (PLEN PC)
+                          (FOLDLO DATUM 2))
+            else
 (FSETPC PC PBYTESPERCHAR 1)                 (* ; "A charset 0 1-byte run")

+                 [\SETFILEPTR PFILE (SUB1 (IPLUS (PFPOS PC)
+                                                 (PLEN PC]   (* ; 
+
                          "Position for the last byte for EOL processing.  Maybe only if PPARALAST ?")

                  (if
 (EQ (CHARCODE LF)
                          (SETQ BYTE (BIN PFILE)))
                      then
 
@@ -1350,8 +1334,6 @@
                             else
 (add
 (PLEN PC)
                                       -1)                    (* ; 
 
                                             "Shorten PC, add EOL string piece unless preceded by CR")

-                                 (add
 (PBYTELEN PC)
-                                      -1)
                                  (if
 (EQ (CHARCODE CR)
                                          (\BACKBIN PFILE))
                                      then
 (SETQ EOLC CRLF.EOLC)
@@ -1360,10 +1342,9 @@
                                                         (FSETPC PC PPARALAST NIL]
                    else
 (CL:WHEN (EQ BYTE (CHARCODE CR))
                                (SETQ EOLC CR.EOLC))
-                        (FSETPC PC PTYPE THINFILE.PTYPE)
-                        (FSETPC PC PLEN (PBYTELEN PC] finally
 (CL:WHEN EOLC
-                                                                  (replace
 (STREAM EOLCONVENTION)
-                                                                     of
 PFILE with
 EOLC)))
+                        (FSETPC PC PTYPE THINFILE.PTYPE)))
+       finally
 (CL:WHEN EOLC
+                   (replace
 (STREAM EOLCONVENTION) of
 PFILE with
 EOLC)))
     PIECES])
 
 (\TEDIT.CONVERT.XCCSTOMCCS

@@ -1379,16 +1360,30 @@
                                                                                  TSTREAM CHNO)))
            unless
 (EQ CHAR (SETQ CHAR (MTOXCODE CHAR))) do
 (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR NIL
                                                                   T)))])
+
+(\TEDIT.RUN.TO.STRINGPIECE

+  [LAMBDA (PC CHARSET PFILE)
                                 (* ; "Edited 10-Apr-2026 09:20 by rmk")


+                                                             (* ; "Edited  7-Apr-2026 18:16 by rmk")

+    (SETQ CHARSET (LLSH CHARSET 8))
+    (LET ((STRING (ALLOCSTRING (PLEN PC)
+                         NIL NIL T)))
+         [for
 I from
 1 to
 (PLEN PC) do
 (RPLCHARCODE STRING I (LOGOR CHARSET (BIN PFILE]
+         (FSETPC PC PTYPE FATSTRING.PTYPE)
+         (FSETPC PC PCONTENTS STRING)
+         (FSETPC PC PBYTESPERCHAR 2)
+         PC])
 )
 
 
 
-(* ; "XCCS")

+(* ; "MCCS")

 
 (DEFINEQ
 
 (\TEDIT.GET.UNFORMATTED.FILE.UTF8

-  [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS)
 (* ; "Edited 23-Oct-2025 08:48 by rmk")


+  [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS)
 (* ; "Edited 12-Apr-2026 21:46 by rmk")


+                                                             (* ; "Edited 10-Apr-2026 09:24 by rmk")


+                                                             (* ; "Edited 23-Oct-2025 08:48 by rmk")


                                                              (* ; "Edited 28-Jul-2025 23:45 by rmk")


                                                              (* ; "Edited 11-Mar-2024 23:55 by rmk")


                                                              (* ; "Edited  4-Feb-2024 10:12 by rmk")


@@ -1409,7 +1404,6 @@
                             PCHARLOOKS _ DEFAULTCHARLOOKS
                             PPARALOOKS _ DEFAULTPARALOOKS))
           (NEXTCODESIZE _ 1)
-          (SBINABLE _ (fetch
 (STREAM BINABLE) of
 STRM))
           EOLC CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE CODESIZE PREVCRLF
        first
 (SELECTQ (READBOM STRM)
                  (:UTF-8 (add
 NEXTFILEPOS 3))
@@ -1457,21 +1451,16 @@
               (SETQ PTYPE (CL:IF (EQ CODESIZE 1)
                               THINFILE.PTYPE
                               UTF8.PTYPE))
-              (SETQ PREVPC
-               (FSETPC PREVPC NEXTPIECE
-                      (create
 PIECE
-                             PTYPE _ PTYPE
-                             PCONTENTS _ STRM
-                             PFPOS _ FILEPOS
-                             PLEN _ (IQUOTIENT RUNLEN CODESIZE)
-                             PCHARLOOKS _ DEFAULTCHARLOOKS
-                             PPARALOOKS _ DEFAULTPARALOOKS
-                             PBYTESPERCHAR _ CODESIZE
-                             PBYTELEN _ RUNLEN
-                             PREVPIECE _ PREVPC
-                             PBINABLE _ (AND (EQ PTYPE THINFILE.PTYPE)
-                                             SBINABLE)
-                             PUTF8BYTESPERCHAR _ CODESIZE))))
+              (SETQ PREVPC (FSETPC PREVPC NEXTPIECE
+                                  (create
 PIECE
+                                         PTYPE _ PTYPE
+                                         PCONTENTS _ STRM
+                                         PFPOS _ FILEPOS
+                                         PLEN _ (IQUOTIENT RUNLEN CODESIZE)
+                                         PCHARLOOKS _ DEFAULTCHARLOOKS
+                                         PPARALOOKS _ DEFAULTPARALOOKS
+                                         PBYTESPERCHAR _ CODESIZE
+                                         PREVPIECE _ PREVPC))))
           (CL:WHEN (EQ CHAR (CHARCODE LF))
               [if
 CRBEFORE
                   then
 (SETQ EOLC CRLF.EOLC)
@@ -1646,7 +1635,8 @@
     (\WIN STREAM])
 
 (\TEDIT.GET.CHARLOOKS.INDEX

-  [LAMBDA (PC FORMATSTREAM)
                                  (* ; "Edited 28-Jul-2025 23:46 by rmk")


+  [LAMBDA (PC FORMATSTREAM)
                                  (* ; "Edited 24-Apr-2026 21:03 by rmk")


+                                                             (* ; "Edited 28-Jul-2025 23:46 by rmk")


                                                              (* ; "Edited 14-Jan-2024 00:11 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited  3-Sep-2023 23:31 by rmk")


@@ -1654,18 +1644,18 @@
                                                              (* ; "Edited 26-Aug-2023 23:22 by rmk")


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

 
-    (* ;; "Set the type, length, and and charlooks-index for the current piece, PC")

+    (* ;; "Set the type, length, and charlooks-index for the current piece, PC")

 
     (LET ((FLAGS (BIN FORMATSTREAM)))
          (FSETPC PC PCHARLOOKS (\WIN FORMATSTREAM))
          (CL:UNLESS (ZEROP (LOGAND FLAGS 1))
                 (FSETPC PC PNEW T))
-         (CL:UNLESS (ZEROP (LOGAND FLAGS 2))                 (* ; 
-
                                         "XCSS FAT. It may be a continuation of a previous fat piece")

-             (FSETPC PC PLEN (IQUOTIENT (FGETPC PC PLEN)
-                                    2))
-             (FSETPC PC PTYPE FATFILE2.PTYPE)
-             (FSETPC PC PBYTESPERCHAR 2))])
+         (CL:UNLESS (ZEROP (LOGAND FLAGS 2))
+
+             (* ;; "MCSS FAT. It may have a 255 255 0 (NSHIFTBYTES=3) prefix or it may be  a continuation of a previous fat piece.  PLEN on the file is the runlength including the NSHIFTBYTES, so we can't fold from bytes to chars here: \TEDIT.INTERPRET.MCCS.SHIFTS.  Until then, this is goofy")

+
+             (FSETPC PC PBYTESPERCHAR 2)
+             (FSETPC PC PTYPE FATFILE2.PTYPE))])
 )
 (DEFINEQ
 
@@ -1773,7 +1763,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.OBJECT

-  [LAMBDA (TSTREAM PIECE FILE CURFILEBYTE# BYTELEN)
          (* ; "Edited  1-Aug-2025 14:50 by rmk")


+  [LAMBDA (TSTREAM PIECE FILE CURTEXTBYTE# BYTELEN)
          (* ; "Edited 15-Apr-2026 12:05 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 14:50 by rmk")


                                                              (* ; "Edited 28-Jul-2025 23:46 by rmk")


                                                              (* ; "Edited 31-Jul-2024 12:09 by rmk")


                                                              (* ; "Edited  5-Dec-2023 12:28 by rmk")


@@ -1794,13 +1785,13 @@
 
          (* ;; "rrb 10-AUG-87 --- calculate the length of the image object's data.  This assumes that the file is currently pointed at the end of the data which is where the GETFN is written {I think}.")

 
-         (* ;; "RMK:  Originally, BYTELEN was calculated here as (DIFFERENCE (GETFILEPTR FILE) CURFILEBYTE#).  But this is garbage: (GETFILEPTR FILE) is in the looks section, CURFILEBYTE# is in the text section. The caller knows the true value, now passes it in. ")

+         (* ;; "RMK:  Originally, BYTELEN was calculated here as (DIFFERENCE (GETFILEPTR FILE) CURTEXTBYTE#).  But this is garbage: (GETFILEPTR FILE) is in the looks section, CURTEXTBYTE# is in the text section. The caller knows the true value, now passes it in. ")

 
          (SETQ GETFN (\ATMIN
 FILE))                          (* ; 
 
                                                             "The GETFN for this kind of IMAGEOBJ")

          (SETQ FILEPTRSAVE (GETFILEPTR FILE))                (* ; 
 
                                             "Save our file location thru the building of the object")

-         (SETFILEPTR FILE CURFILEBYTE#)
+         (SETFILEPTR FILE CURTEXTBYTE#)
          (SETQ OBJ (READIMAGEOBJ FILE GETFN NIL BYTELEN))
          (CL:WHEN (IMAGEOBJPROP OBJ 'UNKNOWNGETFN)           (* ; 
 
      "If the object has an unknown getfn property, then it's an encapsulated object.  Warn the user")

@@ -1832,6 +1823,9 @@
 
 (\TEDIT.PUT.PCTB

   [LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)

+                                                             (* ; "Edited 18-Apr-2026 14:56 by rmk")


+                                                             (* ; "Edited  9-Apr-2026 23:19 by rmk")


+                                                             (* ; "Edited  7-Apr-2026 12:31 by rmk")


                                                              (* ; "Edited 14-Feb-2026 10:32 by rmk")


                                                              (* ; "Edited  9-Sep-2025 21:32 by rmk")


                                                              (* ; "Edited 26-Apr-2025 00:11 by rmk")


@@ -1870,8 +1864,8 @@
     (CL:WHEN (EQ :UTF-8 (STREAMPROP CHARSTREAM 'FORMAT))
            (\TEDIT.PUT.UTF8.SPLITPIECES
 TEXTOBJ))
     (for
 PC PFILE NEXTNEW RUNLEN UNFORMATTED? (NSHIFTBYTES _ 0)
-         (CURBYTE# _ 0)
-         (OLDBYTE# _ 0)
+         (CURTEXTBYTE# _ 0)
+         (OLDTEXTBYTE# _ 0)
          [UNFORMATTED? _ (PROG1 (EQ FORMATSTREAM T)
                              (CL:UNLESS (STREAMP FORMATSTREAM)
                                  [SETQ FORMATSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW
@@ -1906,8 +1900,8 @@
 
              (* ;; " We're ready to put the pieces on the output file.  ")

 
-             (SETQ CURBYTE# (\GETFILEPTR CHARSTREAM))
-             (SETQ OLDBYTE# CURBYTE#) 
+             (SETQ CURTEXTBYTE# (\GETFILEPTR CHARSTREAM))
+             (SETQ OLDTEXTBYTE# CURTEXTBYTE#) 
 
              (* ;; "ZEROP should never happen, but...")

 
@@ -1915,7 +1909,7 @@
 
               unless
 (ZEROP (PLEN PC))
        do
 
-          (* ;; "PC starts a run of one or more pieces that can be collapsed together into a single file piece.  The paragraph looks are produced before the first piece of a new paragraph (first piece or previous piece was PPARALAST), then the piece(s)-characters, followed by the charlooks.  I.e., FORMATSTREAM describes the paragraph-start piece with its paragraph looks forllowed by its char looks.")

+          (* ;; "PC starts a run of one or more pieces that can be collapsed together into a single file piece.  The paragraph looks are produced before the first piece of a new paragraph (first piece or previous piece was PPARALAST), then the piece(s)-characters, followed by the charlooks.  I.e., FORMATSTREAM describes the paragraph-start piece with its paragraph looks followed by its char looks.")

 
           (CL:WHEN (OR (NULL (PREVPIECE PC))
                        (PPARALAST (PREVPIECE PC)))
@@ -1923,15 +1917,15 @@
               (add
 PCCOUNT 1))
           (CL:WHEN (MEMB EXTFORMAT '(:MCCS :XCCS))
 
-              (* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file.   TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes.  NSHIFTBYTES is used here if the edit will continue.")

+              (* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file.   TEDIT.GET calls \TEDIT.INTERPRET.MCCS.SHIFTS to shave those bytes.  NSHIFTBYTES is used here so the edit can continue.")

 
-              (CHARSET CHARSTREAM (OR (AND (EQ EXTFORMAT :XCCS)
-                                           (MEMB (PTYPE PC)
-                                                 FAT.PTYPES))
-                                      (PCHARSET PC)))
+              (CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
+                                               FAT.PTYPES)
+                                      T
+                                      0))
               (SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM)
-                                       OLDBYTE#)))
-          (do
 (\TEDIT.PUT.PCTB.PIECEDATA
 PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#)
+                                       OLDTEXTBYTE#)))
+          (do
 (\TEDIT.PUT.PCTB.PIECEDATA
 PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDTEXTBYTE#)
               (CL:UNLESS (\TEDIT.PUT.PCTB.MERGEABLE
 PC (NEXTPIECE PC)
                                 EDITSTENTATIVE EXTFORMAT TEXTOBJ)
                      (RETURN))
@@ -1939,8 +1933,8 @@
 
           (* ;; "PC is the last piece written for a mergeable sequence. Finish off the corresponding file piece by writing PC's character looks into FORMATSTREAM. ")

 
-          (SETQ CURBYTE# (\GETFILEPTR CHARSTREAM))
-          (SETQ RUNLEN (IDIFFERENCE CURBYTE# OLDBYTE#))
+          (SETQ CURTEXTBYTE# (\GETFILEPTR CHARSTREAM))
+          (SETQ RUNLEN (IDIFFERENCE CURTEXTBYTE# OLDTEXTBYTE#))
           (CL:UNLESS (EQ OBJECT.PTYPE (PTYPE PC))            (* ; 
 
                                              "Objects get their charlooks from the preceding piece.")

               (\TEDIT.PUT.CHARLOOKS
 FORMATSTREAM RUNLEN PC EDITSTENTATIVE LOOKSHASH))
@@ -1952,28 +1946,30 @@
 
               (* ;; "Only for continued editing: make a new piece that describes those characters as they now reside on CHARSTREAM. ")

 
-              (SETQ NEXTNEW (\TEDIT.PUT.PCTB.NEXTNEW
 NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ 
+              (SETQ NEXTNEW (\TEDIT.PUT.PCTB.NEXTNEW
 NEXTNEW PC OLDTEXTBYTE# RUNLEN EXTFORMAT TEXTOBJ
                                    EOLC NSHIFTBYTES)))
-          (SETQ OLDBYTE# CURBYTE#) finally
 
+          (SETQ OLDTEXTBYTE# CURTEXTBYTE#) finally
 
 
                                  (* ;; "Finalize and append FORMATSTREAM unless unformatted or KEEPSEPARATE (for splitting). If KEEPSEPARATE, the caller must have provided the formatstream")

 
-                                         (CL:UNLESS UNFORMATTED?
-                                             (\TEDIT.PUT.TRAILER
 FORMATSTREAM (\GETFILEPTR CHARSTREAM
-                                                                                     )
-                                                    PCCOUNT 3 (FGETTOBJ TEXTOBJ DOCPROPS)))
-                                         (CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE)
-                                             (COPYBYTES FORMATSTREAM CHARSTREAM 0 (GETEOFPTR 
-                                                                                         FORMATSTREAM
-                                                                                         )))
-                                         (RETURN (CL:WHEN NEWPIECES
+                                                 (CL:UNLESS UNFORMATTED?
+                                                     (\TEDIT.PUT.TRAILER
 FORMATSTREAM (\GETFILEPTR
+                                                                                       CHARSTREAM)
+                                                            PCCOUNT 3 (FGETTOBJ TEXTOBJ DOCPROPS)))
+                                                 (CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE)
+                                                     (COPYBYTES FORMATSTREAM CHARSTREAM 0
+                                                            (GETEOFPTR FORMATSTREAM)))
+                                                 (RETURN (CL:WHEN NEWPIECES
 
-                                 (* ;; "Throw away the dummy head of the new piece chain (NEWPIECES is NIL if not continuing). The caller must make install the new pieces.")

+                                   (* ;; "Throw away the dummy head of the new piece chain (NEWPIECES is NIL if not continuing). The caller must install the new pieces.")

 
-                                                     (NEXTPIECE NEWPIECES))])
+                                                             (NEXTPIECE NEWPIECES))])
 
 (\TEDIT.PUT.PCTB.PIECEDATA

-  [LAMBDA (PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#)
      (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDTEXTBYTE#)
  (* ; "Edited 18-Apr-2026 14:54 by rmk")


+                                                             (* ; "Edited  9-Apr-2026 13:37 by rmk")


+                                                             (* ; "Edited  7-Apr-2026 18:10 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 15-May-2024 17:04 by rmk")

 
     (* ;; "Write the data defining PC on CHARSTREAM.")

@@ -1982,7 +1978,7 @@
 
     (* ;; "FORMATSTREAM is needed for objects.")

 
-    (* ;; "OLDBYTE# needed to deal with XCCS shift before objects.")

+    (* ;; "OLDTEXTBYTE# needed to deal with XCCS shift before objects.")

 
     (LET (PFILE)
          (CL:WHEN (MEMB (PTYPE PC)
@@ -2004,16 +2000,9 @@
                             (for
 CH instring
 (PCONTENTS PC) do
 (\OUTCHAR CHARSTREAM CH)))
              (FATFILE2.PTYPE 
                   (for
 I from
 1 to
 (PLEN PC) do
 (\OUTCHAR CHARSTREAM (\WIN PFILE))))
-             (FATFILE1.PTYPE 
-                             (* ;; 
-
                             "We read but don't write FATFILE1 pieces, they merge with FATFILE2.")

-
-                  [for
 I (CSET _ (LLSH (PCHARSET PC)
-                                       8)) from
 1 to
 (PLEN PC)
-                     do
 (\OUTCHAR CHARSTREAM (LOGOR CSET (BIN PFILE])
              (UTF8.PTYPE (for
 I from
 1 to
 (PLEN PC) do
 (\OUTCHAR CHARSTREAM (UTF8.INCCODEFN PFILE))))
              (OBJECT.PTYPE                                   (* ; "It's an object, use its PUTFN.")

-                           (\TEDIT.PUT.OBJECT
 PC CHARSTREAM FORMATSTREAM OLDBYTE#)
+                           (\TEDIT.PUT.OBJECT
 PC CHARSTREAM FORMATSTREAM OLDTEXTBYTE#)
 
                            (* ;; "0 indicates that nothing special needs to be done here to recover the looks of this piece.  \TEDIT.GET.PIECES3 says that the object-piece looks are taken from the previous piece (or default for first piece.  In earlier versions the value 1 indicated that the looks were not indexed and therefore had to be written explicitly here. This byte won't be needed in the next version of the format.")

 
@@ -2041,7 +2030,9 @@
          (\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
 
 (\TEDIT.PUT.PCTB.MERGEABLE

-  [LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ)
       (* ; "Edited  1-Aug-2025 14:51 by rmk")


+  [LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ)
       (* ; "Edited 12-Apr-2026 21:44 by rmk")


+                                                             (* ; "Edited  7-Apr-2026 18:07 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 14:51 by rmk")


                                                              (* ; "Edited 25-Apr-2025 23:50 by rmk")


                                                              (* ; "Edited 24-Apr-2025 16:02 by rmk")


                                                              (* ; "Edited 14-May-2024 11:55 by rmk")


@@ -2076,21 +2067,21 @@
                                    (THINPIECEP PC)))
                           (:UTF-8 
 
-                                 (* ;; "UTF8 pieces with the same bytesperchar are mergeable.  We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PUTF8BYTESPERCHAR can be merged.")

+                                 (* ;; "UTF8 pieces with the same bytesperchar are mergeable.  We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PBYTESPERCHAR can be merged.")

 
-                                  (EQ (FGETPC PREVPC PUTF8BYTESPERCHAR)
-                                      (FGETPC PC PUTF8BYTESPERCHAR)))
+                                  (EQ (FGETPC PREVPC PBYTESPERCHAR)
+                                      (FGETPC PC PBYTESPERCHAR)))
                           NIL)
                       (OR (EQ PREVTYPE UTF8.PTYPE)
-                          (AND (EQ PREVTYPE FATFILE1.PTYPE)
-                               (NEQ 0 (PCHARSET PREVPC)))
                           [AND (EQ EXTFORMAT :UTF-8)
                                (NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE]
                           (NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE PREVPC (SUB1 (PLEN PREVPC)))
                                      (CHARCODE (EOL LF])])])
 
 (\TEDIT.PUT.UTF8.SPLITPIECES

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 19-Jan-2025 15:02 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 12-Apr-2026 21:49 by rmk")


+                                                             (* ; "Edited  9-Apr-2026 00:05 by rmk")


+                                                             (* ; "Edited 19-Jan-2025 15:02 by rmk")


                                                              (* ; "Edited 17-Mar-2024 00:14 by rmk")


                                                              (* ; "Edited  3-Feb-2024 14:52 by rmk")


                                                              (* ; "Edited 11-Jan-2024 23:29 by rmk")


@@ -2101,24 +2092,24 @@
 
     (for
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ)
        do
 (SELECTC (PTYPE PC)
-              (UTF8.PTYPE (FSETPC PC PUTF8BYTESPERCHAR (PBYTESPERCHAR PC)))
+              (UTF8.PTYPE)
               (STRING.PTYPES (for
 CH BPC instring
 (PCONTENTS PC) as
 I from
 1
                                 do
 
 
                                  (* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.")

 
                                    (if
 (EQ I 1)
-                                       then
 (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
-                                            (FSETPC PC PUTF8BYTESPERCHAR BPC) 
+                                       then
 (SETQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
+                                            (FSETPC PC PBYTESPERCHAR BPC) 
                                                              (* ; 
 
                                                             "The first character defines the piece")

-                                     elseif
 (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
+                                     elseif
 (EQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
                                      else
 (\TEDIT.SPLITPIECE PC (SUB1 I)
                                                  TEXTOBJ)
                                           (SETQ PC (PREVPIECE PC)) 
                                                              (* ; 
 
                                                             "Prefix piece always exists since I>1")

-                                          (FSETPC PC PUTF8BYTESPERCHAR BPC) 
+                                          (FSETPC PC PBYTESPERCHAR BPC) 
                                                              (* ; 
 
                                                          "Mark it, iteration continues on its next.")

                                           (RETURN))))
@@ -2128,30 +2119,26 @@
                        (for
 I BPC (PFILE _ (PCONTENTS PC)) from
 1 to
 (PLEN PC)
                           first
 (\SETFILEPTR PFILE (PFPOS PC))
                           do
 (if
 (EQ I 1)
-                                 then
 [SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
-                                      (FSETPC PC PUTF8BYTESPERCHAR BPC)
-                               elseif
 [EQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
+                                 then
 [SETQ BPC (NUTF8-CODE-BYTES (MTOUCODE (BIN PFILE]
+                                      (FSETPC PC PBYTESPERCHAR BPC)
+                               elseif
 [EQ BPC (NUTF8-CODE-BYTES (MTOUCODE (BIN PFILE]
                                else
 (\TEDIT.SPLITPIECE PC (SUB1 I)
                                            TEXTOBJ)
                                     (SETQ PC (PREVPIECE PC))
-                                    (FSETPC PC PUTF8BYTESPERCHAR BPC)
+                                    (FSETPC PC PBYTESPERCHAR BPC)
                                     (RETURN)))))
-              ((LIST FATFILE2.PTYPE FATFILE1.PTYPE)          (* ; "XCCS pieces")

+              (FATFILE2.PTYPE                                (* ; "XCCS pieces")

                    (for
 I BPC CH (PFILE _ (PCONTENTS PC)) from
 1 to
 (PLEN PC)
                       first
 (\SETFILEPTR PFILE (PFPOS PC))
-                      do
 (SETQ CH (LOGOR (LLSH (CL:IF (EQ FATFILE2.PTYPE (PTYPE PC))
-                                                   (BIN PFILE)
-                                                   (PCHARSET PC))
-                                               8)
-                                         (BIN PFILE)))
+                      do
 (SETQ CH (\WIN PFILE))
                          (if
 (EQ I 1)
-                             then
 (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
-                                  (FSETPC PC PUTF8BYTESPERCHAR BPC)
-                           elseif
 (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
+                             then
 (SETQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
+                                  (FSETPC PC PBYTESPERCHAR BPC)
+                           elseif
 (EQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
                            else
 (\TEDIT.SPLITPIECE PC (SUB1 I)
                                        TEXTOBJ)
                                 (SETQ PC (PREVPIECE PC))
-                                (FSETPC PC PUTF8BYTESPERCHAR BPC)
+                                (FSETPC PC PBYTESPERCHAR BPC)
                                 (RETURN))))
               NIL])
 
@@ -2183,6 +2170,11 @@
 
 (\TEDIT.PUT.PCTB.NEXTNEW

   [LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)

+                                                             (* ; "Edited 24-Apr-2026 20:45 by rmk")


+                                                             (* ; "Edited 17-Apr-2026 23:55 by rmk")


+                                                             (* ; "Edited 12-Apr-2026 21:47 by rmk")


+                                                             (* ; "Edited  9-Apr-2026 13:20 by rmk")


+                                                             (* ; "Edited  7-Apr-2026 18:12 by rmk")


                                                              (* ; "Edited 15-Feb-2026 15:09 by rmk")


                                                              (* ; "Edited 25-Apr-2025 08:48 by rmk")


                                                              (* ; "Edited 26-Mar-2025 09:27 by rmk")


@@ -2198,28 +2190,25 @@
 
     (* ;; "This updates the piece chain that is created for continued editing.")

 
-    (* ;; "Note that the PCONTENTS (=  PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level.  For the same reason, PBINABLE isn't set here.")

+    (* ;; "Note that the PCONTENTS (=  PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level.  ")

 
-    (* ;; "NSHIFTBYTES strips any MCCS/XCCS charset shifts at the beginning of the new piece.")

+    (* ;; "NSHIFTBYTES ignores any MCCS/XCCS charset shifts at the beginning of the new piece.")

 
     (SETQ RUNLEN (IDIFFERENCE RUNLEN NSHIFTBYTES))
     (FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create
 PIECE
                                                using
 PC PFPOS _ (IPLUS NSHIFTBYTES OLDBYTE#)
-                                                     PBYTELEN _ RUNLEN PREVPIECE _ NEXTNEW PTREENODE
-                                                     _ NIL)))
+                                                     PLEN _ RUNLEN PREVPIECE _ NEXTNEW PTREENODE _ 
+                                                     NIL)))
     (SELECTQ EXTFORMAT
-        (:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))
+        (:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PC PBYTESPERCHAR))
                                           THINFILE.PTYPE
-                                          UTF8.PTYPE))
-                (FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PC PUTF8BYTESPERCHAR)))
+                                          UTF8.PTYPE)))
         ((:MCCS :XCCS)                                       (* ; 
 
                                         "String pieces can be merged with corresponding file pieces")

              (FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
                                        (THINSTRING.PTYPE 
                                             THINFILE.PTYPE)
-                                       ((LIST FATSTRING.PTYPE FATFILE1.PTYPE) 
-                                                             (* ; 
-
                                                             "PCHARSET is not relevant for FILEFILE2")

+                                       (FATSTRING.PTYPE 
                                             (FSETPC NEXTNEW PBYTESPERCHAR 2)
                                             FATFILE2.PTYPE)
                                        (PTYPE PC))))
@@ -2238,15 +2227,14 @@
                      (FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
               else
 (add
 (FGETPC NEXTNEW PLEN)
                         -1)                                  (* ; "We know it's thin, maybe paralast")

-                   (add
 (FGETPC NEXTNEW PBYTELEN)
-                        -1)
                    (SETQ NEXTNEW (\TEDIT.MAKE.STRINGPIECE
 NEXTNEW (CHARCODE EOL)))
                    (FSETPC (PREVPIECE NEXTNEW)
                           PPARALAST NIL))))
     NEXTNEW])
 
 (\TEDIT.INSERT.NEWPIECES

-  [LAMBDA (DESTSTREAM OLDSTREAM NEWPIECES)
                   (* ; "Edited 14-May-2024 18:38 by rmk")


+  [LAMBDA (DESTSTREAM OLDSTREAM NEWPIECES)
                   (* ; "Edited 10-Apr-2026 09:25 by rmk")


+                                                             (* ; "Edited 14-May-2024 18:38 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:13 by rmk")


                                                              (* ; "Edited 20-Mar-2024 10:59 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:06 by rmk")


@@ -2265,13 +2253,8 @@
     (LET ((TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 OLDSTREAM)))
           FILEPTR)
          (SETQ FILEPTR (\TEDIT.TEXTGETFILEPTR OLDSTREAM))    (* ; "Restore the editing parameters")

-         (for
 PC (SBINABLE _ (fetch
 (STREAM BINABLE) of
 DESTSTREAM)) inpieces
 NEWPIECES
-            when
 (MEMB (PTYPE PC)
-                       FILE.PTYPES) do
 (FSETPC PC PCONTENTS DESTSTREAM)
-                                       (CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC))
-                                                             (* ; 
-
                             "If the backing stream isn't binable, the thinfile pieces aren't either")

-                                           (FSETPC PC PBINABLE SBINABLE)))
+         (for
 PC inpieces
 NEWPIECES when
 (MEMB (PTYPE PC)
+                                               FILE.PTYPES) do
 (FSETPC PC PCONTENTS DESTSTREAM))
                                                              (* ; "Non-object pieces are on OFILE")

 
          (* ;; "Here, finally, we toss the out-of-date pieces to install the new ones. For complete safety, the rest should be uninterruptable (although the file has just been saved, so nothing would really be lost)")

@@ -2459,6 +2442,7 @@
 
 (\TEDIT.PUT.CHARLOOKS

   [LAMBDA (FORMATSTREAM BYTELEN PC EDITSTENTATIVE LOOKSHARRAY)

+                                                             (* ; "Edited  9-Apr-2026 23:24 by rmk")


                                                              (* ; "Edited  1-Aug-2025 14:51 by rmk")


                                                              (* ; "Edited 14-May-2024 10:24 by rmk")


                                                              (* ; "Edited 13-Jan-2024 16:35 by rmk")


@@ -2471,7 +2455,7 @@
     (* ;; "Put a description of PC's charlooks into FORMATSTREAM.  The looks apply to bytes OLDBYTE# thru CURBYTE#-1")

 
     (\DTEST PC 'PIECE)
-    (\TEDIT.PUT.CHARLOOKS1
 FORMATSTREAM BYTELEN (GETHASH (PCHARALOOKS PC)
+    (\TEDIT.PUT.CHARLOOKS1
 FORMATSTREAM BYTELEN (GETHASH (PCHARLOOKS PC)
                                                        LOOKSHARRAY)
            (AND EDITSTENTATIVE PC (PNEW PC))
            (EQ FATFILE2.PTYPE (PTYPE PC])
@@ -2496,7 +2480,8 @@
     (\WOUT FORMATSTREAM CHARLOOKSINDEX])
 
 (\TEDIT.PUT.OBJECT

-  [LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#)
       (* ; "Edited 14-May-2024 12:09 by rmk")


+  [LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURTEXTBYTE#)
       (* ; "Edited 18-Apr-2026 14:52 by rmk")


+                                                             (* ; "Edited 14-May-2024 12:09 by rmk")


                                                              (* ; "Edited 24-Jan-2024 23:35 by rmk")


                                                              (* ; "Edited 13-Jan-2024 12:20 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:14 by rmk")


@@ -2519,7 +2504,7 @@
          (APPLY* (IMAGEOBJPROP OBJECT 'PUTFN)
                 OBJECT CHARSTREAM)
          (SETQ BYTELEN (IDIFFERENCE (GETEOFPTR CHARSTREAM)
-                              CURFILEBYTE#))
+                              CURTEXTBYTE#))
          (SETFILEPTR FORMATSTREAM ORIGFILEPTR)               (* ; 
 
                          "Now go back and fill in the length of the text description of the object.")

          (\DWOUT
 FORMATSTREAM BYTELEN)
@@ -2721,29 +2706,29 @@
 
 (RPAQ? *TEDIT-FILE-READTABLE*
 (COPYREADTABLE \ORIGREADTABLE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5423 35682 (TEDIT.GET 5433 . 11843) (TEDIT.FORMATTEDFILEP 11845 . 13161) (
-TEDIT.FILEDATE 13163 . 14472) (TEDIT.INCLUDE 14474 . 22503) (TEDIT.RAW.INCLUDE 22505 . 23313) (
-TEDIT.PUT 23315 . 31671) (TEDIT.PUT.STREAM 31673 . 35680)) (35683 56957 (\TEDIT.GET.FOREIGN.FILE 35693
- . 39118) (\TEDIT.GET.UNFORMATTED.FILE 39120 . 43426) (\TEDIT.GET.FORMATTED.FILE 43428 . 47071) (
-\TEDIT.FORMATTEDSTREAMP 47073 . 50204) (\ARBIN 50206 . 50926) (\ATMIN 50928 . 51465) (\DWIN 51467 . 
-51846) (\STRINGIN 51848 . 52556) (\TEDIT.GET.TRAILER 52558 . 55426) (\TEDIT.CACHEFILE 55428 . 56955)) 
-(57123 73161 (\TEDIT.GET.PIECES3 57133 . 68096) (\TEDIT.GET.PROPS3 68098 . 71320) (
-\TEDIT.MAKE.STRINGPIECE 71322 . 73159)) (73162 86588 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73172 . 79405) 
-(\TEDIT.INTERPRET.MCCS.SHIFTS 79407 . 85652) (\TEDIT.CONVERT.XCCSTOMCCS 85654 . 86586)) (86610 92855 (
-\TEDIT.GET.UNFORMATTED.FILE.UTF8 86620 . 92853)) (92878 104220 (\TEDIT.GET.CHARLOOKS.LIST 92888 . 
-93619) (\TEDIT.GET.SINGLE.CHARLOOKS 93621 . 100693) (\TEDIT.GET.CHARLOOKS 100695 . 102251) (
-\TEDIT.GET.PARALOOKS.INDEX 102253 . 102797) (\TEDIT.GET.CHARLOOKS.INDEX 102799 . 104218)) (104221 
-111878 (\TEDIT.GET.PARALOOKS.LIST 104231 . 104853) (\TEDIT.GET.SINGLE.PARALOOKS 104855 . 111876)) (
-111879 115712 (\TEDIT.GET.OBJECT 111889 . 115710)) (115777 150880 (\TEDIT.PUT.PCTB 115787 . 125844) (
-\TEDIT.PUT.PCTB.PIECEDATA 125846 . 129044) (\TEDIT.PUT.TRAILER 129046 . 130374) (
-\TEDIT.PUT.PCTB.MERGEABLE 130376 . 134149) (\TEDIT.PUT.UTF8.SPLITPIECES 134151 . 138853) (
-\TEDIT.PUT.MCCS.SPLITPIECES 138855 . 140433) (\TEDIT.PUT.PCTB.NEXTNEW 140435 . 145041) (
-\TEDIT.INSERT.NEWPIECES 145043 . 148478) (\TEDIT.PUTRESET 148480 . 148722) (\ARBOUT 148724 . 149448) (
-\ATMOUT 149450 . 150055) (\DWOUT 150057 . 150336) (\STRINGOUT 150338 . 150878)) (150881 163615 (
-\TEDIT.PUT.CHARLOOKS.LIST 150891 . 152563) (\TEDIT.PUT.SINGLE.CHARLOOKS 152565 . 158845) (
-\TEDIT.PUT.CHARLOOKS 158847 . 160186) (\TEDIT.PUT.CHARLOOKS1 160188 . 161239) (\TEDIT.PUT.OBJECT 
-161241 . 163613)) (163616 171255 (\TEDIT.PUT.PARALOOKS.LIST 163626 . 164528) (
-\TEDIT.PUT.SINGLE.PARALOOKS 164530 . 170114) (\TEDIT.PUT.PARALOOKS 170116 . 171253)) (171350 174755 (
-TEDITFROMLISPSOURCE 171360 . 174004) (SHELLSCRIPTP 174006 . 174235) (TEDITFROMSHELLSCRIPT 174237 . 
-174753)))))
+  (FILEMAP (NIL (5384 35643 (TEDIT.GET 5394 . 11804) (TEDIT.FORMATTEDFILEP 11806 . 13122) (
+TEDIT.FILEDATE 13124 . 14433) (TEDIT.INCLUDE 14435 . 22464) (TEDIT.RAW.INCLUDE 22466 . 23274) (
+TEDIT.PUT 23276 . 31632) (TEDIT.PUT.STREAM 31634 . 35641)) (35644 56951 (\TEDIT.GET.FOREIGN.FILE 35654
+ . 39079) (\TEDIT.GET.UNFORMATTED.FILE 39081 . 43420) (\TEDIT.GET.FORMATTED.FILE 43422 . 47065) (
+\TEDIT.FORMATTEDSTREAMP 47067 . 50198) (\ARBIN 50200 . 50920) (\ATMIN 50922 . 51459) (\DWIN 51461 . 
+51840) (\STRINGIN 51842 . 52550) (\TEDIT.GET.TRAILER 52552 . 55420) (\TEDIT.CACHEFILE 55422 . 56949)) 
+(57117 73044 (\TEDIT.GET.PIECES3 57127 . 68176) (\TEDIT.GET.PROPS3 68178 . 71400) (
+\TEDIT.MAKE.STRINGPIECE 71402 . 73042)) (73045 85841 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73055 . 78706) 
+(\TEDIT.INTERPRET.MCCS.SHIFTS 78708 . 84304) (\TEDIT.CONVERT.XCCSTOMCCS 84306 . 85238) (
+\TEDIT.RUN.TO.STRINGPIECE 85240 . 85839)) (85863 92124 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 85873 . 92122
+)) (92147 103665 (\TEDIT.GET.CHARLOOKS.LIST 92157 . 92888) (\TEDIT.GET.SINGLE.CHARLOOKS 92890 . 99962)
+ (\TEDIT.GET.CHARLOOKS 99964 . 101520) (\TEDIT.GET.PARALOOKS.INDEX 101522 . 102066) (
+\TEDIT.GET.CHARLOOKS.INDEX 102068 . 103663)) (103666 111323 (\TEDIT.GET.PARALOOKS.LIST 103676 . 104298
+) (\TEDIT.GET.SINGLE.PARALOOKS 104300 . 111321)) (111324 115266 (\TEDIT.GET.OBJECT 111334 . 115264)) (
+115331 150489 (\TEDIT.PUT.PCTB 115341 . 125667) (\TEDIT.PUT.PCTB.PIECEDATA 125669 . 128826) (
+\TEDIT.PUT.TRAILER 128828 . 130156) (\TEDIT.PUT.PCTB.MERGEABLE 130158 . 134019) (
+\TEDIT.PUT.UTF8.SPLITPIECES 134021 . 138597) (\TEDIT.PUT.MCCS.SPLITPIECES 138599 . 140177) (
+\TEDIT.PUT.PCTB.NEXTNEW 140179 . 144920) (\TEDIT.INSERT.NEWPIECES 144922 . 148087) (\TEDIT.PUTRESET 
+148089 . 148331) (\ARBOUT 148333 . 149057) (\ATMOUT 149059 . 149664) (\DWOUT 149666 . 149945) (
+\STRINGOUT 149947 . 150487)) (150490 163441 (\TEDIT.PUT.CHARLOOKS.LIST 150500 . 152172) (
+\TEDIT.PUT.SINGLE.CHARLOOKS 152174 . 158454) (\TEDIT.PUT.CHARLOOKS 158456 . 159903) (
+\TEDIT.PUT.CHARLOOKS1 159905 . 160956) (\TEDIT.PUT.OBJECT 160958 . 163439)) (163442 171081 (
+\TEDIT.PUT.PARALOOKS.LIST 163452 . 164354) (\TEDIT.PUT.SINGLE.PARALOOKS 164356 . 169940) (
+\TEDIT.PUT.PARALOOKS 169942 . 171079)) (171176 174581 (TEDITFROMLISPSOURCE 171186 . 173830) (
+SHELLSCRIPTP 173832 . 174061) (TEDITFROMSHELLSCRIPT 174063 . 174579)))))
 STOP

library/tedit/TEDIT-FIXFILES

@@ -0,0 +1,183 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "14-Dec-2024 16:53:27" {WMEDLEY}<library>TEDIT>TEDIT-FIXFILES.;14
 9776   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS CR-LF-FONTFIX)
+                  (VARS TEDIT-FIXFILESCOMS)
+                  (ADVICE ELT)
+
+      :PREVIOUS-DATE "12-Dec-2024 21:50:29" {WMEDLEY}<library>TEDIT>TEDIT-FIXFILES.;10)
+
+
+(PRETTYCOMPRINT TEDIT-FIXFILESCOMS)
+
+(RPAQQ TEDIT-FIXFILESCOMS
 (
+                           (* ;; "Hacks that may help in fixing broken Tedit files")

+
+                           (FILES TEDIT-DEBUG)
+                           (FNS CRLFSWAP CHANGEPLEN)
+                           (FNS CR-LF-FONTFIX)
+                           (P (MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS))
+                           (ADVISE ELT)))
+
+
+
+(* ;; "Hacks that may help in fixing broken Tedit files")

+
+
+(FILESLOAD TEDIT-DEBUG)
+(DEFINEQ
+
+(CRLFSWAP

+  [LAMBDA (INFILE OUTFILE)
                                   (* ; "Edited 12-Dec-2024 08:25 by rmk")


+                                                             (* ; "Edited  9-Dec-2024 13:33 by rmk")

+    (CL:WITH-OPEN-FILE (INSTREAM INFILE :DIRECTION :INPUT)
+           (CL:UNLESS OUTFILE
+               (SETQ OUTFILE (PACKFILENAME 'VERSION NIL 'NAME (CONCAT (FILENAMEFIELD INSTREAM
+                                                                             'NAME)
+                                                                     "-SWAPPED")
+                                    'BODY INSTREAM)))
+           (CL:WITH-OPEN-FILE (OUTSTREAM OUTFILE :DIRECTION :OUTPUT)
+                  (for
 I B from
 1 to
 (GETEOFPTR INSTREAM)
+                     do
 (BOUT OUTSTREAM (SELCHARQ (SETQ B (BIN INSTREAM))
+                                             (LF (CHARCODE CR))
+                                             (CR (CHARCODE LF))
+                                             B)))
+                  (FULLNAME OUTSTREAM])
+
+(CHANGEPLEN

+  [LAMBDA (PC DELTA ARG)
                                     (* ; "Edited 11-Dec-2024 15:18 by rmk")

+
+    (* ;; "Change the length of piece PC by DELTA (negative = shorter).")

+
+    (LET [(PC (SP PC 1 NIL (GTO ARG]
+         (CL:WHEN (EQ 'Y (ASKUSER NIL NIL (CONCAT "Confirm changing PLEN by " DELTA " from "
+                                                 (PLEN PC)
+                                                 " to "
+                                                 (IPLUS (PLEN PC)
+                                                        DELTA)
+                                                 " ? ")))
+             (FSETPC PC PLEN (IPLUS (PLEN PC)
+                                    DELTA))
+             (SP PC 1 NIL (GTO ARG)))])
+)
+(DEFINEQ
+
+(CR-LF-FONTFIX

+  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited 14-Dec-2024 14:31 by rmk")


+                                                             (* ; "Edited 12-Dec-2024 21:50 by rmk")

+    (SI::%%WITH-CHANGED-CALLS
+     ((|TEXTPROP in INTERLISP::\TEDIT.GET.SINGLE.CHARLOOKS| . TEXTPROP))

+                                                             (* ; "Edited 12-Dec-2024 20:51 by rmk")


+                                                             (* ; "Edited 11-Dec-2024 17:11 by rmk")


+                                                             (* ; "Edited  9-Dec-2024 20:11 by rmk")


+                                                             (* ; "Edited 13-Aug-2024 08:49 by rmk")


+                                                             (* ; "Edited 31-Jul-2024 00:04 by rmk")


+                                                             (* ; "Edited  7-Apr-2024 17:21 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 22:46 by rmk")


+                                                             (* ; "Edited 21-Dec-2023 23:54 by rmk")


+                                                             (* ; "Edited 19-Dec-2023 10:13 by rmk")


+                                                             (* ; "Edited 25-Nov-2023 23:21 by rmk")


+                                                             (* ; "Edited 24-Aug-2023 15:05 by rmk")


+                                                           (* ; "Edited 20-Feb-2022 12:42 by larry")


+                                                             (* ; "Edited 30-May-91 20:25 by jds")

+
+     (* ;; "Read one CHARLOOKS from FILE.  This gets and then sets the file pointer, based on the stored length.  But that won't work if the file is not random access.  Maybe that's not necessary?")

+
+     (* ;; "TEXTOBJ only for printing in the local promptwindow, if necessary.")

+
+     (PROG* ((LOOKS (create
 CHARLOOKS))
+             (FILEPOS (GETFILEPTR FILE))
+             (LOOKSLEN (\WIN FILE))
+             FONT NAME FACE SIZE SUPER PROPS STYLESTR)
+            (SETQ NAME (\ARBIN FILE))                        (* ; "The font name")

+            (SETQ SIZE (\WIN FILE))                          (* ; "Size of the type, in points")

+            (SETQ SUPER (\SMALLPIN FILE))                    (* ; 
+
                                                         "Superscripting distance, could be negative")

+            (FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
+                                          0))
+            (FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
+            (SETQ PROPS (\WIN FILE))
+            (with
 CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS]
+                  [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS]
+                  [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
+                  [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
+                  [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
+                  [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
+                  [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
+                  [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
+                  [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
+                  [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
+                  [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
+                  [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
+                  [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
+                  [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
+                  (SETQ CLSIZE SIZE)
+                  (SETQ CLOFFSET SUPER))
+            (SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD)
+                                  'B
+                                  'M)
+                              (CL:IF (FGETCLOOKS LOOKS CLITAL)
+                                  'I
+                                  'R)
+                              'R))
+            (if
 (LISTP NAME)
+                then
                                         (* ; 
+
                                                             "This was a font class.  Restore it.")

+                     (SETQ FONT (FONTCLASS (pop
 NAME)
+                                       NAME))
+              elseif
 (OR (NOT NAME)
+                         (ZEROP SIZE))
+                then
 
+                     (* ;; "This was a test in the original, seems bogus")

+
+              elseif
 (SETQ FONT (FONTCREATE NAME SIZE FACE NIL NIL T))
+              elseif
 [AND (EQ SIZE 13)
+                          (SETQ FONT (FONTCREATE NAME 10 FACE NIL NIL T))
+                          (SELECTQ (STREAMPROP FILE 'COERCEFONT)
+                              (YES T)
+                              (NO NIL)
+                              (SELECTQ [U-CASE (MKATOM (CL:IF TEXTOBJ
+                                                           (TEDIT.GETINPUT TEXTOBJ 
+                                                                  "Change font size 13 to 10 ? ")
+                                                           (ASKUSER NIL NIL 
+                                                                  "Change font size 13 to 10 ? "))]
+                                  ((Y YES) 
+                                       (STREAMPROP FILE 'COERCEFONT 'YES)
+                                       T)
+                                  (PROGN (STREAMPROP FILE 'COERCEFONT 'NO)
+                                         NIL]
+                then
 
+                     (* ;; "A hack to deal with files that have CR-LF corruption")

+
+                     (SETQ SIZE 10)
+                     (FSETCLOOKS LOOKS CLSIZE 10)
+              else
 (SETQ FONT (FONTCREATE NAME SIZE FACE)))
+            (FSETCLOOKS LOOKS CLNAME (if
 (type?
 FONTCLASS FONT)
+                                         then
 
+                                              (* ;; 
+
                                       "Put the display family in the CLNAME spot.  Better than NIL.")

+
+                                              (CL:WHEN [SETQ NAME (FONTCOPY FONT
+                                                                         '(DEVICE DISPLAY NOERROR T]
+                                                  (FONTPROP NAME 'FAMILY))
+                                       else
 NAME))
+            (FSETCLOOKS LOOKS CLFONT FONT)
+            (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
+            (RETURN LOOKS])
+)
+
+(MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS)
+
+[XCL:REINSTALL-ADVICE 'ELT :BEFORE '((:LAST (CL:WHEN (AND (EQ N 13)
+                                                          (ILESSP (ARRAYSIZE A)
+                                                                 13))
+                                                   (SETQ N 10]
+
+(READVISE ELT)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (912 2760 (CRLFSWAP 922 . 1990) (CHANGEPLEN 1992 . 2758)) (2761 9403 (CR-LF-FONTFIX 2771
+ . 9401)))))
+STOP

library/tedit/TEDIT-HISTORY

@@ -1,14 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Aug-2025 14:58:56" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;252
 59126  
+
(FILECREATED "19-Feb-2026 12:39:37" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;253
 59143  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.UNDO.CHARLOOKS)
+      :CHANGES-TO (FNS \TEDIT.UNDO1)
 
-      :PREVIOUS-DATE "28-Jul-2025 23:47:41" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;251)
+      :PREVIOUS-DATE " 1-Aug-2025 14:58:56" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;252)
 
 
 (PRETTYCOMPRINT TEDIT-HISTORYCOMS)
@@ -407,7 +405,8 @@
            (\TEDIT.SHOWSEL SEL T TSTREAM])
 
 (\TEDIT.UNDO1

-  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited  6-Apr-2025 14:42 by rmk")


+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited 19-Feb-2026 12:39 by rmk")


+                                                             (* ; "Edited  6-Apr-2025 14:42 by rmk")


                                                              (* ; "Edited  1-Apr-2025 21:22 by rmk")


                                                              (* ; "Edited 28-Mar-2025 14:22 by rmk")


                                                              (* ; "Edited 16-Mar-2025 18:46 by rmk")


@@ -457,7 +456,7 @@
                     (COND
                        (UNDOFN 
 
-                              (* ;; "<EFBFBD>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

+                              (* ;; "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

 
                               (APPLY* UNDOFN TSTREAM EVENT (GETTH EVENT THLEN)
                                      (GETTH EVENT THCH#)
@@ -920,15 +919,15 @@
     (\TEDIT.THELP 'Redo-composite])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5022 6043 (\TEDIT.HISTORYEVENT.DEFPRINT 5032 . 6041)) (7133 18387 (\TEDIT.HISTORYADD 
-7143 . 12405) (\TEDIT.HISTORYADD.COMPOSITE 12407 . 13439) (\TEDIT.CUMULATE.EVENTS 13441 . 15035) (
-\TEDIT.COMPOSITE.EVENT 15037 . 15773) (\TEDIT.HISTORY.PROP 15775 . 17138) (\TEDIT.HISTORY.EVENT 17140
- . 18211) (\TEDIT.POPEVENT 18213 . 18385)) (18440 37427 (TEDIT.UNDO 18450 . 23326) (\TEDIT.UNDO1 23328
- . 27666) (TEDIT.REDO 27668 . 34581) (\TEDIT.UNDO.UNDO 34583 . 37425)) (37428 56129 (
-\TEDIT.UNDO.INSERT 37438 . 38563) (\TEDIT.UNDO.DELETE 38565 . 39577) (\TEDIT.UNDO.MOVE 39579 . 41232) 
-(\TEDIT.UNDO.REPLACE 41234 . 42744) (\TEDIT.UNDO.CHARLOOKS 42746 . 48209) (\TEDIT.UNDO.PARALOOKS 48211
- . 52040) (\TEDIT.UNDO.PAGELOOKS 52042 . 52600) (\TEDIT.UNDO.COMPOSITE 52602 . 54202) (
-\TEDIT.UNDO.REPLACECODE 54204 . 54538) (\TEDIT.UNDO.WRAP 54540 . 55469) (\TEDIT.UNDO.SEL 55471 . 56127
-)) (56130 59103 (\TEDIT.REDO.INSERT 56140 . 57102) (\TEDIT.REDO.REPLACE 57104 . 58710) (
-\TEDIT.REDO.COMPOSITE 58712 . 59101)))))
+  (FILEMAP (NIL (4931 5952 (\TEDIT.HISTORYEVENT.DEFPRINT 4941 . 5950)) (7042 18296 (\TEDIT.HISTORYADD 
+7052 . 12314) (\TEDIT.HISTORYADD.COMPOSITE 12316 . 13348) (\TEDIT.CUMULATE.EVENTS 13350 . 14944) (
+\TEDIT.COMPOSITE.EVENT 14946 . 15682) (\TEDIT.HISTORY.PROP 15684 . 17047) (\TEDIT.HISTORY.EVENT 17049
+ . 18120) (\TEDIT.POPEVENT 18122 . 18294)) (18349 37444 (TEDIT.UNDO 18359 . 23235) (\TEDIT.UNDO1 23237
+ . 27683) (TEDIT.REDO 27685 . 34598) (\TEDIT.UNDO.UNDO 34600 . 37442)) (37445 56146 (
+\TEDIT.UNDO.INSERT 37455 . 38580) (\TEDIT.UNDO.DELETE 38582 . 39594) (\TEDIT.UNDO.MOVE 39596 . 41249) 
+(\TEDIT.UNDO.REPLACE 41251 . 42761) (\TEDIT.UNDO.CHARLOOKS 42763 . 48226) (\TEDIT.UNDO.PARALOOKS 48228
+ . 52057) (\TEDIT.UNDO.PAGELOOKS 52059 . 52617) (\TEDIT.UNDO.COMPOSITE 52619 . 54219) (
+\TEDIT.UNDO.REPLACECODE 54221 . 54555) (\TEDIT.UNDO.WRAP 54557 . 55486) (\TEDIT.UNDO.SEL 55488 . 56144
+)) (56147 59120 (\TEDIT.REDO.INSERT 56157 . 57119) (\TEDIT.REDO.REPLACE 57121 . 58727) (
+\TEDIT.REDO.COMPOSITE 58729 . 59118)))))
 STOP

library/tedit/TEDIT-LOOKS

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "16-Feb-2026 00:36:00" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;467
 155443 
+
(FILECREATED "10-Apr-2026 09:34:11" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;469
 155253 
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
 
-      :PREVIOUS-DATE "10-Feb-2026 11:07:12" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;465)
+      :PREVIOUS-DATE " 9-Apr-2026 17:25:54" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;468)
 
 
 (PRETTYCOMPRINT TEDIT-LOOKSCOMS)
@@ -924,7 +924,8 @@
 (DEFINEQ
 
 (\TEDIT.MCCS.TRANSLATE

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 16-Feb-2026 00:35 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 10-Apr-2026 09:34 by rmk")


+                                                             (* ; "Edited 16-Feb-2026 00:35 by rmk")


                                                              (* ; "Edited  6-Oct-2025 20:50 by rmk")


                                                              (* ; "Edited  5-Oct-2025 10:57 by rmk")


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


@@ -972,14 +973,9 @@
                                               THINSTRING.PTYPE))
                          (FSETPC PC PCONTENTS STRING)
                          (FSETPC PC PFPOS NIL)
-                         (FSETPC PC PBINABLE (NOT FAT))
                          (FSETPC PC PBYTESPERCHAR (CL:IF FAT
                                                       2
                                                       1))
-                         (FSETPC PC PBYTELEN (CL:IF FAT
-                                                 (UNFOLD (PLEN PC)
-                                                        2)
-                                                 (PLEN PC)))
                          (CL:UNLESS (EQ 'MCCS (fetch
 (FONTDESCRIPTOR FONTCHARENCODING) of
 CLFONT))
 
                              (* ;; 
@@ -2472,18 +2468,18 @@
 \TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
  . 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
 \TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
-\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64879 (\TEDIT.MCCS.TRANSLATE 52884 . 58615) (
-\TEDIT.CONVERT.TO.FORMATTED 58617 . 64877)) (65751 73088 (\TEDIT.UNIQUIFY.CHARLOOKS 65761 . 67421) (
-\TEDIT.UNIQUIFY.PARALOOKS 67423 . 68690) (\TEDIT.UNIQUIFY.ALL 68692 . 70780) (
-\TEDIT.FLUSH.UNUSED.LOOKS 70782 . 73086)) (73121 85079 (TEDIT.LOOKS 73131 . 75520) (TEDIT.GET.LOOKS 
-75522 . 77857) (TEDIT.SUBLOOKS 77859 . 82239) (TEDIT.FINDLOOKS 82241 . 85077)) (85080 114853 (
-\TEDIT.CHANGE.CHARLOOKS 85090 . 93991) (\TEDIT.CHANGE.CHARLOOKS.NEW 93993 . 97808) (
-\TEDIT.CHARLOOKS.CHANGE.FONT 97810 . 106117) (\TEDIT.FONT.NEXTSIZE 106119 . 107740) (\TEDIT.LOOKS 
-107742 . 111071) (\TEDIT.FONTCOPY 111073 . 112574) (\TEDIT.COERCE.FONTCLASS 112576 . 113727) (
-\TEDIT.FONTCLASS.TO.FONT 113729 . 114851)) (114896 146785 (\TEDIT.EQFMTSPEC 114906 . 118121) (
-TEDIT.GET.PARALOOKS 118123 . 122170) (\TEDIT.PARSE.PARALOOKS.LIST 122172 . 130205) (TEDIT.PARALOOKS 
-130207 . 131247) (\TEDIT.CHANGE.PARALOOKS 131249 . 138458) (\TEDIT.CHANGE.PARALOOKS.NEW 138460 . 
-142443) (TEDIT.COPY.PARALOOKS 142445 . 145119) (\TEDIT.PARABOUNDS 145121 . 146783)) (146845 154561 (
-TEDIT.SUBPARALOOKS 146855 . 150957) (SAMEPARALOOKS 150959 . 154559)) (154562 155249 (
-\TEDIT.MARK.REVISION 154572 . 155247)))))
+\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64689 (\TEDIT.MCCS.TRANSLATE 52884 . 58425) (
+\TEDIT.CONVERT.TO.FORMATTED 58427 . 64687)) (65561 72898 (\TEDIT.UNIQUIFY.CHARLOOKS 65571 . 67231) (
+\TEDIT.UNIQUIFY.PARALOOKS 67233 . 68500) (\TEDIT.UNIQUIFY.ALL 68502 . 70590) (
+\TEDIT.FLUSH.UNUSED.LOOKS 70592 . 72896)) (72931 84889 (TEDIT.LOOKS 72941 . 75330) (TEDIT.GET.LOOKS 
+75332 . 77667) (TEDIT.SUBLOOKS 77669 . 82049) (TEDIT.FINDLOOKS 82051 . 84887)) (84890 114663 (
+\TEDIT.CHANGE.CHARLOOKS 84900 . 93801) (\TEDIT.CHANGE.CHARLOOKS.NEW 93803 . 97618) (
+\TEDIT.CHARLOOKS.CHANGE.FONT 97620 . 105927) (\TEDIT.FONT.NEXTSIZE 105929 . 107550) (\TEDIT.LOOKS 
+107552 . 110881) (\TEDIT.FONTCOPY 110883 . 112384) (\TEDIT.COERCE.FONTCLASS 112386 . 113537) (
+\TEDIT.FONTCLASS.TO.FONT 113539 . 114661)) (114706 146595 (\TEDIT.EQFMTSPEC 114716 . 117931) (
+TEDIT.GET.PARALOOKS 117933 . 121980) (\TEDIT.PARSE.PARALOOKS.LIST 121982 . 130015) (TEDIT.PARALOOKS 
+130017 . 131057) (\TEDIT.CHANGE.PARALOOKS 131059 . 138268) (\TEDIT.CHANGE.PARALOOKS.NEW 138270 . 
+142253) (TEDIT.COPY.PARALOOKS 142255 . 144929) (\TEDIT.PARABOUNDS 144931 . 146593)) (146655 154371 (
+TEDIT.SUBPARALOOKS 146665 . 150767) (SAMEPARALOOKS 150769 . 154369)) (154372 155059 (
+\TEDIT.MARK.REVISION 154382 . 155057)))))
 STOP

library/tedit/TEDIT-MENU

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED " 9-Feb-2026 09:10:43" {WMEDLEY}<library>tedit>TEDIT-MENU.;510
 183027 
+
(FILECREATED "29-Apr-2026 15:35:33" {MEDLEY}<library>TEDIT>TEDIT-MENU.;512
 183159 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.PAGEMENU.CREATE)
+      :CHANGES-TO (FNS \TEDIT.SHOW.PAGELOOKS)
 
-      :PREVIOUS-DATE "27-Jan-2026 10:42:09" {WMEDLEY}<library>tedit>TEDIT-MENU.;508)
+      :PREVIOUS-DATE " 9-Feb-2026 09:10:43" {MEDLEY}<library>TEDIT>TEDIT-MENU.;510)
 
 
 (PRETTYCOMPRINT TEDIT-MENUCOMS)
@@ -2525,7 +2525,8 @@
                'PAGE))])
 
 (\TEDIT.SHOW.PAGELOOKS

-  [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM)
                (* ; "Edited 20-Apr-2025 23:41 by rmk")


+  [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM)
                (* ; "Edited 29-Apr-2026 15:35 by rmk")


+                                                             (* ; "Edited 20-Apr-2025 23:41 by rmk")


                                                              (* ; "Edited 22-Oct-2024 11:04 by rmk")


                                                              (* ; "Edited 20-Oct-2024 17:32 by rmk")


                                                              (* ; "Edited 29-Sep-2024 15:10 by rmk")


@@ -2538,19 +2539,18 @@
 
     (* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.")

 
-    (PROG [(PAGEID (MB.GET 'PAGEID MENUSTREAM 'STATE]
-          (CL:WHEN (MEMB PAGEID '(NIL OFF))
-              (TEDIT.PROMPTPRINT MENUWINDOW "Please specify the page-type" T T)
-              (RETURN))
-          (RESETLST
-              (TEDIT.DEFER.UPDATES MENUSTREAM)
-              (\TEDIT.PAGEMENU.FILLIN
 MENUSTREAM (\TEDIT.PAGEREGION.UNPARSE
 (\TEDIT.MAINSTREAM 
+    (LET [(PAGEID (MB.GET 'PAGEID MENUSTREAM 'STATE]
+         (if
 (MEMB PAGEID '(NIL OFF))
+             then
 (TEDIT.PROMPTPRINT MENUWINDOW "Please specify the page-type" T T)
+           else
 (RESETLST
+                    (TEDIT.DEFER.UPDATES MENUSTREAM)
+                    (\TEDIT.PAGEMENU.FILLIN
 MENUSTREAM (\TEDIT.PAGEREGION.UNPARSE
 (\TEDIT.MAINSTREAM
                                                                                    MENUSTREAM)
-                                                        PAGEID)))
-          (FSETSEL MENUSEL ONFLG T)
-          (\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT)
-          (\TEDIT.FIXSEL MENUSEL MENUSTREAM)
-          (TEDIT.BACKTOMAIN MENUSTREAM])
+                                                              PAGEID)))
+                (FSETSEL MENUSEL ONFLG T)
+                (\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT)
+                (\TEDIT.FIXSEL MENUSEL MENUSTREAM))
+         (TEDIT.BACKTOMAIN MENUSTREAM])
 
 (\TEDIT.PAGEMENU.FILLIN

   [LAMBDA (MENUSTREAM PAGELOOKS)
                             (* ; "Edited 29-Sep-2024 12:53 by rmk")


@@ -2899,32 +2899,32 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4936 16574 (TEDIT.ADD.MENUITEM 4946 . 7063) (TEDIT.DEFAULT.MENUFN 7065 . 13786) (
-TEDIT.REMOVE.MENUITEM 13788 . 14785) (\TEDIT.CREATEMENU 14787 . 15352) (\TEDIT.MENU.WHENHELDFN 15354
- . 16259) (\TEDIT.MENU.WHENSELECTEDFN 16261 . 16572)) (17388 65423 (DRAWMARGINSCALE 17398 . 20857) (
-MARGINBAR 20859 . 27984) (MARGINBAR.CREATE 27986 . 32184) (MB.MARGINBAR.BUTTONEVENTINFN 32186 . 39988)
- (MB.MARGINBAR.SELFN.TABS 39990 . 45230) (MB.MARGINBAR.SELFN.TABS.KIND 45232 . 46167) (
-MARGINBAR.GETSTATEFN 46169 . 50156) (MARGINBAR.SETSTATEFN 50158 . 50368) (MARGINBAR.NEUTRALIZE 50370
- . 51045) (MARGINBAR.LOOKS 51047 . 54153) (MB.MARGINBAR.SIZEFN 54155 . 54941) (MB.MARGINBAR.DISPLAYFN 
-54943 . 58004) (MDESCALE 58006 . 58546) (MSCALE 58548 . 58878) (MB.MARGINBAR.SHOWTAB 58880 . 61203) (
-MB.MARGINBAR.TABTRACK 61205 . 62590) (MARGINBAR.INIT 62592 . 63985) (\TEDIT.PARALOOKS.TO.MARBAR 63987
- . 65421)) (66248 73530 (TEDIT.MENUSTREAM 66258 . 67258) (TEDITMENUP 67260 . 68229) (\TEDIT.MENU.START
- 68231 . 72578) (\TEDIT.MENU.OPEN? 72580 . 72954) (\TEDIT.MENU.BUTTONEVENTFN 72956 . 73528)) (73849 
-81900 (\TEDIT.MENU.CREATE 73859 . 75799) (\TEDIT.MENU.PARSE 75801 . 79490) (\TEDIT.MENU.NEUTRALIZE 
-79492 . 81563) (\TEDITMENU.RECORD.UNFORMATTED 81565 . 81898)) (81966 101368 (
-\TEDIT.EXPANDEDMENU.CREATE 81976 . 87654) (\TEDIT.EXPANDEDMENU.START 87656 . 89280) (
-\TEDIT.EXPANDEDMENU.FN 89282 . 92537) (\TEDIT.EXPANDEDMENU.ACTIONFN 92539 . 101366)) (101430 120855 (
-\TEDIT.PARAMENU.CREATE 101440 . 110171) (\TEDIT.PARAMENU.START 110173 . 111427) (
-\TEDIT.APPLY.PARALOOKS 111429 . 112481) (\TEDIT.SHOW.PARALOOKS 112483 . 115200) (
-\TEDIT.PARAMENU.FILLIN 115202 . 119951) (\TEDIT.PARAMENU.RESHAPEFN 119953 . 120853)) (121049 147891 (
-\TEDIT.CHARMENU.CREATE 121059 . 123663) (\TEDIT.CHARMENU.START 123665 . 124955) (\TEDIT.CHARMENU.SPEC 
-124957 . 129640) (\TEDIT.CHARMENU.PARSE 129642 . 132810) (\TEDIT.CHARMENU.FILLIN 132812 . 137442) (
-\TEDIT.SHOW.CHARLOOKS 137444 . 140989) (\TEDIT.APPLY.CHARLOOKS 140991 . 142152) (
-\TEDIT.OFFSETTYPE.STATEFN 142154 . 144117) (\TEDIT.OTHER.STATECHANGEFN 144119 . 145764) (
-\TEDIT.OTHER.SELECTFN 145766 . 147889)) (147953 177067 (\TEDIT.PAGEMENU.CREATE 147963 . 156484) (
-\TEDIT.PAGEMENU.START 156486 . 156837) (\TEDIT.SHOW.PAGELOOKS 156839 . 158725) (\TEDIT.PAGEMENU.FILLIN
- 158727 . 160277) (\TEDIT.PAGEREGION.UNPARSE 160279 . 169678) (\TEDIT.APPLY.PAGELOOKS 169680 . 171607)
- (\TEDIT.CHANGE.PAGELOOKS 171609 . 176223) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176225 . 177065)) (
-177068 182871 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177078 . 179890) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 
-179892 . 181317) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181319 . 182869)))))
+  (FILEMAP (NIL (4933 16571 (TEDIT.ADD.MENUITEM 4943 . 7060) (TEDIT.DEFAULT.MENUFN 7062 . 13783) (
+TEDIT.REMOVE.MENUITEM 13785 . 14782) (\TEDIT.CREATEMENU 14784 . 15349) (\TEDIT.MENU.WHENHELDFN 15351
+ . 16256) (\TEDIT.MENU.WHENSELECTEDFN 16258 . 16569)) (17385 65420 (DRAWMARGINSCALE 17395 . 20854) (
+MARGINBAR 20856 . 27981) (MARGINBAR.CREATE 27983 . 32181) (MB.MARGINBAR.BUTTONEVENTINFN 32183 . 39985)
+ (MB.MARGINBAR.SELFN.TABS 39987 . 45227) (MB.MARGINBAR.SELFN.TABS.KIND 45229 . 46164) (
+MARGINBAR.GETSTATEFN 46166 . 50153) (MARGINBAR.SETSTATEFN 50155 . 50365) (MARGINBAR.NEUTRALIZE 50367
+ . 51042) (MARGINBAR.LOOKS 51044 . 54150) (MB.MARGINBAR.SIZEFN 54152 . 54938) (MB.MARGINBAR.DISPLAYFN 
+54940 . 58001) (MDESCALE 58003 . 58543) (MSCALE 58545 . 58875) (MB.MARGINBAR.SHOWTAB 58877 . 61200) (
+MB.MARGINBAR.TABTRACK 61202 . 62587) (MARGINBAR.INIT 62589 . 63982) (\TEDIT.PARALOOKS.TO.MARBAR 63984
+ . 65418)) (66245 73527 (TEDIT.MENUSTREAM 66255 . 67255) (TEDITMENUP 67257 . 68226) (\TEDIT.MENU.START
+ 68228 . 72575) (\TEDIT.MENU.OPEN? 72577 . 72951) (\TEDIT.MENU.BUTTONEVENTFN 72953 . 73525)) (73846 
+81897 (\TEDIT.MENU.CREATE 73856 . 75796) (\TEDIT.MENU.PARSE 75798 . 79487) (\TEDIT.MENU.NEUTRALIZE 
+79489 . 81560) (\TEDITMENU.RECORD.UNFORMATTED 81562 . 81895)) (81963 101365 (
+\TEDIT.EXPANDEDMENU.CREATE 81973 . 87651) (\TEDIT.EXPANDEDMENU.START 87653 . 89277) (
+\TEDIT.EXPANDEDMENU.FN 89279 . 92534) (\TEDIT.EXPANDEDMENU.ACTIONFN 92536 . 101363)) (101427 120852 (
+\TEDIT.PARAMENU.CREATE 101437 . 110168) (\TEDIT.PARAMENU.START 110170 . 111424) (
+\TEDIT.APPLY.PARALOOKS 111426 . 112478) (\TEDIT.SHOW.PARALOOKS 112480 . 115197) (
+\TEDIT.PARAMENU.FILLIN 115199 . 119948) (\TEDIT.PARAMENU.RESHAPEFN 119950 . 120850)) (121046 147888 (
+\TEDIT.CHARMENU.CREATE 121056 . 123660) (\TEDIT.CHARMENU.START 123662 . 124952) (\TEDIT.CHARMENU.SPEC 
+124954 . 129637) (\TEDIT.CHARMENU.PARSE 129639 . 132807) (\TEDIT.CHARMENU.FILLIN 132809 . 137439) (
+\TEDIT.SHOW.CHARLOOKS 137441 . 140986) (\TEDIT.APPLY.CHARLOOKS 140988 . 142149) (
+\TEDIT.OFFSETTYPE.STATEFN 142151 . 144114) (\TEDIT.OTHER.STATECHANGEFN 144116 . 145761) (
+\TEDIT.OTHER.SELECTFN 145763 . 147886)) (147950 177199 (\TEDIT.PAGEMENU.CREATE 147960 . 156481) (
+\TEDIT.PAGEMENU.START 156483 . 156834) (\TEDIT.SHOW.PAGELOOKS 156836 . 158857) (\TEDIT.PAGEMENU.FILLIN
+ 158859 . 160409) (\TEDIT.PAGEREGION.UNPARSE 160411 . 169810) (\TEDIT.APPLY.PAGELOOKS 169812 . 171739)
+ (\TEDIT.CHANGE.PAGELOOKS 171741 . 176355) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176357 . 177197)) (
+177200 183003 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177210 . 180022) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 
+180024 . 181449) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181451 . 183001)))))
 STOP

library/tedit/TEDIT-OLDFILE

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED " 8-Sep-2025 22:10:10" {WMEDLEY}<library>TEDIT>TEDIT-OLDFILE.;40
 73888  
+
(FILECREATED "10-Apr-2026 09:29:21" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;45
 73241  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.GET.PCTB2)
+      :CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1 \TEDIT.GET.PCTB0)
 
-      :PREVIOUS-DATE " 7-Sep-2025 11:07:57" {WMEDLEY}<library>TEDIT>TEDIT-OLDFILE.;39)
+      :PREVIOUS-DATE "10-Apr-2026 00:16:32" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;41)
 
 
 (PRETTYCOMPRINT TEDIT-OLDFILECOMS)
@@ -46,23 +46,18 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB2

-  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited  8-Sep-2025 22:08 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 10-Apr-2026 09:28 by rmk")


+                                                             (* ; "Edited  8-Sep-2025 22:08 by rmk")


                                                              (* ; "Edited  1-Aug-2025 14:55 by rmk")


                                                              (* ; "Edited 28-Jul-2025 23:39 by rmk")


                                                              (* ; "Edited  8-Feb-2025 20:21 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:28 by rmk")


                                                              (* ; "Edited 20-Mar-2024 11:00 by rmk")


-                                                             (* ; "Edited 17-Mar-2024 12:41 by rmk")


-                                                             (* ; "Edited 15-Mar-2024 14:37 by rmk")


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


-                                                             (* ; "Edited 13-Jan-2024 12:09 by rmk")


-                                                             (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited 25-Nov-2023 23:18 by rmk")


-                                                             (* ; "Edited  8-Nov-2023 13:48 by rmk")


                                                              (* ; "Edited  4-Oct-2022 16:58 by rmk")


                                                              (* ; "Edited  8-Sep-2022 23:06 by rmk")


-                                                             (* ; "Edited  5-Sep-2022 21:33 by rmk")


                                                              (* ; "Edited  4-May-93 16:27 by jds")

 
     (* ;; "READ OBSOLETE FORMATS OF TEDIT FILE")

@@ -80,8 +75,7 @@
          (SETQ PIECEINFOCH# (\DWIN TEXT))
          (SETFILEPTR TEXT PIECEINFOCH#)
          (bind
 PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
-               (SBINABLE _ (fetch
 (STREAM BINABLE) of
 TEXT)) for
 I from
 1 to
 PCCOUNT
+               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)) for
 I from
 1 to
 PCCOUNT
             do
 (SETQ PC NIL)                                 (* ; 
 
                        "This loop may not really read a piece, so we have to distinguish that case.")

                (SETQ PCLEN (\DWIN TEXT))
@@ -131,37 +125,35 @@
                          (create
 PIECE
                                 PCONTENTS _ TEXT
                                 PFPOS _ CURFILECH#
-                                PBYTELEN _ PCLEN
                                 PLEN _ PCLEN
                                 PPARALOOKS _ OLDPARALOOKS
                                 PTYPE _ THINFILE.PTYPE
                                 PBYTESPERCHAR _ 1))          (* ; "Build the new piece")

                         (\TEDIT.GET.CHARLOOKS2
 PC TEXT LOOKSHASH)
-                        (CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC))
-                               (FSETPC PC PBINABLE SBINABLE))(* ; 
+                                                             (* ; 
 
                                                             "Read the character looks for this guy.")

-                        (COND
-                           [OLDPC                            (* ; 
+                        (if
 OLDPC
+                            then
                             (* ; 
 
                                              "If there's a prior piece, hook this one on the chain.")

-                                  (COND
-                                     ([AND (EQ FATFILE2.PTYPE (PTYPE PC))
-                                           (NOT (EQ FATFILE2.PTYPE (PTYPE OLDPC]
-                                                             (* ; 
+                                 (if
 [AND (EQ FATFILE2.PTYPE (PTYPE PC))
+                                          (NOT (EQ FATFILE2.PTYPE (PTYPE OLDPC]
+                                     then
                    (* ; 
 
                                      "Switching from not-fat to fat.  Add 3 bytes for the 255-255-0")

-                                      (add
 (PFPOS PC)
-                                           3)
-                                      (add
 CURFILECH# -3))
-                                     ([AND (EQ FATFILE2.PTYPE (PTYPE OLDPC))
-                                           (NOT (EQ FATFILE2.PTYPE (PTYPE PC]
-                                                             (* ; 
+                                          (add
 (PFPOS PC)
+                                               3)
+                                          (add
 CURFILECH# -3)
+                                   elseif
 [AND (EQ FATFILE2.PTYPE (PTYPE OLDPC))
+                                               (NOT (EQ FATFILE2.PTYPE (PTYPE PC]
+                                     then
                    (* ; 
 
                                          "Switching from fat to not-fat.  Add 3 bytes for the 255-0")

-                                      (add
 (PFPOS PC)
-                                           2]
-                           ((EQ FATFILE2.PTYPE (PTYPE PC))   (* ; 
+                                          (add
 (PFPOS PC)
+                                               2))
+                          elseif
 (EQ FATFILE2.PTYPE (PTYPE PC))
+                            then
                             (* ; 
 
                                      "Switching from not-fat to fat.  Add 3 bytes for the 255-255-0")

-                            (add
 (PFPOS PC)
-                                 3)
-                            (add
 CURFILECH# -3)))            (* ; 
+                                 (add
 (PFPOS PC)
+                                      3)
+                                 (add
 CURFILECH# -3))        (* ; 
 
                                                             "And note the passing of characters.")

                         (add
 CURFILECH# PCLEN))
                    (\PieceDescriptorOBJECT                   (* ; 
@@ -580,7 +572,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB1

-  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited  1-Aug-2025 14:56 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 10-Apr-2026 09:25 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 14:56 by rmk")


                                                              (* ; "Edited 28-Jul-2025 23:39 by rmk")


                                                              (* ; "Edited  8-Feb-2025 20:22 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


@@ -612,8 +605,7 @@
          (SETQ PIECEINFOCH# (\DWIN TEXT))
          (SETFILEPTR TEXT PIECEINFOCH#)
          (bind
 PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
-               (SBINABLE _ (fetch
 (STREAM BINABLE) of
 TEXT)) for
 I from
 1 to
 PCCOUNT
+               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)) for
 I from
 1 to
 PCCOUNT
             do
 (SETQ PC NIL)                                 (* ; 
 
                        "This loop may not really read a piece, so we have to distinguish that case.")

                (SETQ PCLEN (\DWIN TEXT))
@@ -640,13 +632,11 @@
                          (create
 PIECE
                                 PCONTENTS _ TEXT
                                 PFPOS _ CURFILECH#
-                                PBYTELEN _ PCLEN
                                 PLEN _ PCLEN
                                 PPARALOOKS _ OLDPARALOOKS
                                 PTYPE _ THINFILE.PTYPE
                                 PBYTESPERCHAR _ 1))
-                        (\TEDIT.GET.CHARLOOKS1
 PC TEXT)
-                        (FSETPC PC PBINABLE SBINABLE)        (* ; 
+                        (\TEDIT.GET.CHARLOOKS1
 PC TEXT)      (* ; 
 
                                                             "Read the character looks for this guy.")

                         (add
 CURFILECH# (PLEN PC))           (* ; 
 
                                                             "And note the passing of characters.")

@@ -891,7 +881,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB0

-  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited  8-Feb-2025 20:22 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 10-Apr-2026 09:22 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 20:22 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:27 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:41 by rmk")


@@ -908,7 +899,7 @@
 
     (LET ((TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
           OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
-          (SBINABLE (fetch
 (STREAM BINABLE) of
 TEXT)))
+          )
          (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
                                  8))
          (SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -924,8 +915,7 @@
                        PREVPIECE _ OLDPC
                        PPARALOOKS _ DEFAULTPARALOOKS
                        PTYPE _ THINFILE.PTYPE
-                       PBYTESPERCHAR _ 1
-                       PBINABLE _ SBINABLE))
+                       PBYTESPERCHAR _ 1))
                [COND
                   (OLDPC (FSETPC OLDPC NEXTPIECE PC)
                          (FSETPC PC PPARALOOKS (PPARALOOKS OLDPC]
@@ -1100,14 +1090,14 @@
          PARALOOKS])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1649 37832 (\TEDIT.GET.PCTB2 1659 . 12415) (\TEDIT.GET.PARALOOKS2 12417 . 13006) (
-\TEDIT.GET.CHARLOOKS2 13008 . 14565) (\TEDIT.PARSE.PAGEFRAMES2 14567 . 17306) (
-\TEDIT.GET.CHARLOOKS.LIST2 17308 . 17815) (\TEDIT.GET.SINGLE.CHARLOOKS2 17817 . 21176) (
-\TEDIT.PUT.SINGLE.PARALOOKS2 21178 . 25428) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25430 . 29140) (
-\TEDIT.GET.PARALOOKS.LIST2 29142 . 29649) (\TEDIT.GET.SINGLE.PARALOOKS2 29651 . 34550) (
-\TEDIT.PUT.CHARLOOKS.LIST2 34552 . 36631) (\TEDIT.PUT.PARALOOKS.LIST2 36633 . 37830)) (37909 59190 (
-\TEDIT.GET.PCTB1 37919 . 44936) (\TEDIT.GET.PAGEFRAMES1 44938 . 45390) (\TEDIT.PARSE.PAGEFRAMES1 45392
- . 48045) (\TEDIT.GET.CHARLOOKS1 48047 . 52413) (\TEDIT.GET.PARALOOKS1 52415 . 57326) (
-TEDIT.GET.OBJECT1 57328 . 59188)) (59250 73865 (\TEDIT.GET.PCTB0 59260 . 63341) (\TEDIT.GET.CHARLOOKS0
- 63343 . 67783) (\TEDIT.GET.OBJECT0 67785 . 69860) (\TEDIT.GET.PARALOOKS0 69862 . 73863)))))
+  (FILEMAP (NIL (1683 37235 (\TEDIT.GET.PCTB2 1693 . 11818) (\TEDIT.GET.PARALOOKS2 11820 . 12409) (
+\TEDIT.GET.CHARLOOKS2 12411 . 13968) (\TEDIT.PARSE.PAGEFRAMES2 13970 . 16709) (
+\TEDIT.GET.CHARLOOKS.LIST2 16711 . 17218) (\TEDIT.GET.SINGLE.CHARLOOKS2 17220 . 20579) (
+\TEDIT.PUT.SINGLE.PARALOOKS2 20581 . 24831) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24833 . 28543) (
+\TEDIT.GET.PARALOOKS.LIST2 28545 . 29052) (\TEDIT.GET.SINGLE.PARALOOKS2 29054 . 33953) (
+\TEDIT.PUT.CHARLOOKS.LIST2 33955 . 36034) (\TEDIT.PUT.PARALOOKS.LIST2 36036 . 37233)) (37312 58528 (
+\TEDIT.GET.PCTB1 37322 . 44274) (\TEDIT.GET.PAGEFRAMES1 44276 . 44728) (\TEDIT.PARSE.PAGEFRAMES1 44730
+ . 47383) (\TEDIT.GET.CHARLOOKS1 47385 . 51751) (\TEDIT.GET.PARALOOKS1 51753 . 56664) (
+TEDIT.GET.OBJECT1 56666 . 58526)) (58588 73218 (\TEDIT.GET.PCTB0 58598 . 62694) (\TEDIT.GET.CHARLOOKS0
+ 62696 . 67136) (\TEDIT.GET.OBJECT0 67138 . 69213) (\TEDIT.GET.PARALOOKS0 69215 . 73216)))))
 STOP

library/tedit/TEDIT-PAGE

@@ -1,13 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "27-Jan-2026 10:30:27" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;243
 130855 
+
(FILECREATED " 6-May-2026 22:17:41" {MEDLEY}<library>TEDIT>TEDIT-PAGE.;244
 130772 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
-                  (VARS TEDIT-PAGECOMS)
+      :CHANGES-TO (FNS TEDIT.TO.IMAGEFILE)
 
-      :PREVIOUS-DATE "17-Jan-2026 12:00:08" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;241)
+      :PREVIOUS-DATE "27-Jan-2026 10:30:27" {MEDLEY}<library>TEDIT>TEDIT-PAGE.;243)
 
 
 (PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -636,7 +635,8 @@
 (DEFINEQ
 
 (TEDIT.TO.IMAGEFILE

-  [LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS)
              (* ; "Edited 17-Jan-2026 11:59 by rmk")


+  [LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS)
              (* ; "Edited  6-May-2026 22:16 by rmk")


+                                                             (* ; "Edited 17-Jan-2026 11:59 by rmk")


                                                              (* ; "Edited 15-Jan-2026 08:46 by rmk")


                                                              (* ; "Edited 25-Dec-2025 15:07 by rmk")


                                                              (* ; "Edited 20-Dec-2025 23:03 by rmk")


@@ -650,11 +650,9 @@
 
     (RESETLST
         (SETQ TSTREAM (if
 (TEXTSTREAM TSTREAM T)
-                        elseif
 (TEDIT.FORMATTEDFILEP TSTREAM)
-                          then
 [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM))
-                                      `(PROGN (CLOSEF? OLDVALUE]
-                               TSTREAM
-                        else
 (ERROR TSTREAM "is not a Tedit stream")))
+                        else
 [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM))
+                                    `(PROGN (CLOSEF? OLDVALUE]
+                             TSTREAM))
         (CL:WHEN (GETTEXTPROP TSTREAM 'MENUFLG)
             (SETQ TSTREAM (TEXTSTREAM (\TEDIT.MAINW TSTREAM))))
         (CL:UNLESS IMAGEFILE
@@ -2062,18 +2060,18 @@
                         (RETURN (DREMOVE NIL $$VAL])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (12248 15860 (\TEDIT.PARSE.PAGEFRAMES 12258 . 14037) (\TEDIT.PUT.PAGEFRAMES 14039 . 
-14863) (\TEDIT.UNPARSE.PAGEFRAMES 14865 . 15858)) (15923 38091 (TEDIT.SINGLE.PAGEFORMAT 15933 . 27077)
- (TEDIT.COMPOUND.PAGEFORMAT 27079 . 28058) (TEDIT.PAGEFORMAT 28060 . 35349) (TEDIT.GET.PAGEFORMAT 
-35351 . 38089)) (38378 44858 (TEDIT.TO.IMAGEFILE 38388 . 44856)) (45006 98258 (\TEDIT.FORMATBOX 45016
- . 58440) (\TEDIT.FORMATHEADING 58442 . 63088) (\TEDIT.FORMATPAGE 63090 . 72279) (\TEDIT.FORMATTEXTBOX
- 72281 . 88794) (\TEDIT.FORMATFOLIO 88796 . 94113) (\TEDIT.FORMAT.FOUNDBOX? 94115 . 96154) (
-\TEDIT.SKIP.SPECIALCOND 96156 . 98256)) (98338 103393 (\TEDIT.HARDCOPY.PAGEHEADINGS 98348 . 103391)) (
-103502 111553 (\TEDIT.HARDCOPY-COLUMN-END 103512 . 111551)) (111598 116539 (SCALEPAGEUNITS 111608 . 
-112749) (SCALEPAGEXUNITS 112751 . 113521) (SCALEPAGEYUNITS 113523 . 114294) (\TEDIT.PAPERHEIGHT 114296
- . 115231) (\TEDIT.PAPERWIDTH 115233 . 116537)) (116955 120523 (ROMANNUMERALS 116965 . 120521)) (
-120562 127828 (TEDIT.PAGENO.CREATE 120572 . 120948) (\TEDIT.PAGENO.OBJINIT 120950 . 122233) (
-\TEDIT.PAGENO.BUTTONEVENTINFN 122235 . 123301) (\TEDIT.PAGENO.IMAGEBOXFN 123303 . 125453) (
-\TEDIT.PAGENO.DISPLAYFN 125455 . 127105) (\TEDIT.PAGENO.GETFN 127107 . 127499) (\TEDIT.PAGENO.PUTFN 
-127501 . 127826)) (127893 130832 (\TEDIT.FORMAT.FOOTNOTE 127903 . 130830)))))
+  (FILEMAP (NIL (12201 15813 (\TEDIT.PARSE.PAGEFRAMES 12211 . 13990) (\TEDIT.PUT.PAGEFRAMES 13992 . 
+14816) (\TEDIT.UNPARSE.PAGEFRAMES 14818 . 15811)) (15876 38044 (TEDIT.SINGLE.PAGEFORMAT 15886 . 27030)
+ (TEDIT.COMPOUND.PAGEFORMAT 27032 . 28011) (TEDIT.PAGEFORMAT 28013 . 35302) (TEDIT.GET.PAGEFORMAT 
+35304 . 38042)) (38331 44775 (TEDIT.TO.IMAGEFILE 38341 . 44773)) (44923 98175 (\TEDIT.FORMATBOX 44933
+ . 58357) (\TEDIT.FORMATHEADING 58359 . 63005) (\TEDIT.FORMATPAGE 63007 . 72196) (\TEDIT.FORMATTEXTBOX
+ 72198 . 88711) (\TEDIT.FORMATFOLIO 88713 . 94030) (\TEDIT.FORMAT.FOUNDBOX? 94032 . 96071) (
+\TEDIT.SKIP.SPECIALCOND 96073 . 98173)) (98255 103310 (\TEDIT.HARDCOPY.PAGEHEADINGS 98265 . 103308)) (
+103419 111470 (\TEDIT.HARDCOPY-COLUMN-END 103429 . 111468)) (111515 116456 (SCALEPAGEUNITS 111525 . 
+112666) (SCALEPAGEXUNITS 112668 . 113438) (SCALEPAGEYUNITS 113440 . 114211) (\TEDIT.PAPERHEIGHT 114213
+ . 115148) (\TEDIT.PAPERWIDTH 115150 . 116454)) (116872 120440 (ROMANNUMERALS 116882 . 120438)) (
+120479 127745 (TEDIT.PAGENO.CREATE 120489 . 120865) (\TEDIT.PAGENO.OBJINIT 120867 . 122150) (
+\TEDIT.PAGENO.BUTTONEVENTINFN 122152 . 123218) (\TEDIT.PAGENO.IMAGEBOXFN 123220 . 125370) (
+\TEDIT.PAGENO.DISPLAYFN 125372 . 127022) (\TEDIT.PAGENO.GETFN 127024 . 127416) (\TEDIT.PAGENO.PUTFN 
+127418 . 127743)) (127810 130749 (\TEDIT.FORMAT.FOOTNOTE 127820 . 130747)))))
 STOP

library/tedit/TEDIT-PCTREE

@@ -1,13 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251
 68691  
+
(FILECREATED " 9-Apr-2026 17:25:38" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;252
 68540  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-PCTREECOMS)
-                  (FNS \TEDIT.UNLINKPIECE \TEDIT.DELETEPIECES)
+      :CHANGES-TO (FNS \TEDIT.SPLITPIECE)
 
-      :PREVIOUS-DATE "28-Jul-2025 23:25:19" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;249)
+      :PREVIOUS-DATE "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251)
 
 
 (PRETTYCOMPRINT TEDIT-PCTREECOMS)
@@ -658,7 +657,8 @@
          NEW])
 
 (\TEDIT.SPLITPIECE

-  [LAMBDA (PC CHOFFSET TEXTOBJ)
                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (PC CHOFFSET TEXTOBJ)
                              (* ; "Edited  9-Apr-2026 13:22 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 17-Mar-2024 00:11 by rmk")


                                                              (* ; "Edited 28-Dec-2023 22:17 by rmk")


                                                              (* ; "Edited  7-Dec-2023 21:07 by rmk")


@@ -680,9 +680,8 @@
         (\INSURE.VACANT.BTREESLOT (FGETPC PC PTREENODE)
                TEXTOBJ)                                      (* ; 
 
                                                  "Do this before reducing PC, so tree remains valid")

-        (LET [(PREVPC (create
 PIECE using
 PC PPARALAST _ NIL PLEN _ CHOFFSET PBYTELEN _
-                                          (ITIMES (PBYTESPERCHAR PC)
-                                                 CHOFFSET]   (* ; 
+        (LET ((PREVPC (create
 PIECE using
 PC PPARALAST _ NIL PLEN _ CHOFFSET)))
+                                                             (* ; 
 
                                   "There can be no para break before the split, as things now work.")

 
              (* ;; "PREVPC is the prefix before the split point of length CHOFFSET, PC will be the suffix, a shortened version of a piece that was already in the piece tree.")

@@ -713,8 +712,6 @@
 
                  (change
 (PLEN PC)
                         (IDIFFERENCE DATUM CHOFFSET))
-                 (FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
-                                            (PLEN PC)))
                  (freplace
 (BTSLOT DLEN) of
 (\FINDSLOT (FGETPC PC PTREENODE)
                                                    PC) with
 (PLEN PC))
 
@@ -1104,13 +1101,13 @@
 (GLOBALVARS BTVALIDATETAGS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8731 56217 (\TEDIT.MAKEPCTB 8741 . 10634) (\TEDIT.UPDATEPCNODES 10636 . 12930) (
-\TEDIT.FIRSTPIECE 12932 . 14339) (\TEDIT.DELETETREE 14341 . 17615) (\TEDIT.INSERTTREE 17617 . 20362) (
-\TEDIT.LASTPIECE 20364 . 21171) (\TEDIT.PCTOCH 21173 . 23270) (\TEDIT.CHTOPC 23272 . 29449) (
-\TEDIT.SET-TOTLEN 29451 . 30239) (\TEDIT.MAKE.VACANT.BTREESLOT 30241 . 36971) (\TEDIT.LINKNEWPIECE 
-36973 . 38562) (\TEDIT.SPLITPIECE 38564 . 43220) (\TEDIT.INSERTPIECE 43222 . 46494) (
-\TEDIT.INSERTPIECES 46496 . 49588) (\TEDIT.DELETEPIECES 49590 . 54100) (\TEDIT.ALIGNEDPIECE 54102 . 
-56215)) (56245 68568 (\TEDIT.BTVALIDATE 56255 . 57796) (\TEDIT.BTVALIDATE.PRINT 57798 . 59163) (
-\TEDIT.CHECK-BTREE 59165 . 61492) (\TEDIT.CHECK-BTREE1 61494 . 67125) (\TEDIT.BTFAIL 67127 . 67549) (
-\TEDIT.MATCHPCS 67551 . 68566)))))
+  (FILEMAP (NIL (8668 56066 (\TEDIT.MAKEPCTB 8678 . 10571) (\TEDIT.UPDATEPCNODES 10573 . 12867) (
+\TEDIT.FIRSTPIECE 12869 . 14276) (\TEDIT.DELETETREE 14278 . 17552) (\TEDIT.INSERTTREE 17554 . 20299) (
+\TEDIT.LASTPIECE 20301 . 21108) (\TEDIT.PCTOCH 21110 . 23207) (\TEDIT.CHTOPC 23209 . 29386) (
+\TEDIT.SET-TOTLEN 29388 . 30176) (\TEDIT.MAKE.VACANT.BTREESLOT 30178 . 36908) (\TEDIT.LINKNEWPIECE 
+36910 . 38499) (\TEDIT.SPLITPIECE 38501 . 43069) (\TEDIT.INSERTPIECE 43071 . 46343) (
+\TEDIT.INSERTPIECES 46345 . 49437) (\TEDIT.DELETEPIECES 49439 . 53949) (\TEDIT.ALIGNEDPIECE 53951 . 
+56064)) (56094 68417 (\TEDIT.BTVALIDATE 56104 . 57645) (\TEDIT.BTVALIDATE.PRINT 57647 . 59012) (
+\TEDIT.CHECK-BTREE 59014 . 61341) (\TEDIT.CHECK-BTREE1 61343 . 66974) (\TEDIT.BTFAIL 66976 . 67398) (
+\TEDIT.MATCHPCS 67400 . 68415)))))
 STOP

library/tedit/TEDIT-SCREEN

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED " 5-Feb-2026 00:39:54" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;916
 186880 
+
(FILECREATED " 6-May-2026 22:52:37" {MEDLEY}<library>TEDIT>TEDIT-SCREEN.;918
 186879 
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS \TEDIT.FORMATLINE)
 
-      :PREVIOUS-DATE "31-Dec-2025 23:10:18" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;915)
+      :PREVIOUS-DATE " 5-Feb-2026 00:39:54" {MEDLEY}<library>TEDIT>TEDIT-SCREEN.;916)
 
 
 (PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -654,6 +654,7 @@
 
 (\TEDIT.FORMATLINE

   [LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)

+                                                             (* ; "Edited  6-May-2026 22:52 by rmk")


                                                              (* ; "Edited  5-Feb-2026 00:38 by rmk")


                                                              (* ; "Edited 21-Nov-2025 16:36 by rmk")


                                                              (* ; "Edited  7-Aug-2025 12:49 by rmk")


@@ -1101,28 +1102,26 @@
 
                 (CL:WHEN (EQ CHARSLOT LASTCHARSLOT)
 
-                    (* ;; 
-
        "If too long, we let it roll over to the next line.  Should we put something in the margin??")

+                    (* ;; "If too long, we let it roll over to the next line. ")

 
-                    (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T)
-                    (RETURN)) finally
 
+                    (GO $$OUT)) finally
 
 
-                                    (* ;; 
+                                      (* ;; 
 
         "Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?")

 
-                                    (CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT))
-                                                  (NULL (CHAR PREVSP)))
+                                      (CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT))
+                                                    (NULL (CHAR PREVSP)))
 
                                  (* ;; "The line ended in a space that needs to be resolved.  If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.")

 
-                                        (FILLCHARSLOT PREVSP (CHARCODE SPACE)
-                                               (CHARW PREVSP)
-                                               CHARLOOKS)
-                                        (SETQ PREVSP NIL))
-                                    (SETQ CHARSLOT (PREVCHARSLOT CHARSLOT))
-                                    (add
 CHNO -1)
-                                    (SETQ DX 0)              (* ; "TX is already correct")

-                                    (FORCEBREAK))
+                                          (FILLCHARSLOT PREVSP (CHARCODE SPACE)
+                                                 (CHARW PREVSP)
+                                                 CHARLOOKS)
+                                          (SETQ PREVSP NIL))
+                                      (SETQ CHARSLOT (PREVCHARSLOT CHARSLOT))
+                                      (add
 CHNO -1)
+                                      (SETQ DX 0)            (* ; "TX is already correct")

+                                      (FORCEBREAK))
 
      (* ;; "End of character loop.  ")

 
@@ -2866,21 +2865,21 @@
                  (\TEDIT.LINE.TALLP LINE PHEIGHT))))])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (26200 28416 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26210 . 28414)) (35870 119724 (
-\TEDIT.FORMATLINE 35880 . 71208) (\TEDIT.FORMATLINE.SETUP.PARA 71210 . 76404) (
-\TEDIT.FORMATLINE.HORIZONTAL 76406 . 81223) (\TEDIT.FORMATLINE.VERTICAL 81225 . 83676) (
-\TEDIT.FORMATLINE.JUSTIFY 83678 . 89699) (\TEDIT.FORMATLINE.TABS 89701 . 97729) (\TEDIT.SCALE.TABS 
-97731 . 98522) (\TEDIT.FORMATLINE.PURGE.SPACES 98524 . 99951) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN 
-99953 . 101030) (\TEDIT.FORMATLINE.EMPTY 101032 . 105852) (\TEDIT.FORMATLINE.UPDATELOOKS 105854 . 
-112035) (\TEDIT.FORMATLINE.LASTLEGAL 112037 . 115487) (\TEDIT.LINES.ABOVE 115489 . 119100) (
-\TEDIT.CHNO.TO.YTOP 119102 . 119722)) (120001 140581 (\TEDIT.DISPLAYLINE 120011 . 132521) (
-\TEDIT.DISPLAYLINE.TABS 132523 . 135327) (\TEDIT.LINECACHE 135329 . 136057) (\TEDIT.CREATE.LINECACHE 
-136059 . 136895) (\TEDIT.BLTCHAR 136897 . 139524) (\TEDIT.DIACRITIC.SHIFT 139526 . 140579)) (141196 
-186857 (\TEDIT.BACKFORMAT 141206 . 143760) (\TEDIT.PREVIOUS.LINEBREAK 143762 . 146565) (
-\TEDIT.UPDATE.LINES 146567 . 152873) (\TEDIT.PANE.CREATELINES 152875 . 155165) (
-\TEDIT.SUFFIXLINE.CREATE 155167 . 156782) (\TEDIT.LINES.BELOW 156784 . 161394) (\TEDIT.MEASURED.LINES 
-161396 . 163405) (\TEDIT.VALID.LASTCHNOS 163407 . 167183) (\TEDIT.VALID.NEXTCHNOS 167185 . 170659) (
-\TEDIT.LASTVALIDLINE 170661 . 175332) (\TEDIT.NEXTVALIDLINE 175334 . 178304) (
-\TEDIT.CLEARPANE.BELOW.LINE 178306 . 180412) (\TEDIT.INSERTLINE 180414 . 181800) (\TEDIT.LINE.BOTTOM 
-181802 . 185032) (\TEDIT.SHOW.AT.BOTTOMP 185034 . 186144) (\TEDIT.SHOW.AT.TOPP 186146 . 186855)))))
+  (FILEMAP (NIL (26198 28414 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26208 . 28412)) (35868 119723 (
+\TEDIT.FORMATLINE 35878 . 71207) (\TEDIT.FORMATLINE.SETUP.PARA 71209 . 76403) (
+\TEDIT.FORMATLINE.HORIZONTAL 76405 . 81222) (\TEDIT.FORMATLINE.VERTICAL 81224 . 83675) (
+\TEDIT.FORMATLINE.JUSTIFY 83677 . 89698) (\TEDIT.FORMATLINE.TABS 89700 . 97728) (\TEDIT.SCALE.TABS 
+97730 . 98521) (\TEDIT.FORMATLINE.PURGE.SPACES 98523 . 99950) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN 
+99952 . 101029) (\TEDIT.FORMATLINE.EMPTY 101031 . 105851) (\TEDIT.FORMATLINE.UPDATELOOKS 105853 . 
+112034) (\TEDIT.FORMATLINE.LASTLEGAL 112036 . 115486) (\TEDIT.LINES.ABOVE 115488 . 119099) (
+\TEDIT.CHNO.TO.YTOP 119101 . 119721)) (120000 140580 (\TEDIT.DISPLAYLINE 120010 . 132520) (
+\TEDIT.DISPLAYLINE.TABS 132522 . 135326) (\TEDIT.LINECACHE 135328 . 136056) (\TEDIT.CREATE.LINECACHE 
+136058 . 136894) (\TEDIT.BLTCHAR 136896 . 139523) (\TEDIT.DIACRITIC.SHIFT 139525 . 140578)) (141195 
+186856 (\TEDIT.BACKFORMAT 141205 . 143759) (\TEDIT.PREVIOUS.LINEBREAK 143761 . 146564) (
+\TEDIT.UPDATE.LINES 146566 . 152872) (\TEDIT.PANE.CREATELINES 152874 . 155164) (
+\TEDIT.SUFFIXLINE.CREATE 155166 . 156781) (\TEDIT.LINES.BELOW 156783 . 161393) (\TEDIT.MEASURED.LINES 
+161395 . 163404) (\TEDIT.VALID.LASTCHNOS 163406 . 167182) (\TEDIT.VALID.NEXTCHNOS 167184 . 170658) (
+\TEDIT.LASTVALIDLINE 170660 . 175331) (\TEDIT.NEXTVALIDLINE 175333 . 178303) (
+\TEDIT.CLEARPANE.BELOW.LINE 178305 . 180411) (\TEDIT.INSERTLINE 180413 . 181799) (\TEDIT.LINE.BOTTOM 
+181801 . 185031) (\TEDIT.SHOW.AT.BOTTOMP 185033 . 186143) (\TEDIT.SHOW.AT.TOPP 186145 . 186854)))))
 STOP

library/tedit/TEDIT-SELECTION

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "16-Feb-2026 00:38:33" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;738
 162152 
+
(FILECREATED "16-Apr-2026 09:27:41" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;741
 161623 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.SELPIECES.CHARTRANSFORM)
+      :CHANGES-TO (FNS \TEDIT.SELPIECES.FROM.STRING)
 
-      :PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736)
+      :PREVIOUS-DATE "10-Apr-2026 09:31:20" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;740)
 
 
 (PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
@@ -2041,7 +2041,8 @@
                   SPLASTCHAR _ (ffetch
 (SELPIECES SPLASTCHAR) of
 SP2])
 
 (\TEDIT.SELPIECES.CHARTRANSFORM

-  [LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM)
              (* ; "Edited 16-Feb-2026 00:38 by rmk")


+  [LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM)
              (* ; "Edited 10-Apr-2026 09:17 by rmk")


+                                                             (* ; "Edited 16-Feb-2026 00:38 by rmk")


                                                              (* ; "Edited 24-Apr-2025 16:02 by rmk")


                                                              (* ; "Edited 20-Apr-2025 23:23 by rmk")


                                                              (* ; "Edited 16-Mar-2025 10:03 by rmk")


@@ -2063,7 +2064,7 @@
               (STRING.PTYPES (for
 I CH (STR _ PCONTENTS) from
 1 while
 (SETQ CH (NTHCHARCODE STR I))
                                 do
 (RPLCHARCODE STR I (APPLY* CHARFN CH (add
 INDEX 1)
                                                              TEXTOBJ))))
-              (FILE.PTYPES [LET [(STR (ALLOCSTRING (PLEN PC]
+              (FILE.PTYPES (LET [(STR (ALLOCSTRING (PLEN PC]
 
                                 (* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this.  If not, ALLOCSTRING will cause an error.")

 
@@ -2074,13 +2075,9 @@
                                 (if
 (fetch
 (STRINGP FATSTRINGP) of
 STR)
                                     then
 (FSETPC PC PTYPE FATSTRING.PTYPE)
                                          (FSETPC PC PBYTESPERCHAR 2)
-                                         (FSETPC PC PBINABLE NIL)
                                   else
 (FSETPC PC PTYPE THINSTRING.PTYPE)
-                                       (FSETPC PC PBYTESPERCHAR 1)
-                                       (FSETPC PC PBINABLE T))
-                                (FSETPC PC PCONTENTS STR)
-                                (FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
-                                                           (PLEN PC])
+                                       (FSETPC PC PBYTESPERCHAR 1))
+                                (FSETPC PC PCONTENTS STR)))
               (OBJECT.PTYPE (add
 INDEX 1)
                             (CL:WHEN OBJECTSTOO
                                 (FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX))))
@@ -2088,7 +2085,8 @@
     SELPIECES])
 
 (\TEDIT.SELPIECES.FROM.STRING

-  [LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS)
   (* ; "Edited 28-Jul-2025 23:50 by rmk")


+  [LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS)
   (* ; "Edited 10-Apr-2026 09:18 by rmk")


+                                                             (* ; "Edited 28-Jul-2025 23:50 by rmk")


                                                              (* ; "Edited  8-Feb-2025 20:14 by rmk")


                                                              (* ; "Edited 20-Mar-2024 10:57 by rmk")


                                                              (* ; "Edited  3-Mar-2024 13:00 by rmk")


@@ -2109,12 +2107,10 @@
     (CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP))
            (SETQ CHECKFOREOL T))
     (LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1)
-                (PTYPE THINSTRING.PTYPE)
-                (PBINABLE T))
+                (PTYPE THINSTRING.PTYPE))
          (SETQ STRING (CONCAT STRING))
          (CL:WHEN (fetch
 (STRINGP FATSTRINGP) of
 STRING)
              (SETQ PTYPE FATSTRING.PTYPE)
-             (SETQ PBINABLE NIL)
              (SETQ BYTESPERCHAR 2))
          (if
 (AND CHECKFOREOL (SETQ EOLPOS (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL)))
                                                   STRING)))
@@ -2131,13 +2127,10 @@
                                        PTYPE _ PTYPE
                                        PCONTENTS _ STR
                                        PLEN _ (NCHARS STR)
-                                       PBYTELEN _ (ITIMES (NCHARS STR)
-                                                         BYTESPERCHAR)
                                        PCHARLOOKS _ CHARLOOKS
                                        PPARALOOKS _ PARALOOKS
                                        PPARALAST _ T
-                                       PREVPIECE _ PC
-                                       PBINABLE _ PBINABLE))
+                                       PREVPIECE _ PC))
                                (CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PC))
                                (SETQ PREVPC PC)
                                (SETQ EOLPOS (OR (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL)))
@@ -2158,10 +2151,7 @@
                                         PTYPE _ PTYPE
                                         PCONTENTS _ STRING
                                         PLEN _ (NCHARS STRING)
-                                        PBYTELEN _ (ITIMES (NCHARS STRING)
-                                                          BYTESPERCHAR)
                                         PBYTESPERCHAR _ BYTESPERCHAR
-                                        PBINABLE _ PBINABLE
                                         PCHARLOOKS _ CHARLOOKS
                                         PPARALOOKS _ PARALOOKS))
                 (create
 SELPIECES
@@ -2571,26 +2561,26 @@
 (ADDTOVAR LAMA
 TEDIT.SELPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (15888 17709 (\TEDIT.SELECTION.DEFPRINT 15898 . 17707)) (17746 19251 (
-\TEDIT.SET.GLOBAL.SELECTIONS 17756 . 19249)) (19252 25473 (\TEDIT.SELECTED.PIECES 19262 . 20901) (
-\TEDIT.FIND.PROTECTED.END 20903 . 22697) (\TEDIT.FIND.PROTECTED.START 22699 . 24682) (
-\TEDIT.WORD.BOUND 24684 . 25471)) (25607 59714 (\TEDIT.EXTEND.SEL 25617 . 32857) (\TEDIT.SCAN.LINE 
-32859 . 44532) (\TEDIT.SCAN.LINE.WORD 44534 . 49527) (\TEDIT.XYTOSEL 49529 . 56867) (\TEDIT.REGIONTYPE
- 56869 . 57888) (\TEDIT.XYTOSEL.INLINEP 57890 . 58345) (\TEDIT.XYTOSEL.LINE 58347 . 59712)) (59715 
-73260 (\TEDIT.FIXSEL 59725 . 69102) (\TEDIT.CHTOLINEX 69104 . 73258)) (73261 77465 (
-\TEDIT.RESET.EXTEND.PENDING.DELETE 73271 . 74549) (\TEDIT.SET.SEL.LOOKS 74551 . 77463)) (78402 99555 (
-\TEDIT.SHOWSEL 78412 . 83388) (\TEDIT.NOSEL 83390 . 83691) (\TEDIT.SEL.OFF 83693 . 84104) (
-\TEDIT.SEL.ON 84106 . 84522) (\TEDIT.SHOWSEL.HILIGHT 84524 . 89145) (\TEDIT.UPDATE.SEL 89147 . 93749) 
-(\TEDIT.CARETLINE 93751 . 94465) (\TEDIT.SEL.L1 94467 . 95150) (\TEDIT.SEL.LN 95152 . 95835) (
-\TEDIT.SEL.DELETEDCHARS 95837 . 99553)) (99556 104438 (\TEDIT.COPYSEL 99566 . 102208) (
-\TEDIT.SEL.CHANGED? 102210 . 104436)) (104469 118128 (\TEDIT.SELECT.OBJECT 104479 . 109432) (
-\TEDIT.SHOWSEL.OBJECT 109434 . 111665) (\TEDIT.CLIP.OBJECT 111667 . 113671) (\TEDIT.OPERATE.OBJECT 
-113673 . 118126)) (118156 137982 (\TEDIT.SELPIECES 118166 . 122447) (\TEDIT.SELPIECES.COPY 122449 . 
-124938) (\TEDIT.SELPIECES.CONCAT 124940 . 126819) (\TEDIT.SELPIECES.CHARTRANSFORM 126821 . 130357) (
-\TEDIT.SELPIECES.FROM.STRING 130359 . 135617) (\TEDIT.SELPIECES.TO.STRING 135619 . 137980)) (138035 
-161983 (TEDIT.XYTOCH 138045 . 140621) (TEDIT.SELPROP 140623 . 144900) (TEDIT.GETPOINT 144902 . 146822)
- (TEDIT.GETSEL 146824 . 147700) (TEDIT.GETSEL.PARA 147702 . 148651) (TEDIT.SCANSEL 148653 . 149601) (
-TEDIT.SET.SEL.LOOKS 149603 . 151088) (TEDIT.SETSEL 151090 . 156008) (TEDIT.SHOWSEL 156010 . 157874) (
-TEDIT.SEL.AS.STRING 157876 . 160361) (TEDIT.SEL.AS.SEXPR 160363 . 161649) (TEDIT.SELECTALL 161651 . 
-161981)))))
+  (FILEMAP (NIL (15886 17707 (\TEDIT.SELECTION.DEFPRINT 15896 . 17705)) (17744 19249 (
+\TEDIT.SET.GLOBAL.SELECTIONS 17754 . 19247)) (19250 25471 (\TEDIT.SELECTED.PIECES 19260 . 20899) (
+\TEDIT.FIND.PROTECTED.END 20901 . 22695) (\TEDIT.FIND.PROTECTED.START 22697 . 24680) (
+\TEDIT.WORD.BOUND 24682 . 25469)) (25605 59712 (\TEDIT.EXTEND.SEL 25615 . 32855) (\TEDIT.SCAN.LINE 
+32857 . 44530) (\TEDIT.SCAN.LINE.WORD 44532 . 49525) (\TEDIT.XYTOSEL 49527 . 56865) (\TEDIT.REGIONTYPE
+ 56867 . 57886) (\TEDIT.XYTOSEL.INLINEP 57888 . 58343) (\TEDIT.XYTOSEL.LINE 58345 . 59710)) (59713 
+73258 (\TEDIT.FIXSEL 59723 . 69100) (\TEDIT.CHTOLINEX 69102 . 73256)) (73259 77463 (
+\TEDIT.RESET.EXTEND.PENDING.DELETE 73269 . 74547) (\TEDIT.SET.SEL.LOOKS 74549 . 77461)) (78400 99553 (
+\TEDIT.SHOWSEL 78410 . 83386) (\TEDIT.NOSEL 83388 . 83689) (\TEDIT.SEL.OFF 83691 . 84102) (
+\TEDIT.SEL.ON 84104 . 84520) (\TEDIT.SHOWSEL.HILIGHT 84522 . 89143) (\TEDIT.UPDATE.SEL 89145 . 93747) 
+(\TEDIT.CARETLINE 93749 . 94463) (\TEDIT.SEL.L1 94465 . 95148) (\TEDIT.SEL.LN 95150 . 95833) (
+\TEDIT.SEL.DELETEDCHARS 95835 . 99551)) (99554 104436 (\TEDIT.COPYSEL 99564 . 102206) (
+\TEDIT.SEL.CHANGED? 102208 . 104434)) (104467 118126 (\TEDIT.SELECT.OBJECT 104477 . 109430) (
+\TEDIT.SHOWSEL.OBJECT 109432 . 111663) (\TEDIT.CLIP.OBJECT 111665 . 113669) (\TEDIT.OPERATE.OBJECT 
+113671 . 118124)) (118154 137453 (\TEDIT.SELPIECES 118164 . 122445) (\TEDIT.SELPIECES.COPY 122447 . 
+124936) (\TEDIT.SELPIECES.CONCAT 124938 . 126817) (\TEDIT.SELPIECES.CHARTRANSFORM 126819 . 130189) (
+\TEDIT.SELPIECES.FROM.STRING 130191 . 135088) (\TEDIT.SELPIECES.TO.STRING 135090 . 137451)) (137506 
+161454 (TEDIT.XYTOCH 137516 . 140092) (TEDIT.SELPROP 140094 . 144371) (TEDIT.GETPOINT 144373 . 146293)
+ (TEDIT.GETSEL 146295 . 147171) (TEDIT.GETSEL.PARA 147173 . 148122) (TEDIT.SCANSEL 148124 . 149072) (
+TEDIT.SET.SEL.LOOKS 149074 . 150559) (TEDIT.SETSEL 150561 . 155479) (TEDIT.SHOWSEL 155481 . 157345) (
+TEDIT.SEL.AS.STRING 157347 . 159832) (TEDIT.SEL.AS.SEXPR 159834 . 161120) (TEDIT.SELECTALL 161122 . 
+161452)))))
 STOP

library/tedit/TEDIT-STREAM

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "16-Feb-2026 12:40:44" {WMEDLEY}<library>tedit>TEDIT-STREAM.;944
 193110 
+
(FILECREATED " 1-May-2026 08:15:56" {MEDLEY}<library>tedit>TEDIT-STREAM.;956
 190971 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.STREAMINIT)
+      :CHANGES-TO (RECORDS PIECE)
 
-      :PREVIOUS-DATE "16-Feb-2026 09:39:00" {WMEDLEY}<library>tedit>TEDIT-STREAM.;943)
+      :PREVIOUS-DATE "26-Apr-2026 23:46:38" {MEDLEY}<library>tedit>TEDIT-STREAM.;955)
 
 
 (PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -14,8 +14,8 @@
 (RPAQQ TEDIT-STREAMCOMS

        [(DECLARE%: EVAL@COMPILE DONTCOPY
                (EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
-                      (MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PCHARSET 
-                             PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
+                      (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)
@@ -94,8 +94,8 @@
                  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")

-                 PBYTELEN                                    (* ; 
-
                            "Length of this character piece in bytes.  PBYTELEN = PLEN*PBYTESPERCHAR")

+                 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                                        (* ; 
@@ -111,20 +111,18 @@
                  (PNEW FLAG)                                 (* ; 
 
             "This text is new here;  used by the tentative edit system, and anyone else interested.")

                  (NIL FLAG)                                  (* ; "Was PFATP")

-                 (PBINABLE FLAG)                             (* ; 
-
                                                 "8-bit bytes are binable (THINSTRING and THINFILE) ")

+                 (NIL FLAG)
                  (PTREENODE XPOINTER)                        (* ; 
 
                                             "Points to the PCTB tree-node that contains this piece.")

-                 (PCHARSET BYTE)                             (* ; 
-
                                                             "High-order charset for FATFILE1 pieces")

-                 (PUTF8BYTESPERCHAR BYTE))                   (* ; 
-
              "The number of bytes in the UTF-8 encoding of all the Unicode characters in 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 PBYTELEN _ 0)
+                PFPOS _ 0 PLEN _ 0)
 
 (DATATYPE TEXTOBJ
 (
                    (* ;; 
@@ -294,7 +292,7 @@
 (/DECLAREDATATYPE 'PIECE
        '(POINTER (BITS 4)
                POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG 
-               FLAG XPOINTER BYTE BYTE)
+               FLAG XPOINTER BYTE POINTER)
        '((PIECE 0 POINTER)
          (PIECE 0 (BITS . 3))
          (PIECE 2 POINTER)
@@ -311,8 +309,8 @@
          (PIECE 16 (FLAGBITS . 32))
          (PIECE 18 XPOINTER)
          (PIECE 20 (BITS . 7))
-         (PIECE 20 (BITS . 135)))
-       '22)
+         (PIECE 22 POINTER))
+       '24)
 
 (/DECLAREDATATYPE 'TEXTOBJ
        '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER 
@@ -405,9 +403,6 @@
 (PUTPROPS PCHARLOOKS
 MACRO
 ((PC)
                             (ffetch
 (PIECE PCHARLOOKS) of
 PC)))
 
-(PUTPROPS PCHARSET
 MACRO
 ((PC)
-                          (ffetch
 (PIECE PCHARSET) of
 PC)))
-
 (PUTPROPS PPARALOOKS
 MACRO
 ((PC)
                             (ffetch
 (PIECE PPARALOOKS) of
 PC)))
 
@@ -417,15 +412,13 @@
 (PUTPROPS PFPOS
 MACRO
 ((PC)
                        (ffetch
 (PIECE PFPOS) of
 PC)))
 
-(PUTPROPS PBYTELEN
 MACRO
 ((PC)
-                          (ffetch
 (PIECE PBYTELEN) 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 PBINABLE
 MACRO
 ((PC)
-                          (ffetch
 (PIECE PBINABLE) of
 PC)))
-
 (PUTPROPS PBYTESPERCHAR
 MACRO
 ((PC)
                                (ffetch
 (PIECE PBYTESPERCHAR) of
 PC)))
 
@@ -454,7 +447,7 @@
 
                             (SELECTC (PTYPE PC)
                                 (THIN.PTYPES T)
-                                (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR)))
+                                (UTF8.PTYPE (EQ 1 (FGETPC PC PBYTESPERCHAR)))
                                 NIL)))
 )
 (DECLARE%: EVAL@COMPILE 
@@ -517,7 +510,6 @@
 
 (RPAQQ PTYPES

        ((THINFILE.PTYPE 0)
-        (FATFILE1.PTYPE 1)
         (FATFILE2.PTYPE 2)
         (THINSTRING.PTYPE 3)
         (FATSTRING.PTYPE 4)
@@ -527,18 +519,15 @@
         (UTF16BE.PTYPE 8)
         (UTF16LE.PTYPE 9)
         (UTF8.PTYPE 11)
-        (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE 
-                           UTF16LE.PTYPE))
+        (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 FATFILE1.PTYPE))))
+        (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE))))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ THINFILE.PTYPE
 0)
 
-(RPAQQ FATFILE1.PTYPE
 1)
-
 (RPAQQ FATFILE2.PTYPE
 2)
 
 (RPAQQ THINSTRING.PTYPE
 3)
@@ -557,8 +546,7 @@
 
 (RPAQQ UTF8.PTYPE
 11)
 
-(RPAQ FILE.PTYPES
 (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE 
-                        UTF16LE.PTYPE))
+(RPAQ FILE.PTYPES
 (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
 
 (RPAQ STRING.PTYPES
 (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
 
@@ -566,11 +554,10 @@
 
 (RPAQ THIN.PTYPES
 (LIST THINFILE.PTYPE THINSTRING.PTYPE))
 
-(RPAQ FAT.PTYPES
 (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
+(RPAQ FAT.PTYPES
 (LIST FATFILE2.PTYPE FATSTRING.PTYPE))
 
 
 (CONSTANTS (THINFILE.PTYPE 0)
-       (FATFILE1.PTYPE 1)
        (FATFILE2.PTYPE 2)
        (THINSTRING.PTYPE 3)
        (FATSTRING.PTYPE 4)
@@ -580,12 +567,11 @@
        (UTF16BE.PTYPE 8)
        (UTF16LE.PTYPE 9)
        (UTF8.PTYPE 11)
-       (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE 
-                          UTF16LE.PTYPE))
+       (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 FATFILE1.PTYPE)))
+       (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE)))
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -599,7 +585,7 @@
 (/DECLAREDATATYPE 'PIECE
        '(POINTER (BITS 4)
                POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG 
-               FLAG XPOINTER BYTE BYTE)
+               FLAG XPOINTER BYTE POINTER)
        '((PIECE 0 POINTER)
          (PIECE 0 (BITS . 3))
          (PIECE 2 POINTER)
@@ -616,8 +602,8 @@
          (PIECE 16 (FLAGBITS . 32))
          (PIECE 18 XPOINTER)
          (PIECE 20 (BITS . 7))
-         (PIECE 20 (BITS . 135)))
-       '22)
+         (PIECE 22 POINTER))
+       '24)
 
 (/DECLAREDATATYPE 'TEXTOBJ
        '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER 
@@ -697,6 +683,10 @@
 (\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")

@@ -818,18 +808,6 @@
                                                       (\TEDIT.INSTALL.FILEBUFFER
 TSTREAM
                                                              (ffetch
 (TEXTSTREAM PCCHARSLEFT)
                                                                 of
 TSTREAM)))))
-                                  (FATFILE1.PTYPE 
-                                       (PROG1 (create
 WORD
-                                                     HIBYTE _ (PCHARSET PC)
-                                                     LOBYTE _ (BIN (PCONTENTS PC)))
-                                           (add
 (ffetch
 (STREAM COFFSET) of
 TSTREAM)
-                                                1)
-                                           (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))
@@ -848,7 +826,8 @@
                                          (\TEDIT.THELP "\TEXTBIN UNKNOWN PTYPE" (PTYPE PC])
 
 (\TEDIT.TEXTPEEKBIN

-  [LAMBDA (TSTREAM NOERROR)
                                  (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [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")


@@ -911,10 +890,6 @@
                                                       'OBJECTBYTE)
                                                PCONTENTS))
                              (UTF8.PTYPE (UTF8.PEEKCCODEFN PCONTENTS))
-                             (FATFILE1.PTYPE 
-                                  (create
 WORD
-                                         HIBYTE _ (PCHARSET PC)
-                                         LOBYTE _ (\PEEKBIN PCONTENTS)))
                              (SUBSTREAM.PTYPE                (* ; "A substream stored as an object")

                                   (\PEEKBIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
                              (\TEDIT.THELP "UNKNOWN PIECE TYPE")))
@@ -923,7 +898,8 @@
            else
 (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
 
 (\TEDIT.TEXTBACKFILEPTR

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 16-Feb-2026 08:54 by rmk")


+  [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")


@@ -1008,10 +984,6 @@
                                           'OBJECTBYTE)
                                    (PCONTENTS PC)))
                  (UTF8.PTYPE (UTF8.PEEKCCODEFN (PCONTENTS PC)))
-                 (FATFILE1.PTYPE 
-                      (LOGOR (LLSH (PCHARSET PC)
-                                   8)
-                             (\PEEKBIN (PCONTENTS PC))))
                  (SUBSTREAM.PTYPE                            (* ; "A substream stored as an object")

                       (BIN (IMAGEOBJPROP (PCONTENTS PC)
                                   'SUBSTREAM)))
@@ -1760,7 +1732,8 @@
 (DEFINEQ
 
 (\TEDIT.STREAMINIT

-  [LAMBDA NIL
                                                (* ; "Edited 16-Feb-2026 12:40 by rmk")


+  [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")


@@ -1823,7 +1796,7 @@
            (FUNCTION \TEDIT.TEXTBACKCCODEFN)
            (FUNCTION \TEDIT.TEXTOUTCHARFN)
            (FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
-           'CR NIL (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
+           'CR T (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
 
     (* ;; "Support for error handling:  The old error handler for the stream-not-open error.  ")

 
@@ -2277,7 +2250,8 @@
                     (IDIFFERENCE N START-OF-PIECE)))])
 
 (\TEDIT.PIECE.NTHCHARCODE

-  [LAMBDA (PC OFFSET)
                                        (* ; "Edited 15-Feb-2026 14:31 by rmk")


+  [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")


@@ -2304,14 +2278,6 @@
                                                     OFFSET))
                       (PROG1 (BIN PCONTENTS)
                              (\SETFILEPTR PCONTENTS FILEPOS)))
-                 (FATFILE1.PTYPE 
-                      (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
-                      (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
-                                                    OFFSET))
-                      (PROG1 (create
 WORD
-                                    HIBYTE _ (PCHARSET PC)
-                                    LOBYTE _ (BIN PCONTENTS))
-                             (\SETFILEPTR PCONTENTS FILEPOS)))
                  (FATFILE2.PTYPE 
                       (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
                       (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
@@ -2359,7 +2325,8 @@
              TSTREAM))])
 
 (\TEDIT.PIECE.RPLCHARCODE

-  [LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS)
       (* ; "Edited 16-Feb-2026 08:41 by rmk")


+  [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")


@@ -2393,10 +2360,7 @@
                   (CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
                                 (IGREATERP NEWCHARCODE \MAXTHINCHAR))
                       (FSETPC PC PTYPE FATSTRING.PTYPE)
-                      (FSETPC PC PBINABLE NIL)
-                      (FSETPC PC PBYTESPERCHAR 2)
-                      (FSETPC PC PBYTELEN (UNFOLD (PLEN PC)
-                                                 2)))
+                      (FSETPC PC PBYTESPERCHAR 2))
            elseif
 [AND (IMAGEOBJP NEWCHARCODE)
                        (EQ OBJECT.PTYPE (PTYPE PC))
                        (OR (NULL NEWCHARLOOKS)
@@ -2425,24 +2389,17 @@
 
                 (SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE
 PC 0))
                 (if
 (IMAGEOBJP NEWCHARCODE)
-                    then
 (FSETPC PC PBINABLE NIL)
-                         (FSETPC PC PCONTENTS NEWCHARCODE)
+                    then
 (FSETPC PC PCONTENTS NEWCHARCODE)
                          (FSETPC PC PTYPE OBJECT.PTYPE)
                          (FSETPC PC PBYTESPERCHAR NIL)       (* ; "Doesn't make sense for objects")

-                         (FSETPC PC PBYTELEN NIL)
                   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 PBINABLE NIL)
                                 (FSETPC PC PBYTESPERCHAR 2)
-                                (FSETPC PC PBYTELEN 2)
                          else
 (FSETPC PC PTYPE THINSTRING.PTYPE)
-                              (FSETPC PC PBINABLE T)
-                              (FSETPC PC PBYTESPERCHAR 1)
-                              (FSETPC PC PBYTELEN 1)
-                              (FSETPC PC PCHARSET 0)))
+                              (FSETPC PC PBYTESPERCHAR 1)))
                 (FSETPC PC PFPOS NIL)
                 (CL:WHEN NEWCHARLOOKS
                     (FSETPC PC PCHARLOOKS (CL:IF (FONTP NEWCHARLOOKS)
@@ -2546,7 +2503,8 @@
              T)])
 
 (\TEDIT.INSERTCH

-  [LAMBDA (CH CH# TEXTOBJ PARALAST)
                          (* ; "Edited 26-Jul-2025 21:13 by rmk")


+  [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")


@@ -2634,14 +2592,9 @@
                                      PNEW _ T))
                  (SELECTC INSERTPTYPE
                      (THINSTRING.PTYPE 
-                          (FSETPC PREVPC PBYTESPERCHAR 1)
-                          (FSETPC PREVPC PBYTELEN ILEN)
-                          (FSETPC PREVPC PBINABLE T)
-                          (FSETPC PREVPC PCHARSET 0))
-                     (FATSTRING.PTYPE                        (* ; "PCHARSET is not relevant")

-                          (FSETPC PREVPC PBYTESPERCHAR 2)
-                          (FSETPC PREVPC PBYTELEN (UNFOLD ILEN 2))
-                          (FSETPC PREVPC PBINABLE NIL))
+                          (FSETPC PREVPC PBYTESPERCHAR 1))
+                     (FATSTRING.PTYPE 
+                          (FSETPC PREVPC PBYTESPERCHAR 2))
                      (\TEDIT.THELP "Unexpected PTYPE"))
                  (\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))
 
@@ -2785,7 +2738,8 @@
          INSERTION])
 
 (\TEDIT.INSERTCH.EXTEND

-  [LAMBDA (PC ILEN TEXTOBJ)
                                  (* ; "Edited 16-Mar-2024 09:56 by rmk")


+  [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")


@@ -2796,8 +2750,6 @@
 
     (add
 (PLEN PC)
          ILEN)
-    (FSETPC PC PBYTELEN (ITIMES (PLEN PC)
-                               (PBYTESPERCHAR PC)))
     (add
 (ffetch
 (STRINGP LENGTH) of
 (PCONTENTS PC))
          ILEN)
     (add
 (ffetch
 (BTSLOT DLEN) of
 (\FINDSLOT (ffetch
 (PIECE PTREENODE) of
 PC)
@@ -2836,7 +2788,8 @@
 (DEFINEQ
 
 (\TEDIT.INSTALL.PIECE

-  [LAMBDA (TSTREAM PC CHOFFSET)
                              (* ; "Edited 21-Oct-2024 00:26 by rmk")


+  [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")


@@ -2891,7 +2844,11 @@
                                                 PLEN)))
                   (OBJECT.PTYPE (freplace
 (STREAM CBUFSIZE) of
 TSTREAM with
 1))
                   NIL)
-              (freplace
 (STREAM BINABLE) of
 TSTREAM with
 (PBINABLE PC))
+
+         (* ;; "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)
@@ -3127,33 +3084,33 @@
 (ADDTOVAR LAMA
 TEXTPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (36667 67629 (\TEDIT.TEXTBIN 36677 . 47470) (\TEDIT.TEXTPEEKBIN 47472 . 53022) (
-\TEDIT.TEXTBACKFILEPTR 53024 . 58800) (\TEDIT.TEXTBOUT 58802 . 63419) (\TEDIT.INSTALL.FILEBUFFER 63421
- . 67627)) (68527 72818 (\TEDIT.TEXTOUTCHARFN 68537 . 70093) (\TEDIT.TEXTINCCODEFN 70095 . 70834) (
-\TEDIT.TEXTBACKCCODEFN 70836 . 71428) (\TEDIT.TEXTFORMATBYTESTREAM 71430 . 72267) (
-\TEDIT.TEXTFORMATBYTESTRING 72269 . 72816)) (72865 84940 (OPENTEXTSTREAM 72875 . 79851) (
-COPYTEXTSTREAM 79853 . 84163) (TEDIT.STREAMCHANGEDP 84165 . 84467) (TXTFILE 84469 . 84938)) (84941 
-108146 (\TEDIT.REOPENTEXTSTREAM 84951 . 86303) (\TEDIT.OPENTEXTSTREAM.PIECES 86305 . 91233) (
-\TEDIT.OPENTEXTSTREAM.PROPS 91235 . 92337) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92339 . 97789) (
-\TEDIT.OPENTEXTSTREAM.WINDOW 97791 . 100582) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100584 . 102523) (
-\TEDIT.OPENTEXTFILE 102525 . 104657) (\TEDIT.CREATE.TEXTSTREAM 104659 . 105806) (\TEDIT.REOPEN.STREAM 
-105808 . 108144)) (108147 116372 (\TEDIT.STREAMINIT 108157 . 116189) (TEDIT.IMAGESTREAM.OPEN 116191 . 
-116370)) (116560 117748 (\TEDIT.TTYBOUT 116570 . 117746)) (117866 139549 (\TEDIT.TEXTCLOSEF 117876 . 
-119200) (\TEDIT.TEXTDSPFONT 119202 . 120400) (\TEDIT.TEXTEOFP 120402 . 122157) (\TEDIT.TEXTGETEOFPTR 
-122159 . 122482) (\TEDIT.TEXTSETEOFPTR 122484 . 123771) (\TEDIT.TEXTGETFILEPTR 123773 . 126608) (
-\TEDIT.TEXTSETFILEINFO 126610 . 127118) (\TEDIT.TEXTOPENF 127120 . 128051) (\TEDIT.TEXTSETEOF 128053
- . 128669) (\TEDIT.TEXTSETFILEPTR 128671 . 130781) (\TEDIT.TEXTDSPXPOSITION 130783 . 133486) (
-\TEDIT.TEXTDSPYPOSITION 133488 . 134229) (\TEDIT.TEXTLEFTMARGIN 134231 . 134822) (\TEDIT.TEXTCOLOR 
-134824 . 135407) (\TEDIT.TEXTRIGHTMARGIN 135409 . 138698) (\TEDIT.TEXTDSPCHARWIDTH 138700 . 139004) (
-\TEDIT.TEXTDSPSTRINGWIDTH 139006 . 139312) (\TEDIT.TEXTDSPLINEFEED 139314 . 139547)) (139587 152583 (
-\TEDIT.NTHCHARCODE 139597 . 141123) (\TEDIT.PIECE.NTHCHARCODE 141125 . 145033) (\TEDIT.RPLCHARCODE 
-145035 . 146593) (\TEDIT.PIECE.RPLCHARCODE 146595 . 152228) (\TEDIT.NTHCHARLOOKS 152230 . 152581)) (
-153630 174724 (\TEDIT.DELETE.SELPIECES 153640 . 157265) (\TEDIT.INSERTCH 157267 . 165306) (
-\TEDIT.INSERTCH.HISTORY 165308 . 168772) (\TEDIT.INSERTEOL 168774 . 170599) (\TEDIT.INSERTCH.INSERTION
- 170601 . 173438) (\TEDIT.INSERTCH.EXTEND 173440 . 174722)) (174725 176332 (\TEDIT.NEXTCHANGEABLE.CHNO
- 174735 . 175450) (\TEDIT.LASTCHANGEABLE.CHNO 175452 . 176330)) (176333 180791 (\TEDIT.INSTALL.PIECE 
-176343 . 180789)) (180829 190295 (TEXTPROP 180839 . 181186) (GETTEXTPROP 181188 . 181432) (PUTTEXTPROP
- 181434 . 181691) (GETTEXTPROPS 181693 . 182137) (PUTTEXTPROPS 182139 . 183043) (TEXTPROP.ADD 183045
- . 183308) (\TEDIT.TEXTPROP 183310 . 190293)) (190296 192673 (\TEDIT.TEXTOBJ.PROPNAMES 190306 . 191565
-) (\TEDIT.TEXTOBJ.PROPFETCHFN 191567 . 192083) (\TEDIT.TEXTOBJ.PROPSTOREFN 192085 . 192671)))))
+  (FILEMAP (NIL (36156 66033 (\TEDIT.TEXTBIN 36166 . 46068) (\TEDIT.TEXTPEEKBIN 46070 . 51495) (
+\TEDIT.TEXTBACKFILEPTR 51497 . 57204) (\TEDIT.TEXTBOUT 57206 . 61823) (\TEDIT.INSTALL.FILEBUFFER 61825
+ . 66031)) (66931 71222 (\TEDIT.TEXTOUTCHARFN 66941 . 68497) (\TEDIT.TEXTINCCODEFN 68499 . 69238) (
+\TEDIT.TEXTBACKCCODEFN 69240 . 69832) (\TEDIT.TEXTFORMATBYTESTREAM 69834 . 70671) (
+\TEDIT.TEXTFORMATBYTESTRING 70673 . 71220)) (71269 83344 (OPENTEXTSTREAM 71279 . 78255) (
+COPYTEXTSTREAM 78257 . 82567) (TEDIT.STREAMCHANGEDP 82569 . 82871) (TXTFILE 82873 . 83342)) (83345 
+106550 (\TEDIT.REOPENTEXTSTREAM 83355 . 84707) (\TEDIT.OPENTEXTSTREAM.PIECES 84709 . 89637) (
+\TEDIT.OPENTEXTSTREAM.PROPS 89639 . 90741) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 90743 . 96193) (
+\TEDIT.OPENTEXTSTREAM.WINDOW 96195 . 98986) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98988 . 100927) (
+\TEDIT.OPENTEXTFILE 100929 . 103061) (\TEDIT.CREATE.TEXTSTREAM 103063 . 104210) (\TEDIT.REOPEN.STREAM 
+104212 . 106548)) (106551 114883 (\TEDIT.STREAMINIT 106561 . 114700) (TEDIT.IMAGESTREAM.OPEN 114702 . 
+114881)) (115071 116259 (\TEDIT.TTYBOUT 115081 . 116257)) (116377 138060 (\TEDIT.TEXTCLOSEF 116387 . 
+117711) (\TEDIT.TEXTDSPFONT 117713 . 118911) (\TEDIT.TEXTEOFP 118913 . 120668) (\TEDIT.TEXTGETEOFPTR 
+120670 . 120993) (\TEDIT.TEXTSETEOFPTR 120995 . 122282) (\TEDIT.TEXTGETFILEPTR 122284 . 125119) (
+\TEDIT.TEXTSETFILEINFO 125121 . 125629) (\TEDIT.TEXTOPENF 125631 . 126562) (\TEDIT.TEXTSETEOF 126564
+ . 127180) (\TEDIT.TEXTSETFILEPTR 127182 . 129292) (\TEDIT.TEXTDSPXPOSITION 129294 . 131997) (
+\TEDIT.TEXTDSPYPOSITION 131999 . 132740) (\TEDIT.TEXTLEFTMARGIN 132742 . 133333) (\TEDIT.TEXTCOLOR 
+133335 . 133918) (\TEDIT.TEXTRIGHTMARGIN 133920 . 137209) (\TEDIT.TEXTDSPCHARWIDTH 137211 . 137515) (
+\TEDIT.TEXTDSPSTRINGWIDTH 137517 . 137823) (\TEDIT.TEXTDSPLINEFEED 137825 . 138058)) (138098 150332 (
+\TEDIT.NTHCHARCODE 138108 . 139634) (\TEDIT.PIECE.NTHCHARCODE 139636 . 143204) (\TEDIT.RPLCHARCODE 
+143206 . 144764) (\TEDIT.PIECE.RPLCHARCODE 144766 . 149977) (\TEDIT.NTHCHARLOOKS 149979 . 150330)) (
+151379 172254 (\TEDIT.DELETE.SELPIECES 151389 . 155014) (\TEDIT.INSERTCH 155016 . 162821) (
+\TEDIT.INSERTCH.HISTORY 162823 . 166287) (\TEDIT.INSERTEOL 166289 . 168114) (\TEDIT.INSERTCH.INSERTION
+ 168116 . 170953) (\TEDIT.INSERTCH.EXTEND 170955 . 172252)) (172255 173862 (\TEDIT.NEXTCHANGEABLE.CHNO
+ 172265 . 172980) (\TEDIT.LASTCHANGEABLE.CHNO 172982 . 173860)) (173863 178652 (\TEDIT.INSTALL.PIECE 
+173873 . 178650)) (178690 188156 (TEXTPROP 178700 . 179047) (GETTEXTPROP 179049 . 179293) (PUTTEXTPROP
+ 179295 . 179552) (GETTEXTPROPS 179554 . 179998) (PUTTEXTPROPS 180000 . 180904) (TEXTPROP.ADD 180906
+ . 181169) (\TEDIT.TEXTPROP 181171 . 188154)) (188157 190534 (\TEDIT.TEXTOBJ.PROPNAMES 188167 . 189426
+) (\TEDIT.TEXTOBJ.PROPFETCHFN 189428 . 189944) (\TEDIT.TEXTOBJ.PROPSTOREFN 189946 . 190532)))))
 STOP

library/tedit/TEDIT-TFBRAVO

@@ -1,13 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "21-Jan-2026 12:15:57" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;190
 98203  
+
(FILECREATED "10-Apr-2026 09:25:52" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;192
 97960  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS BRAVOFILEP)
-                  (VARS TEDIT-TFBRAVOCOMS)
+      :CHANGES-TO (FNS \TFBRAVO.INSERT.RUN)
 
-      :PREVIOUS-DATE " 7-Sep-2025 11:11:43" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;187)
+      :PREVIOUS-DATE " 9-Apr-2026 17:24:28" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;191)
 
 
 (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -1027,7 +1026,8 @@
                                                   (\TFBRAVO.INSERT.RUN
 RUN BSTREAM PARALOOKS TEXTOBJ])
 
 (\TFBRAVO.INSERT.RUN

-  [LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ)
                    (* ; "Edited 28-Jul-2025 23:33 by rmk")


+  [LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ)
                    (* ; "Edited 10-Apr-2026 09:22 by rmk")


+                                                             (* ; "Edited 28-Jul-2025 23:33 by rmk")


                                                              (* ; "Edited  8-Feb-2025 23:08 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 16-Jan-2024 18:28 by rmk")


@@ -1064,17 +1064,11 @@
                                             THINSTRING.PTYPE))
                             (SETQ PBYTESPERCHAR (CL:IF FATP
                                                     2
-                                                    1))
-                            (SETQ PBINABLE (NOT FATP))
-                            (SETQ PBYTELEN (UNFOLD NCHARS 2))
-                            (SETQ PUTF8BYTESPERCHAR 2))
+                                                    1)))
                else
 (with
 PIECE PC (SETQ PCONTENTS BSTREAM)
                           (SETQ PFPOS RUNSTART)
                           (SETQ PTYPE THINFILE.PTYPE)
-                          (SETQ PBINABLE T)
-                          (SETQ PBYTESPERCHAR 1)
-                          (SETQ PBYTELEN NCHARS)
-                          (SETQ PUTF8BYTESPERCHAR 2)))
+                          (SETQ PBYTESPERCHAR 1)))
              (\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
              PC))])
 
@@ -1571,18 +1565,18 @@
 (AND NIL (\TEDIT.NAMEDTAB.INIT
))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7784 15335 (BRAVOFILEP 7794 . 9981) (TEDITFROMBRAVO 9983 . 15333)) (15610 32026 (
-\TFBRAVO.GET.USER.CM 15620 . 18800) (\TFBRAVO.USER.CM.LOOKS 18802 . 20295) (\TFBRAVO.READ.USER.CM 
-20297 . 24920) (\TFBRAVO.INIT.PARALOOKS 24922 . 27139) (\TFBRAVO.INIT.PAGEFORMAT 27141 . 28021) (
-\TFBRAVO.GETPARAMS 28023 . 30877) (\TFBRAVO.FIND.LAST.TRAILER 30879 . 32024)) (32068 52773 (
-\TFBRAVO.PARSE.PARA 32078 . 36005) (\TFBRAVO.READ.PARALOOKS 36007 . 42897) (\TFBRAVO.CREATE.RUNS 42899
- . 44287) (\TFBRAVO.READ.CHARLOOKS 44289 . 49318) (\TFBRAVO.FONT.FROM.CHARLOOKS 49320 . 50874) (
-\TFBRAVO.READNUM? 50876 . 52771)) (52810 63851 (\TFBRAVO.HANDLE.HEADING 52820 . 55547) (
-\TFBRAVO.PARSE.PROFILE.PARA 55549 . 63849)) (63894 86228 (\TFBRAVO.INSERT.PARA 63904 . 64745) (
-\TFBRAVO.INSERT.RUN 64747 . 68238) (\TFBRAVO.SPLIT.PARA 68240 . 75664) (\TFBRAVO.RUN.TABSPEC 75666 . 
-80533) (\TFBRAVO.INSTALL.PAGEFORMAT 80535 . 86226)) (86229 90372 (\TFBRAVO.ASSERT 86239 . 86769) (
-\TEST.CHARACTER.LOOKS 86771 . 88657) (\TEST.PARAGRAPH.LOOKS 88659 . 90370)) (91382 98037 (
-\TFBRAVO.ADD.NAMEDTAB 91392 . 94995) (\TFBRAVO.COPY.NAMEDTAB 94997 . 95445) (\TFBRAVO.PUT.NAMEDTAB 
-95447 . 95727) (\TFBRAVO.GET.NAMEDTAB 95729 . 96106) (\NAMEDTABNYET 96108 . 96268) (\NAMEDTABSIZE 
-96270 . 96785) (\NAMEDTABPREPRINT 96787 . 96985) (\TEDIT.NAMEDTAB.INIT 96987 . 98035)))))
+  (FILEMAP (NIL (7750 15301 (BRAVOFILEP 7760 . 9947) (TEDITFROMBRAVO 9949 . 15299)) (15576 31992 (
+\TFBRAVO.GET.USER.CM 15586 . 18766) (\TFBRAVO.USER.CM.LOOKS 18768 . 20261) (\TFBRAVO.READ.USER.CM 
+20263 . 24886) (\TFBRAVO.INIT.PARALOOKS 24888 . 27105) (\TFBRAVO.INIT.PAGEFORMAT 27107 . 27987) (
+\TFBRAVO.GETPARAMS 27989 . 30843) (\TFBRAVO.FIND.LAST.TRAILER 30845 . 31990)) (32034 52739 (
+\TFBRAVO.PARSE.PARA 32044 . 35971) (\TFBRAVO.READ.PARALOOKS 35973 . 42863) (\TFBRAVO.CREATE.RUNS 42865
+ . 44253) (\TFBRAVO.READ.CHARLOOKS 44255 . 49284) (\TFBRAVO.FONT.FROM.CHARLOOKS 49286 . 50840) (
+\TFBRAVO.READNUM? 50842 . 52737)) (52776 63817 (\TFBRAVO.HANDLE.HEADING 52786 . 55513) (
+\TFBRAVO.PARSE.PROFILE.PARA 55515 . 63815)) (63860 85985 (\TFBRAVO.INSERT.PARA 63870 . 64711) (
+\TFBRAVO.INSERT.RUN 64713 . 67995) (\TFBRAVO.SPLIT.PARA 67997 . 75421) (\TFBRAVO.RUN.TABSPEC 75423 . 
+80290) (\TFBRAVO.INSTALL.PAGEFORMAT 80292 . 85983)) (85986 90129 (\TFBRAVO.ASSERT 85996 . 86526) (
+\TEST.CHARACTER.LOOKS 86528 . 88414) (\TEST.PARAGRAPH.LOOKS 88416 . 90127)) (91139 97794 (
+\TFBRAVO.ADD.NAMEDTAB 91149 . 94752) (\TFBRAVO.COPY.NAMEDTAB 94754 . 95202) (\TFBRAVO.PUT.NAMEDTAB 
+95204 . 95484) (\TFBRAVO.GET.NAMEDTAB 95486 . 95863) (\NAMEDTABNYET 95865 . 96025) (\NAMEDTABSIZE 
+96027 . 96542) (\NAMEDTABPREPRINT 96544 . 96742) (\TEDIT.NAMEDTAB.INIT 96744 . 97792)))))
 STOP

library/tedit/TEDIT-WINDOW

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Dec-2025 11:22:33" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;883
 231422 
+
(FILECREATED " 7-Feb-2026 18:53:22" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;896
 234678 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.MINIMAL.WINDOW.SETUP TEDIT.PROMPTCLEAR TEDIT.PROMPTPRINT)
+      :CHANGES-TO (FNS TEDIT.PROMPTPRINT)
 
-      :PREVIOUS-DATE "15-Nov-2025 01:27:38" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;881)
+      :PREVIOUS-DATE " 5-Feb-2026 08:24:23" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;895)
 
 
 (PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -458,7 +458,10 @@
          WINDOW])
 
 (\TEDIT.WINDOW.GETREGION

-  [LAMBDA (TSTREAM REGIONTYPE PHEIGHT)
                       (* ; "Edited 25-Oct-2025 10:27 by rmk")


+  [LAMBDA (TSTREAM REGIONTYPE PHEIGHT)
                       (* ; "Edited  5-Feb-2026 08:24 by rmk")


+                                                             (* ; "Edited 27-Jan-2026 15:30 by rmk")


+                                                             (* ; "Edited 25-Jan-2026 20:09 by rmk")


+                                                             (* ; "Edited 25-Oct-2025 10:27 by rmk")


                                                              (* ; "Edited 19-Oct-2025 01:05 by rmk")


                                                              (* ; "Edited 14-Apr-2025 00:05 by rmk")


                                                              (* ; "Edited 31-Mar-2025 22:43 by rmk")


@@ -466,87 +469,94 @@
                                                              (* ; "Edited 18-Mar-2025 21:52 by rmk")


                                                              (* ; "Edited 19-Feb-2025 16:48 by rmk")


                                                              (* ; "Edited 18-Feb-2025 10:09 by rmk")

-    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
-          [WIDTHOVERHEAD (IPLUS \TEDIT.LINEREGION.WIDTH (TIMES 2 WBorder)
-                                (if
 (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
-                                    then
 0
-                                  elseif
 (ILEQ \TEDIT.OP.WIDTH 0)
-                                    then
 
-                                         (* ;; "On both sides, for symmetry")

+    (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+           [WIDTHOVERHEAD (IPLUS \TEDIT.LINEREGION.WIDTH (TIMES 2 WBorder)
+                                 (if
 (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
+                                     then
 0
+                                   elseif
 (ILEQ \TEDIT.OP.WIDTH 0)
+                                     then
 
+                                          (* ;; "On both sides, for symmetry")

 
-                                         \TEDIT.LINEREGION.WIDTH
-                                  else
 
-                                       (* ;; 
+                                          \TEDIT.LINEREGION.WIDTH
+                                   else
 
+                                        (* ;; 
 
                       "36 to allow for some spacing between the text and the OPS area on the right.")

 
-                                       (IPLUS \TEDIT.OP.WIDTH 36]
-          [HEIGHTOVERHEAD (IPLUS PHEIGHT (ADD1 (TIMES 2 WBorder))
-                                 (FONTPROP WindowTitleDisplayStream 'HEIGHT]
-          WIDTH HEIGHT)
+                                        (IPLUS \TEDIT.OP.WIDTH 36]
+           [HEIGHTOVERHEAD (IPLUS PHEIGHT (ADD1 (TIMES 2 WBorder))
+                                  (FONTPROP WindowTitleDisplayStream 'HEIGHT]
+           WIDTH HEIGHT)
 
-         (* ;; "Explict properties cover content")

+          (* ;; "Explict properties cover content")

 
-         [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
-                         (for
 PARALOOKS in
 (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
-                            when
 (IGREATERP (GETPLOOKS PARALOOKS RIGHTMAR)
-                                        0) largest
 (GETPLOOKS PARALOOKS RIGHTMAR)
-                            finally
 (RETURN $$EXTREME]
-         (SETQ HEIGHT (GETTEXTPROP TEXTOBJ 'OPENHEIGHT))
+          [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
+                          (for
 PARALOOKS in
 (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
+                             when
 (IGREATERP (GETPLOOKS PARALOOKS RIGHTMAR)
+                                         0) largest
 (GETPLOOKS PARALOOKS RIGHTMAR)
+                             finally
 (RETURN $$EXTREME]
+          (SETQ HEIGHT (GETTEXTPROP TEXTOBJ 'OPENHEIGHT))
 
-         (* ;; "If still no WIDTH or HEIGHT, look at the first 20 lines")

+          (* ;; "If still no WIDTH or HEIGHT, look at the first 20 lines")

 
-         (CL:UNLESS (AND HEIGHT WIDTH)
-             (for
 I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
-                  (REG _ (CREATEREGION 0 0 (IDIFFERENCE SCREENWIDTH WIDTHOVERHEAD)
-                                (IDIFFERENCE SCREENHEIGHT HEIGHTOVERHEAD)))
-                  (W _ 0)
-                  (H _ 0)
-                  (CHNO _ 1) from
 1 to
 20 while
 (ILEQ CHNO TEXTLEN)
-                do
 
-                   (* ;; 
+          (CL:UNLESS (AND HEIGHT WIDTH)
+              (for
 I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
+                   (REG _ (CREATEREGION 0 0 (IDIFFERENCE SCREENWIDTH WIDTHOVERHEAD)
+                                 (IDIFFERENCE SCREENHEIGHT HEIGHTOVERHEAD)))
+                   (IMAGESTREAM _ (CL:IF (\TEDIT.PRIMARYPANE
 TSTREAM)
+                                      (WINDOWPROP (\TEDIT.PRIMARYPANE
 TSTREAM)
+                                             'DSP)
+                                      (DSPCREATE)))
+                   (W _ 0)
+                   (H _ 0)
+                   (CHNO _ 1) from
 1 to
 20 while
 (ILESSP CHNO TEXTLEN)
+                 do
 
+                    (* ;; 
 
            "But we start by saying that the right margin is infinite, so we can find the true width")

 
-                   (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO NIL REG))
-                   (SETQ CHNO (FGETLD L LCHARLIM))
-                   (add
 H (FGETLD L LHEIGHT))
-                   (CL:UNLESS WIDTH
-                       (CL:WHEN (EQ 'LEFT (FGETPLOOKS (FGETLD L LPARALOOKS)
-                                                 QUAD))
+                    (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO NIL REG IMAGESTREAM))
+                    (SETQ CHNO (FGETLD L LCHARLIM))
+                    (add
 H (FGETLD L LHEIGHT))
+                    (CL:UNLESS WIDTH
+                        (CL:WHEN (EQ 'LEFT (FGETPLOOKS (FGETLD L LPARALOOKS)
+                                                  QUAD))
 
-                           (* ;; 
-
                           "JUSTIFIED, RIGHT and CENTERED involve right margin, which we don't know")

+                            (* ;; 
+
                            "JUSTIFIED, RIGHT and CENTERED involve right margin, which we don't know")

 
-                           (SETQ W (IMAX W (FGETLD L LXLIM)))))
-                finally
 (CL:UNLESS (OR WIDTH (EQ W 0))       (* ; "Maybe no lefts?")

-                            (SETQ WIDTH W))
-                      (CL:UNLESS (OR HEIGHT (EQ H 0))
-                             (SETQ HEIGHT H))))
+                            (SETQ W (IMAX W (FGETLD L LXLIM)))))
+                 finally
 (CL:UNLESS (OR WIDTH (EQ W 0))      (* ; "Maybe no lefts?")

+                             (SETQ WIDTH W))
+                       (CL:UNLESS (OR HEIGHT (EQ H 0))
+                              (SETQ HEIGHT H))))
 
-         (* ;; "Minimum sizes")

+          (* ;; "Minimum sizes:  90 characters by 10 lines")

 
-         (SETQ WIDTH (IMAX 200 (OR WIDTH 0)))
-         (SETQ HEIGHT (IMAX 100 (OR HEIGHT 0)))
+          (CL:UNLESS WIDTH
+              [SETQ WIDTH (TIMES 80 (FONTPROP TSTREAM 'AVGCHARWIDTH])
+          (CL:UNLESS HEIGHT
+              [SETQ HEIGHT (TIMES 10 (FONTPROP TSTREAM 'HEIGHT])
 
-         (* ;; "Allow for the extra stuff")

+          (* ;; "Allow for the extra stuff")

 
-         (add
 WIDTH WIDTHOVERHEAD)
-         (add
 HEIGHT HEIGHTOVERHEAD)
-         (if
 (GRAB-TYPED-REGION REGIONTYPE WIDTH HEIGHT 1.1)
-           else
 
-                (* ;; "Maximum new sizes")

+          (add
 WIDTH WIDTHOVERHEAD)
+          (add
 HEIGHT HEIGHTOVERHEAD)
+          (if
 (GRAB-TYPED-REGION REGIONTYPE WIDTH HEIGHT 1.1)
+            else
 
+                 (* ;; "Maximum new sizes")

 
-                [SETQ WIDTH (IMIN WIDTH (FIXR (FTIMES SCREENWIDTH 0.9]
-                [SETQ HEIGHT (IMIN HEIGHT (FIXR (FTIMES SCREENHEIGHT 0.9]
-                (CLRPROMPT)                                  (* ; "System promptwindow")

-                (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
-                       " region")
-                (CL:WHEN (TXTFILE TSTREAM)
-                    (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
-                (TERPRI PROMPTWINDOW)
-                (GETBOXREGION WIDTH HEIGHT])
+                 [SETQ WIDTH (IMIN WIDTH (FIXR (FTIMES SCREENWIDTH 0.9]
+                 [SETQ HEIGHT (IMIN HEIGHT (FIXR (FTIMES SCREENHEIGHT 0.9]
+                 (CLRPROMPT)                                 (* ; "System promptwindow")

+                 (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
+                        " region")
+                 (CL:WHEN (TXTFILE TSTREAM)
+                     (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
+                 (TERPRI PROMPTWINDOW)
+                 (GETBOXREGION WIDTH HEIGHT])
 
 (\TEDIT.WINDOW.SETUP

-  [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1)
              (* ; "Edited  6-May-2025 11:44 by rmk")


+  [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1)
              (* ; "Edited 15-Jan-2026 10:35 by rmk")


+                                                             (* ; "Edited  6-May-2025 11:44 by rmk")


                                                              (* ; "Edited 21-Apr-2025 12:02 by rmk")


                                                              (* ; "Edited  6-Apr-2025 18:56 by rmk")


                                                              (* ; "Edited  5-Apr-2025 14:07 by rmk")


@@ -595,11 +605,12 @@
           (\TEDIT.CLEARPANE
 PANE)
           (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM (\TEDIT.LINES.BELOW NIL PANE TSTREAM))
           (CL:WHEN AFTERPANE
-              (for
 PANE inpanes
 (PROGN TEXTOBJ) as
 L1 on
 (GETSEL SEL L1) as
 LN
-                 on
 (GETSEL SEL LN) when
 (EQ PANE AFTERPANE) do
 (push
 (CDR L1)
-                                                                      NIL)
-                                                                (push
 (CDR LN)
-                                                                      NIL)))
+              (for
 P inpanes
 (PROGN TEXTOBJ) as
 L1 on
 (GETSEL SEL L1) as
 LN
+                 on
 (GETSEL SEL LN) when
 (EQ P AFTERPANE) do
 (push
 (CDR L1)
+                                                                   NIL)
+                                                             (push
 (CDR LN)
+                                                                   NIL))
+              (WINDOWPROP PANE 'PROMPTWINDOW (WINDOWPROP AFTERPANE 'PROMPTWINDOW)))
           (FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY)))
           (\TEDIT.FIXSEL SEL TSTREAM (AND AFTERPANE PANE))   (* ; 
 
                                       "If not fixed, the highlight in the lower pane will disappear")

@@ -775,7 +786,8 @@
 (DEFINEQ
 
 (\TEDIT.CURSORMOVEDFN

-  [LAMBDA (PANE)
                                             (* ; "Edited 27-Apr-2025 23:43 by rmk")


+  [LAMBDA (PANE)
                                             (* ; "Edited 14-Jan-2026 00:42 by rmk")


+                                                             (* ; "Edited 27-Apr-2025 23:43 by rmk")


                                                              (* ; "Edited 24-Apr-2025 10:35 by rmk")


                                                              (* ; "Edited 19-Apr-2025 22:22 by rmk")


                                                              (* ; "Edited  1-Dec-2024 11:55 by rmk")


@@ -792,71 +804,68 @@
 
     (CL:WHEN (fetch
 (TEXTWINDOW WTEXTSTREAM) of
 (OR (WINDOWP PANE)
                                                     (PANEWINDOW PANE)))
-        [PROG ((X (LASTMOUSEX PANE))
-               (Y (LASTMOUSEY PANE))
-               (TEXTOBJ (PANETEXTOBJ PANE))
-               (CURSORREG (fetch
 (TEXTWINDOW CURSORREGION) of
 (PANEWINDOW PANE)))
-               LINE LEFT)
-              (CL:UNLESS (INSIDE? (PANEREGION PANE)
-                                X Y)
-                  (CURSOR T)
-                  (RETURN))
-              (CL:UNLESS (INSIDE? CURSORREG X Y)
-                  [if
 [AND (IGEQ X (SETQ LEFT (IDIFFERENCE (PANERIGHT PANE)
-                                                     \TEDIT.OP.WIDTH)))
-                           (IGEQ Y (IPLUS (PANEBOTTOM PANE)
-                                          \TEDIT.OP.BOTTOM))
-                           (NOT (OR (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
-                                    (EQ \TEDIT.OP.WIDTH -1]
-                      then
 
-                           (* ;; "We're in the split region on the right")

+        [LET ((X (LASTMOUSEX PANE))
+              (Y (LASTMOUSEY PANE))
+              (TEXTOBJ (PANETEXTOBJ PANE))
+              (CURSORREG (fetch
 (TEXTWINDOW CURSORREGION) of
 (PANEWINDOW PANE)))
+              LINE LEFT)
+             (CL:UNLESS (INSIDE? CURSORREG X Y)
+                 [if
 [AND (IGEQ X (SETQ LEFT (IDIFFERENCE (PANERIGHT PANE)
+                                                    \TEDIT.OP.WIDTH)))
+                          (IGEQ Y (IPLUS (PANEBOTTOM PANE)
+                                         \TEDIT.OP.BOTTOM))
+                          (NOT (OR (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
+                                   (EQ \TEDIT.OP.WIDTH -1]
+                     then
 
+                          (* ;; "We're in the split region on the right")

 
-                           (CURSOR \TEDIT.SPLITCURSOR)
-                           (FSETTOBJ TEXTOBJ MOUSEREGION 'PANE) 
+                          (CURSOR \TEDIT.SPLITCURSOR)
+                          (FSETTOBJ TEXTOBJ MOUSEREGION 'PANE) 
                                                              (* ; 
 
                                    "PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.")

-                           (replace
 (REGION LEFT) of
 CURSORREG with
 LEFT)
-                           (replace
 (REGION WIDTH) of
 CURSORREG with
 \TEDIT.OP.WIDTH)
-                    else
 
-                         (* ;; "Not in the split region.  Are we in the line-select region on the left?  Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR")

+                          (replace
 (REGION LEFT) of
 CURSORREG with
 LEFT)
+                          (replace
 (REGION WIDTH) of
 CURSORREG with
 \TEDIT.OP.WIDTH)
+                   else
 
+                        (* ;; "Not in the split region.  Are we in the line-select region on the left?  Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR")

 
-                         (SETQ LINE (find
 L inlines
 (GETPANEPROP (PANEPROPS PANE)
-                                                           PREFIXLINE)
-                                       suchthat
 (ILEQ (FGETLD L YBOT)
-                                                      Y)))
-                         (CL:WHEN LINE                       (* ; 
+                        (SETQ LINE (find
 L inlines
 (GETPANEPROP (PANEPROPS PANE)
+                                                          PREFIXLINE)
+                                      suchthat
 (ILEQ (FGETLD L YBOT)
+                                                     Y)))
+                        (CL:WHEN LINE                        (* ; 
 
                                                             "The CURSORREGION picks out just LINE")

-                             (replace
 BOTTOM of
 CURSORREG with
 (FGETLD LINE YBOT))
-                             (replace
 HEIGHT of
 CURSORREG with
 (FGETLD LINE LHEIGHT))) 
+                            (replace
 BOTTOM of
 CURSORREG with
 (FGETLD LINE YBOT))
+                            (replace
 HEIGHT of
 CURSORREG with
 (FGETLD LINE LHEIGHT))) 
 
-                         (* ;; "The line region gets wider if the paragraph is indented")

+                        (* ;; "The line region gets wider if the paragraph is indented")

 
-                         (SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN))
-                                        (IPLUS (PANELEFT PANE)
-                                               \TEDIT.LINEREGION.WIDTH)))
-                         (if
 (ILESSP X LEFT)
-                             then
 
-                                  (* ;; "In left margin;  switch to the line-select cursor")

+                        (SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN))
+                                       (IPLUS (PANELEFT PANE)
+                                              \TEDIT.LINEREGION.WIDTH)))
+                        (if
 (ILESSP X LEFT)
+                            then
 
+                                 (* ;; "In left margin;  switch to the line-select cursor")

 
-                                  (CURSOR \TEDIT.LINECURSOR)
-                                  (FSETTOBJ TEXTOBJ MOUSEREGION 'LINE)
-                                  (replace
 (REGION LEFT) of
 CURSORREG with
 0)
-                                  (replace
 (REGION WIDTH) of
 CURSORREG with
 LEFT)
-                           else
 
-                                (* ;; 
+                                 (CURSOR \TEDIT.LINECURSOR)
+                                 (FSETTOBJ TEXTOBJ MOUSEREGION 'LINE)
+                                 (replace
 (REGION LEFT) of
 CURSORREG with
 0)
+                                 (replace
 (REGION WIDTH) of
 CURSORREG with
 LEFT)
+                          else
 
+                               (* ;; 
 
                    "Not in the line-select region, not in the split region, must be the main text. ")

 
-                                (CURSOR T)
-                                (FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT)
-                                (replace
 (REGION LEFT) of
 CURSORREG with
 LEFT)
-                                (replace
 (REGION WIDTH) of
 CURSORREG with
 (IDIFFERENCE (PANERIGHT
-                                                                                        PANE)
-                                                                                 (IPLUS LEFT 
+                               (CURSOR T)
+                               (FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT)
+                               (replace
 (REGION LEFT) of
 CURSORREG with
 LEFT)
+                               (replace
 (REGION WIDTH) of
 CURSORREG with
 (IDIFFERENCE (PANERIGHT
+                                                                                       PANE)
+                                                                                (IPLUS LEFT 
                                                                               \TEDIT.LINEREGION.WIDTH
-                                                                                        ])])])
+                                                                                       ])])])
 
 (\TEDIT.CURSOROUTFN

-  [LAMBDA (PANE)
                                             (* ; "Edited  4-May-2025 14:27 by rmk")


+  [LAMBDA (PANE)
                                             (* ; "Edited 10-Jan-2026 22:49 by rmk")


+                                                             (* ; "Edited  4-May-2025 14:27 by rmk")


                                                              (* ; "Edited 20-Jul-2023 20:32 by rmk")


                                                              (* ; "Edited 30-May-91 23:32 by jds")

 
@@ -1147,7 +1156,9 @@
 (DEFINEQ
 
 (\TEDIT.BUTTONEVENTFN

-  [LAMBDA (PANE)
                                             (* ; "Edited  6-May-2025 20:35 by rmk")


+  [LAMBDA (PANE)
                                             (* ; "Edited 15-Jan-2026 00:39 by rmk")


+                                                             (* ; "Edited 11-Jan-2026 08:30 by rmk")


+                                                             (* ; "Edited  6-May-2025 20:35 by rmk")


                                                              (* ; "Edited 21-Apr-2025 20:19 by rmk")


                                                              (* ; "Edited 13-Apr-2025 13:33 by rmk")


                                                              (* ; "Edited  6-Apr-2025 18:59 by rmk")


@@ -1187,7 +1198,7 @@
                   (OLDX _ MIN.SMALLP)
                   (OLDY _ MIN.SMALLP)
                   (PREG _ (PANEREGION PANE))
-                  TEXTOBJ CURSEL NEWSEL CUROPERATION NEWOPERATION PENDINGDEL READONLY
+                  TEXTOBJ CURSEL NEWSEL CUROPERATION NEWOPERATION PENDINGDEL READONLY SECSEL
                declare
 (SPECVARS CURSEL) first
 
 
                                       (* ;; "Pick off and return from a bunch of peripheral situations, then fall through to the complexities of normal text selection.")

@@ -1215,13 +1226,34 @@
                                                (* ;; "")

 
                                                (SETQ READONLY (FGETTOBJ TEXTOBJ TXTREADONLY))
-                                               (SETQ CUROPERATION 'NORMAL)
                                                (SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION

-                                                                   READONLY NIL))
-                                               (CL:UNLESS (SETQ CURSEL (
+                                                                   READONLY NIL)) 
+
+                                               (* ;; "")

+
+                                               (if
 (SETQ CURSEL (FGETTOBJ TEXTOBJ SECONDARYSEL))
+                                                   then
      (* ; 
+
                                                       "Mouse moved out and came back...and clicked.")

+                                                        (SETQ CUROPERATION (FGETSEL CURSEL 
+                                                                                  SELOPERATION))
+                                                        (SETQ PENDINGDEL (EQ CUROPERATION
+                                                                             'PENDINGDEL))
+                                                        (CL:UNLESS (EQ NEWOPERATION CUROPERATION)
+                                                             (* ; 
+
                                                    "Shift keys have changed, turn off old secondary")

+                                                            (\TEDIT.SEL.OFF TSTREAM CURSEL))
+                                                        (CL:WHEN (EQ NEWOPERATION 'NORMAL)
+                                                             (* ; "")

+                                                            (CL:UNLESS (SETQ CURSEL (
 
                                                                     \TEDIT.BUTTONEVENTFN.CURSEL.INIT

-                                                                        NEWOPERATION TSTREAM))
-                                                      (RETURN))
+                                                                                     NEWOPERATION 
+                                                                                     TSTREAM))
+                                                                   (RETURN)))
+                                                 elseif
 (SETQ CURSEL (
+
                                                                     \TEDIT.BUTTONEVENTFN.CURSEL.INIT

+                                                                      NEWOPERATION TSTREAM))
+                                                   then
 (SETQ CUROPERATION 'NORMAL)
+                                                 else
 (RETURN))
                                                (SETQ NEWSEL (\TEDIT.COPYSEL CURSEL)) 
                                                              (* ; 
 
                                                      "Gets line-chains and consistent initial looks")

@@ -1230,35 +1262,27 @@
                      (GETMOUSESTATE)                         (* ; 
 
                                                             "And get the new mouse and key info")

                      (\TEDIT.CURSORMOVEDFN
 PANE)
-                     (SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION
 READONLY CUROPERATION)) 
+                     (SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION
 READONLY CUROPERATION))
+                     (FSETTOBJ TEXTOBJ SECONDARYSEL CURSEL) 
 
                      (* ;; "We're done if keys and buttons are up")

  until
 (AND (EQ NEWOPERATION 'NORMAL)
             (ALLBUTTONSUP)) unless
 (AND (IEQP OLDX (SETQ X (LASTMOUSEX DS)))
                                         (IEQP OLDY (SETQ Y (LASTMOUSEY DS)))
                                         (EQ CUROPERATION NEWOPERATION))
-               do
 
+               do
 (CL:UNLESS (INSIDEP (PANEREGION PANE PREG)
+                                    X Y)                     (* ; 
+
                                                     "Left the window, stay in the loop if scrolling")

+                      (CL:UNLESS (IN/SCROLL/BAR? PANE LASTMOUSEX LASTMOUSEY)
+                             (RETURN))
+                      (SCROLL.HANDLER PANE)) 
+
+                  (* ;; "")

+
                   (* ;; "Polling loop, track the mouse until the buttons and modifier keys come up, i.e. NORMAL Nothing to do until the mouse moves or the operation changes. .")

 
                   (* ;; "First and always: CURSEL is ON at this point and matches the display. NEWSEL may not be well-defined.")

 
-                  (CL:UNLESS (INSIDEP (PANEREGION PANE PREG)
-                                    X Y)                     (* ; 
-
                                                    "The mouse left the window: cleanup and leave.  ")

-                      (CL:UNLESS (EQ CUROPERATION 'NORMAL)   (* ; 
-
                                                      "Take down the copy/delete/copylooks highlight")

-                          (\TEDIT.SEL.OFF TSTREAM CURSEL)
-                          (\TEDIT.SEL.ON TSTREAM))           (* ; "Go back to original selection?")

-
-                      (* ;; 
-
                    "Scroll if mouse moved to scroll bar (and scroll bar doesn't overlap the window)")

-
-                      (CL:WHEN (IN/SCROLL/BAR? PANE LASTMOUSEX LASTMOUSEY)
-                             (SCROLL.HANDLER PANE))
-                      (RETURN)) 
-
-                  (* ;; "")

-
                   (* ;; "Ready to track the selection.")

 
                   (SETQ OLDX X)
@@ -1322,9 +1346,12 @@
 
        (* ;; "Out of Polling loop")

 
+       (SETTOBJ (FTEXTOBJ TSTREAM)
+              SECONDARYSEL NIL)                              (* ; 
+
                                                     "All keys are up, secondary selection is closed")

        (CL:UNLESS (FGETSEL NEWSEL SET)
 
-           (* ;; ".Here to restore when no valid selection, maybe an unhappy image object?")

+           (* ;; "Here to restore when no valid selection, maybe an unhappy image object?")

 
            (\TEDIT.SEL.OFF TSTREAM CURSEL)                   (* ; "Turn off CURSEL")

            (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ)
@@ -1335,6 +1362,8 @@
 
 (\TEDIT.BUTTONEVENTFN.DOOPERATION

   [LAMBDA (CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC)

+                                                             (* ; "Edited 31-Jan-2026 11:51 by rmk")


+                                                             (* ; "Edited  9-Jan-2026 11:28 by rmk")


                                                              (* ; "Edited  6-May-2025 11:54 by rmk")


                                                              (* ; "Edited 27-Apr-2025 22:26 by rmk")


                                                              (* ; "Edited 21-Apr-2025 20:32 by rmk")


@@ -1388,14 +1417,14 @@
 
                                "Make sure the caret blinks in the position of a successful deletion")

                               (FSETSEL TEXTSEL HASCARET T))
                           (\TEDIT.SETCARET
 TEXTSEL PANE TEXTOBJ T))
-                  (COPY (CL:IF TTYSEL
+                  (COPY (\TEDIT.SEL.OFF TSTREAM CURSEL)
+                        (CL:IF TTYSEL
                             (\TEDIT.COPY CURSEL TTYSEL TSTREAM TTYSTREAM)
-                            (\TEDIT.FOREIGN.COPY
 TTYW CURSEL TSTREAM))
-                        (\TEDIT.SEL.OFF TSTREAM CURSEL))
+                            (\TEDIT.FOREIGN.COPY
 CURSEL TSTREAM)))
                   (MOVE (\TEDIT.SEL.OFF TSTREAM CURSEL)
                         (if
 TTYSEL
                             then
 (\TEDIT.MOVE CURSEL TTYSEL TSTREAM TTYSTREAM)
-                          else
 (\TEDIT.FOREIGN.COPY
 TTYW CURSEL TSTREAM) 
+                          else
 (\TEDIT.FOREIGN.COPY
 CURSEL TSTREAM) 
                                                              (* ; "TEXTSEL moves to deletion point")

                                (\TEDIT.UPDATE.SEL TEXTSEL (FGETSEL CURSEL CH#)
                                       0
@@ -1618,7 +1647,8 @@
                                         then
 (TEDIT.INSERT TSTREAM I])
 
 (\TEDIT.FOREIGN.COPY

-  [LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP)
            (* ; "Edited 28-Mar-2025 12:51 by rmk")


+  [LAMBDA (SOURCESEL SOURCESTREAM BKSYSBUFP)
                 (* ; "Edited 31-Jan-2026 09:20 by rmk")


+                                                             (* ; "Edited 28-Mar-2025 12:51 by rmk")


                                                              (* ; "Edited 27-Aug-2024 13:38 by rmk")


                                                              (* ; "Edited  7-Jul-2024 09:26 by rmk")


                                                              (* ; "Edited 29-Apr-2024 13:37 by rmk")


@@ -1630,7 +1660,8 @@
     (CL:WHEN (IGREATERP (GETSEL SOURCESEL DCH)
                     0)                                       (* ; "If empty, nothing to do")

         [if
 (AND NIL (NOT BKSYSBUFP)
-                 (WINDOWPROP TTYW 'COPYINSERTFN))
+                 (PROCESSPROP (TTY.PROCESS)
+                        'WINDOW))
             then
 
                  (* ;; "This is a stub for a definition that knows how to do a looked string object, given that the destination TTY window has a COPYINSERTFN.  OBJECTFROMSEL is in {LFG}tedit/UNBREAKABLESTRING")

 
@@ -2060,7 +2091,8 @@
            PROMPTWINDOW])
 
 (TEDIT.PROMPTPRINT

-  [LAMBDA (TSTREAM MSG CLEAR? FLASH?)
                        (* ; "Edited 14-Dec-2025 17:41 by rmk")


+  [LAMBDA (TSTREAM MSG CLEAR? FLASH?)
                        (* ; "Edited  7-Feb-2026 18:51 by rmk")


+                                                             (* ; "Edited 14-Dec-2025 17:41 by rmk")


                                                              (* ; "Edited 29-Dec-2024 14:45 by rmk")


                                                              (* ; "Edited 26-Nov-2023 10:10 by rmk")


                                                              (* ; "Edited 10-Sep-2023 00:27 by rmk")


@@ -2072,31 +2104,33 @@
 
     (* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow).  Optionally clear the window first.")

 
-    (LET ((TEXTOBJ (TEXTOBJ TSTREAM T))
-          PWINDOW MAINWINDOW)
-         (if
 TEXTOBJ
-             then
 (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW
 TEXTOBJ))
-                      [SETQ PWINDOW
-                       (CAR (NLSETQ (SELECTQ PWINDOW
-                                        (DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
-                                                      (GETPROMPTWINDOW MAINWINDOW)))
-                                        (NIL (CL:WHEN TSTREAM
-                                                 [GETPROMPTWINDOW MAINWINDOW NIL NIL
-                                                        (NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]))
-                                        PWINDOW])            (* ; 
+    (PROG ((TEXTOBJ (TEXTOBJ TSTREAM T))
+           PWINDOW MAINWINDOW)
+          (CL:UNLESS TEXTOBJ
+              (PROMPTPRINT MSG)
+              (RETURN))
+          (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW
 TSTREAM))
+              (SETQ PWINDOW (FGETTOBJ TEXTOBJ PROMPTWINDOW))
+              [SETQ PWINDOW (CAR (NLSETQ (SELECTQ PWINDOW
+                                             (DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
+                                                           (GETPROMPTWINDOW MAINWINDOW)))
+                                             (NIL (CL:WHEN TSTREAM
+                                                      [GETPROMPTWINDOW MAINWINDOW NIL NIL
+                                                             (NOT (GETTEXTPROP TEXTOBJ 
+                                                                         'PWINDOW.ON.DEMAND]))
+                                             PWINDOW])       (* ; 
 
                                              "Try to find an editor's prompt window for our message")

-                  (COND
-                     ((WINDOWP PWINDOW)                      (* ; 
+          (if
 (WINDOWP PWINDOW)
+              then
                                           (* ; 
 
                                                      "We found a window to use.  Print the message.")

-                      (CL:WHEN CLEAR? (CLEARW PWINDOW))
-                      (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
-                      (PRIN1 MSG PWINDOW))
-                     (T                                      (* ; 
+                   (CL:WHEN CLEAR? (CLEARW PWINDOW))
+                   (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
+                   (PRIN1 MSG PWINDOW)
+            else
                                             (* ; 
 
                                                         "Failing all else, use global PROMPTWINDOW.")

-                        (FRESHLINE PROMPTWINDOW)
-                        (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
-                        (printout PROMPTWINDOW MSG)))
-           else
 (PROMPTPRINT MSG])
+                 (FRESHLINE PROMPTWINDOW)
+                 (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
+                 (printout PROMPTWINDOW MSG])
 
 (TEDIT.PROMPTCLEAR

   [LAMBDA (TSTREAM FONT)
                                     (* ; "Edited 14-Dec-2025 17:34 by rmk")


@@ -3664,36 +3698,36 @@
 (RPAQ? TEDIT.TITLED.ICON.TEMPLATE
 (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ 
                                          TEDIT.ICON.TITLE.REGION))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17143 18039 (TEDIT.DEFER.UPDATES 17153 . 18037)) (18040 45281 (\TEDIT.WINDOW.CREATE 
-18050 . 24913) (\TEDIT.WINDOW.GETREGION 24915 . 29619) (\TEDIT.WINDOW.SETUP 29621 . 33951) (
-\TEDIT.MINIMAL.WINDOW.SETUP 33953 . 41913) (\TEDIT.CLEARPANE 41915 . 42632) (\TEDIT.FILL.PANES 42634
- . 45279)) (45282 68983 (\TEDIT.CURSORMOVEDFN 45292 . 50902) (\TEDIT.CURSOROUTFN 50904 . 51592) (
-\TEDIT.ACTIVE.WINDOWP 51594 . 52664) (\TEDIT.EXPANDFN 52666 . 53229) (\TEDIT.MAINW 53231 . 54511) (
-\TEDIT.MAINSTREAM 54513 . 54847) (\TEDIT.PRIMARYPANE 54849 . 55619) (\TEDIT.PANELIST 55621 . 56117) (
-\TEDIT.NEWREGIONFN 56119 . 58635) (\TEDIT.SET.WINDOW.EXTENT 58637 . 63619) (\TEDIT.SHRINK.ICONCREATE 
-63621 . 66354) (\TEDIT.SHRINKFN 66356 . 66765) (\TEDIT.PANEREGION 66767 . 68981)) (69015 102061 (
-\TEDIT.BUTTONEVENTFN 69025 . 81998) (\TEDIT.BUTTONEVENTFN.DOOPERATION 82000 . 89263) (
-\TEDIT.BUTTONEVENTFN.GETOPERATION 89265 . 91107) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 91109 . 94779) (
-\TEDIT.BUTTONEVENTFN.INACTIVE 94781 . 97211) (\TEDIT.BUTTONEVENTFN.INTITLE 97213 . 99048) (
-\TEDIT.COPYINSERTFN 99050 . 100182) (\TEDIT.FOREIGN.COPY 100184 . 102059)) (102062 119625 (
-\TEDIT.PANE.SPLIT 102072 . 106020) (\TEDIT.SPLITW 106022 . 114081) (\TEDIT.UNSPLITW 114083 . 118282) (
-\TEDIT.LINKPANES 118284 . 119047) (\TEDIT.UNLINKPANE 119049 . 119623)) (121059 121950 (TEDITWINDOWP 
-121069 . 121948)) (121987 125090 (TEDIT.GETINPUT 121997 . 124440) (\TEDIT.MAKEFILENAME 124442 . 125088
-)) (125139 132985 (TEDIT.PROMPTWINDOW 125149 . 125463) (TEDIT.PROMPTPRINT 125465 . 128195) (
-TEDIT.PROMPTCLEAR 128197 . 130032) (TEDIT.PROMPTFLASH 130034 . 131292) (\TEDIT.PROMPT.PAGEFULLFN 
-131294 . 132983)) (133223 143801 (\TEDIT.FILENAME 133233 . 134005) (\TEDIT.DEFAULT.TITLE 134007 . 
-136386) (\TEDIT.WINDOW.TITLE 136388 . 138557) (\TEDIT.LIKELY.FILENAME 138559 . 141283) (
-\TEDIT.UPDATE.TITLE 141285 . 143799)) (143844 156328 (TEDIT.DEACTIVATE.WINDOW 143854 . 149427) (
-\TEDIT.RESHAPEFN 149429 . 151514) (\TEDIT.REPAINTFN 151516 . 151740) (\TEDIT.CLOSESPLITS 151742 . 
-154187) (\TEDIT.CLOSEPANE 154189 . 156326)) (156329 199128 (\TEDIT.SCROLLFN 156339 . 158570) (
-\TEDIT.SCROLLCH.TOP 158572 . 160683) (\TEDIT.SCROLLCH.BOTTOM 160685 . 165015) (\TEDIT.SCROLLUP 165017
- . 170743) (\TEDIT.TOPLINE.YTOP 170745 . 172414) (\TEDIT.SCROLLDOWN 172416 . 179455) (
-\TEDIT.SCROLL.CARET 179457 . 182295) (\TEDIT.VISIBLECARETP 182297 . 184591) (\TEDIT.VISIBLECHARP 
-184593 . 185684) (\TEDIT.BITMAPLINES 185686 . 189606) (\TEDIT.SETPANE.TOPLINE 189608 . 190220) (
-\TEDIT.SHIFTLINES 190222 . 199126)) (199129 209998 (\TEDIT.ONSCREEN? 199139 . 203690) (
-\TEDIT.ONSCREEN.REGION 203692 . 207343) (\TEDIT.AFTERMOVEFN 207345 . 208242) (OFFSCREENP 208244 . 
-209996)) (210040 212854 (\TEDIT.PROCIDLEFN 210050 . 211710) (\TEDIT.PROCENTRYFN 211712 . 212157) (
-\TEDIT.PROCEXITFN 212159 . 212852)) (212933 226158 (\TEDIT.DOWNCARET 212943 . 213736) (
-\TEDIT.FLASHCARET 213738 . 215849) (\TEDIT.UPCARET 215851 . 216955) (TEDIT.NORMALIZECARET 216957 . 
-220175) (\TEDIT.SETCARET 220177 . 225528) (\TEDIT.CARET 225530 . 226156)))))
+  (FILEMAP (NIL (17097 17993 (TEDIT.DEFER.UPDATES 17107 . 17991)) (17994 46195 (\TEDIT.WINDOW.CREATE 
+18004 . 24867) (\TEDIT.WINDOW.GETREGION 24869 . 30356) (\TEDIT.WINDOW.SETUP 30358 . 34865) (
+\TEDIT.MINIMAL.WINDOW.SETUP 34867 . 42827) (\TEDIT.CLEARPANE 42829 . 43546) (\TEDIT.FILL.PANES 43548
+ . 46193)) (46196 69923 (\TEDIT.CURSORMOVEDFN 46206 . 51733) (\TEDIT.CURSOROUTFN 51735 . 52532) (
+\TEDIT.ACTIVE.WINDOWP 52534 . 53604) (\TEDIT.EXPANDFN 53606 . 54169) (\TEDIT.MAINW 54171 . 55451) (
+\TEDIT.MAINSTREAM 55453 . 55787) (\TEDIT.PRIMARYPANE 55789 . 56559) (\TEDIT.PANELIST 56561 . 57057) (
+\TEDIT.NEWREGIONFN 57059 . 59575) (\TEDIT.SET.WINDOW.EXTENT 59577 . 64559) (\TEDIT.SHRINK.ICONCREATE 
+64561 . 67294) (\TEDIT.SHRINKFN 67296 . 67705) (\TEDIT.PANEREGION 67707 . 69921)) (69955 105080 (
+\TEDIT.BUTTONEVENTFN 69965 . 84672) (\TEDIT.BUTTONEVENTFN.DOOPERATION 84674 . 92145) (
+\TEDIT.BUTTONEVENTFN.GETOPERATION 92147 . 93989) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 93991 . 97661) (
+\TEDIT.BUTTONEVENTFN.INACTIVE 97663 . 100093) (\TEDIT.BUTTONEVENTFN.INTITLE 100095 . 101930) (
+\TEDIT.COPYINSERTFN 101932 . 103064) (\TEDIT.FOREIGN.COPY 103066 . 105078)) (105081 122644 (
+\TEDIT.PANE.SPLIT 105091 . 109039) (\TEDIT.SPLITW 109041 . 117100) (\TEDIT.UNSPLITW 117102 . 121301) (
+\TEDIT.LINKPANES 121303 . 122066) (\TEDIT.UNLINKPANE 122068 . 122642)) (124078 124969 (TEDITWINDOWP 
+124088 . 124967)) (125006 128109 (TEDIT.GETINPUT 125016 . 127459) (\TEDIT.MAKEFILENAME 127461 . 128107
+)) (128158 136241 (TEDIT.PROMPTWINDOW 128168 . 128482) (TEDIT.PROMPTPRINT 128484 . 131451) (
+TEDIT.PROMPTCLEAR 131453 . 133288) (TEDIT.PROMPTFLASH 133290 . 134548) (\TEDIT.PROMPT.PAGEFULLFN 
+134550 . 136239)) (136479 147057 (\TEDIT.FILENAME 136489 . 137261) (\TEDIT.DEFAULT.TITLE 137263 . 
+139642) (\TEDIT.WINDOW.TITLE 139644 . 141813) (\TEDIT.LIKELY.FILENAME 141815 . 144539) (
+\TEDIT.UPDATE.TITLE 144541 . 147055)) (147100 159584 (TEDIT.DEACTIVATE.WINDOW 147110 . 152683) (
+\TEDIT.RESHAPEFN 152685 . 154770) (\TEDIT.REPAINTFN 154772 . 154996) (\TEDIT.CLOSESPLITS 154998 . 
+157443) (\TEDIT.CLOSEPANE 157445 . 159582)) (159585 202384 (\TEDIT.SCROLLFN 159595 . 161826) (
+\TEDIT.SCROLLCH.TOP 161828 . 163939) (\TEDIT.SCROLLCH.BOTTOM 163941 . 168271) (\TEDIT.SCROLLUP 168273
+ . 173999) (\TEDIT.TOPLINE.YTOP 174001 . 175670) (\TEDIT.SCROLLDOWN 175672 . 182711) (
+\TEDIT.SCROLL.CARET 182713 . 185551) (\TEDIT.VISIBLECARETP 185553 . 187847) (\TEDIT.VISIBLECHARP 
+187849 . 188940) (\TEDIT.BITMAPLINES 188942 . 192862) (\TEDIT.SETPANE.TOPLINE 192864 . 193476) (
+\TEDIT.SHIFTLINES 193478 . 202382)) (202385 213254 (\TEDIT.ONSCREEN? 202395 . 206946) (
+\TEDIT.ONSCREEN.REGION 206948 . 210599) (\TEDIT.AFTERMOVEFN 210601 . 211498) (OFFSCREENP 211500 . 
+213252)) (213296 216110 (\TEDIT.PROCIDLEFN 213306 . 214966) (\TEDIT.PROCENTRYFN 214968 . 215413) (
+\TEDIT.PROCEXITFN 215415 . 216108)) (216189 229414 (\TEDIT.DOWNCARET 216199 . 216992) (
+\TEDIT.FLASHCARET 216994 . 219105) (\TEDIT.UPCARET 219107 . 220211) (TEDIT.NORMALIZECARET 220213 . 
+223431) (\TEDIT.SETCARET 223433 . 228784) (\TEDIT.CARET 228786 . 229412)))))
 STOP

library/tedit/tedit-exports.all

@@ -1,11 +1,10 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "16-Feb-2026 08:56:58" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;249
 52790  
+
(FILECREATED " 1-May-2026 08:16:04" {MEDLEY}<library>tedit>tedit-exports.all;255
 52514  
 
       :EDIT-BY rmk
 
-      :PREVIOUS-DATE "14-Jan-2026 14:50:53" {WMEDLEY}<library>TEDIT>tedit-exports.all;248)
+      :PREVIOUS-DATE "15-Apr-2026 23:45:28" {MEDLEY}<library>TEDIT>tedit-exports.all;254)
 
 
 (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION 
@@ -17,7 +16,7 @@ PRINT))))))))
 (PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
 (GLOBALVARS CHECK-TEDIT-ASSERTIONS)
 (RPAQ? CHECK-TEDIT-ASSERTIONS T)
-(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 4-Feb-2026 16:02:02"))
+(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "10-Mar-2026 18:07:31"))
 (RPAQQ \BTREEWORDSPERSLOT 4)
 (RPAQQ \BTREEMAXCOUNT 8)
 (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -51,7 +50,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
  (\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
 (I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE))) 
 by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
-(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "14-Feb-2026 13:22:06"))
+(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2026 17:25:38"))
 (DATATYPE SELECTION ((* ;; 
 "Description of a piece of selected text for TEdit.  Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
 ) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;; 
@@ -128,7 +127,7 @@ TSTREAM ONLYPANE DONTFIX)))
 (PUTPROPS \TEDIT.SEL.OFF MACRO ((TSTREAM SEL ONLYPANE) (* ; 
 "Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL 
 TSTREAM ONLYPANE)))
-(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:38:33"))
+(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "16-Apr-2026 09:27:41"))
 (RECORD TAB (TABX . TABKIND))
 (RECORD TABSPEC (DEFAULTTAB . TABS))
 (DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ; 
@@ -263,21 +262,22 @@ $$CHARSLOTLIMIT))))) T)
 (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") 
-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.") (
+) (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") (PBINABLE FLAG) (* ; "8-bit bytes are binable (THINSTRING and THINFILE) ") (PTREENODE
- XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ; 
-"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ; 
-"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (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 PBYTELEN _ 0)
+* ; "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 (* ; 
@@ -376,13 +376,12 @@ IMAGEDATA _ NIL)))
 (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 PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) 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 ((PC) (ffetch (PIECE PBYTELEN) 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 PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC)))
 (PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
 (PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
 (PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
@@ -391,7 +390,7 @@ IMAGEDATA _ NIL)))
 (PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
 (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 PUTF8BYTESPERCHAR))) NIL)))
+) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PBYTESPERCHAR))) NIL)))
 (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 (
@@ -411,14 +410,13 @@ VISIBLEPIECEP PPC))))
 (PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
 (PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR 
 TSTR TEXTOBJ)) TSTR)))
-(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (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 FATFILE1.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 FATFILE1.PTYPE))))
+(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))))
 (RPAQQ THINFILE.PTYPE 0)
-(RPAQQ FATFILE1.PTYPE 1)
 (RPAQQ FATFILE2.PTYPE 2)
 (RPAQQ THINSTRING.PTYPE 3)
 (RPAQQ FATSTRING.PTYPE 4)
@@ -428,20 +426,19 @@ THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTY
 (RPAQQ UTF16BE.PTYPE 8)
 (RPAQQ UTF16LE.PTYPE 9)
 (RPAQQ UTF8.PTYPE 11)
-(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE 
-UTF16LE.PTYPE))
+(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 FATFILE1.PTYPE))
-(CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (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 FATFILE1.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 FATFILE1.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)))
 (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
-(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 08:56:40"))
+(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE " 1-May-2026 08:15:56"))
 (PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;; 
 "Test to see if only the specified mouse button is down.  DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
 ) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
@@ -455,8 +452,8 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
 \BIN STREAM)) BITSPERWORD)))
 (PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
 LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
-(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "15-Feb-2026 23:45:51"))
-(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:10"))
+(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 23:49:14"))
+(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:29:21"))
 (DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") 
 (* ;; "NOTE:  If fields change EQCLOOKS should change too.") CLFONT (* ; 
 "The font descriptor for these characters") CLFONTUNPARSE (* ;; 
@@ -538,7 +535,7 @@ LINELEAD _ 0)
 (PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with 
 NEWVALUE)))
 (PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
-(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:36:00"))
+(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:34:11"))
 (PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:43"))
 (DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
  is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
@@ -602,8 +599,8 @@ GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROP
 $$OUT)))))
 (PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
 (PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2026 18:53:22"))
-(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "25-Jan-2026 09:14:04"))
-(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 9-Feb-2026 09:10:43"))
+(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 17:57:09"))
+(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 15:35:33"))
 (PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
 (RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
 :WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
@@ -626,7 +623,7 @@ TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVE
 (PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
 (PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with 
 NEWVALUE)))
-(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 1-Aug-2025 14:58:56"))
+(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2026 12:39:37"))
 (RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ; 
 "The current page number.  Counted from 1") FIRSTPAGE (* ;; 
 "T if the current page is the 'first page' .  Is set initially, and can be set again by the user at will.  Gets reset after each page image is printed."
@@ -662,8 +659,8 @@ $$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQU
 $$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
 (PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
 (PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Jan-2026 10:30:27"))
-(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "23-Jan-2026 15:49:26"))
-(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Jan-2026 12:15:57"))
+(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "30-Apr-2026 11:55:15"))
+(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:25:52"))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP

library/virtualkeyboards/KEYBOARDCONFIGS

@@ -1,10 +1,10 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT UTF-8)
 
-
(FILECREATED "13-Oct-2025 13:44:47" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;5
 59521  
+
(FILECREATED "19-Feb-2026 22:32:05" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;6
 59604  
 
       :EDIT-BY rmk
 
-      :PREVIOUS-DATE "13-Oct-2025 12:03:23" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;4)
+      :PREVIOUS-DATE "13-Oct-2025 13:44:47" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;5)
 
 
 (PRETTYCOMPRINT KEYBOARDCONFIGSCOMS)
@@ -57,11 +57,11 @@
         (F3 (F3 ITALIC))
         (F4 (F4 UCASE))
         (F5 (F5 STRIKE))
-        (F6 (F6 "­"))
+        (F6 (F6 "^"))
         (F7 (F7 SUBSCR))
         (F8 (F8 SMALL))
         (F9 (F9 MARGIN))
-        (F10 (F10 "¬"))
+        (F10 (F10 "_"))
         (F11 (F11 ""))
         (F12 (F12 ""))
         (LOCK ("CAPS" "LOCK"))
@@ -115,7 +115,7 @@
         (THREE (|3| %# NLS))
         (FOUR (|4| $ NLS))
         (FIVE (|5| %% NLS))
-        (SIX (|6| ^ NLS))
+        (SIX (|6| ↑ NLS))
         (SEVEN (|7| & NLS))
         (EIGHT (|8| * NLS))
         (NINE (|9| %( NLS))))
@@ -234,7 +234,7 @@
              NIL
              ((%" (%' %" NLS))
               (+ (= + NLS))
-              (- (- _ NLS))
+              (- (- ← NLS))
               (%: (; %: NLS))
               (< (%, < NLS))
               (> (%. > NLS))
@@ -255,13 +255,13 @@
               (NUMERIC/ (/ /))
               (NUMERIC0 (INS |0| NLS))
               (NUMERIC1 (END |1| NLS))
-              (NUMERIC2 (¯ |2| NLS))
+              (NUMERIC2 (↓ |2| NLS))
               (NUMERIC3 (PGDN |3| NLS))
-              (NUMERIC4 (¬ |4| NLS))
+              (NUMERIC4 (_ |4| NLS))
               (NUMERIC5 (|5| |5|))
-              (NUMERIC6 (® |6| NLS))
+              (NUMERIC6 (→ |6| NLS))
               (NUMERIC7 (HOME |7| NLS))
-              (NUMERIC8 (­ |8| NLS))
+              (NUMERIC8 (^ |8| NLS))
               (NUMERIC9 (PGUP |9| NLS))
               (NUMERIC= (= =))
               (RETURN (CR CR))
@@ -274,17 +274,17 @@
               (F3 (ITALIC NOTITALIC NLS))
               (F4 (UCASE LCASE NLS))
               (F5 (STRIKEOUT NOTSTRIKEOUT NLS))
-              (F6 ("­" "­" NLS))
+              (F6 ("^" "^" NLS))
               (F7 (SUBSCRIPT SUPERSCRIPT NLS))
               (F8 (SMALLER LARGER NLS))
               (F9 (MARGINS NOTMARGINS NLS))
-              (F10 ("¬" "¬" NLS))
+              (F10 ("_" "_" NLS))
               (F11 (F11 NOTF11 NLS))
               (F12 (F12 NOTF12 NLS)))
              ((%` 45 B)
               (~ 45 T)
               (|6| 2 B)
-              (^ 2 T)
+              (↑ 2 T)
               (%% 0 T)
               (|5| 0 B)
               ($ 1 T)
@@ -523,7 +523,7 @@
                        (> (346 46 29 33))
                        (%: (362 82 29 33))
                        (<-%| (426 82 63 33))
-                       (^ (450 118 29 33))
+                       (↑ (450 118 29 33))
                        (DEL (498 154 29 33))
                        (R (162 118 29 33))
                        (T (194 118 29 33))
@@ -556,7 +556,7 @@
                   (LF (LF LF))
                   (LOCK LOCKDOWN . LOCKUP)
                   (\ (\ %| NLS))
-                  (^ (_ ^ NLS))
+                  (↑ (← ↑ NLS))
                   ({ (%[ { NLS))
                   (} (%] } NLS)))
                  ((BLANK-MIDDLE 30)
@@ -643,8 +643,8 @@
                   (%: 43)
                   (CR 44)
                   (<-%| 44)
-                  (_ 45)
-                  (^ 45)
+                  (← 45)
+                  (↑ 45)
                   (r 48)
                   (R 48)
                   (t 49)
@@ -744,7 +744,7 @@
                  NIL
                  ((%" (%' %" NLS))
                   (+ (= + NLS))
-                  (- (- _ NLS))
+                  (- (- ← NLS))
                   (ESC (ESC %| NLS))
                   (%: (; %: NLS))
                   (< (%, < NLS))
@@ -757,7 +757,7 @@
                   (~ (%` ~ NLS)))
                  ((%` 45)
                   (~ 45)
-                  (^ 2)
+                  (↑ 2)
                   (|6| 2)
                   (w 18)
                   (W 18)
@@ -951,7 +951,7 @@
                 NIL
                 ((%" (%' %" NLS))
                  (+ (= + NLS))
-                 (- (- _ NLS))
+                 (- (- ← NLS))
                  (%: (; %: NLS))
                  (< (%, < NLS))
                  (<-%| (CR CR))
@@ -962,21 +962,21 @@
                  (KEYBOARD METADOWN . METAUP)
                  (LOCK LOCKDOWN . LOCKUP)
                  (NEXT (2,22 2,62 NLS))
-                 (NUMERIC* (NUMLK ´ NLS))
+                 (NUMERIC* (NUMLK × NLS))
                  (NUMERIC+ (HELP 2,45 NLS))
                  (NUMERIC, (\ %, NLS))
                  (NUMERIC- (SCRL - NLS))
                  (NUMERIC. (%| 21 NLS))
-                 (NUMERIC/ (BREAK ¸ NLS))
+                 (NUMERIC/ (BREAK ÷ NLS))
                  (NUMERIC0 (INS |0| NLS))
                  (NUMERIC1 (END |1| NLS))
-                 (NUMERIC2 (¯ |2| NLS))
+                 (NUMERIC2 (↓ |2| NLS))
                  (NUMERIC3 (PGDN |3| NLS))
-                 (NUMERIC4 (¬ |4| NLS))
+                 (NUMERIC4 (_ |4| NLS))
                  (NUMERIC5 (%  |5| NLS))
-                 (NUMERIC6 (® |6| NLS))
+                 (NUMERIC6 (→ |6| NLS))
                  (NUMERIC7 (HOME |7| NLS))
-                 (NUMERIC8 (­ |8| NLS))
+                 (NUMERIC8 (^ |8| NLS))
                  (NUMERIC9 (PGUP |9| NLS))
                  (%` (%` ~ NLS))
                  ({ (%[ { NLS))
@@ -987,7 +987,7 @@
                  (|4| 1)
                  ($ 1)
                  (|6| 2)
-                 (^ 2)
+                 (↑ 2)
                  (e 3)
                  (E 3)
                  (|7| 4)
@@ -1233,7 +1233,7 @@
                   (%. (%. > NLS))
                   (/ (/ ? NLS))
                   (\ (\ %| NLS))
-                  (- (- _ NLS))
+                  (- (- ← NLS))
                   (%` (%` ~ NLS))
                   (%[ (%[ { NLS))
                   (%] (%] } NLS))
@@ -1249,13 +1249,13 @@
                   (NUMERIC/ (/ /))
                   (NUMERIC0 (INS |0| NLS))
                   (NUMERIC1 (END |1| NLS))
-                  (NUMERIC2 (¯ |2| NLS))
+                  (NUMERIC2 (↓ |2| NLS))
                   (NUMERIC3 (PGDN |3| NLS))
-                  (NUMERIC4 (¬ |4| NLS))
+                  (NUMERIC4 (_ |4| NLS))
                   (NUMERIC5 (|5| |5|))
-                  (NUMERIC6 (® |6| NLS))
+                  (NUMERIC6 (→ |6| NLS))
                   (NUMERIC7 (HOME |7| NLS))
-                  (NUMERIC8 (­ |8| NLS))
+                  (NUMERIC8 (^ |8| NLS))
                   (NUMERIC9 (PGUP |9| NLS))
                   (NUMERICENTER (CR CR))
                   (RALT METADOWN . METAUP)
@@ -1264,11 +1264,11 @@
                   (F3 (ITALIC NOTITALIC NLS))
                   (F4 (UCASE LCASE NLS))
                   (F5 (STRIKEOUT NOTSTRIKEOUT NLS))
-                  (F6 ("­" "­" NLS))
+                  (F6 ("^" "^" NLS))
                   (F7 (SUBSCRIPT SUPERSCRIPT NLS))
                   (F8 (SMALLER LARGER NLS))
                   (F9 (MARGINS NOTMARGINS NLS))
-                  (F10 ("¬" "¬" NLS))
+                  (F10 ("_" "_" NLS))
                   (F11 (F11 NOTF11 NLS))
                   (F12 (F12 NOTF12 NLS)))
                  ((%' 28 B)
@@ -1276,7 +1276,7 @@
                   (%, 27 B)
                   (< 27 T)
                   (- 10 B)
-                  (_ 10 T)
+                  (← 10 T)
                   (> 42 T)
                   (%. 42 B)
                   (/ 12 B)
@@ -1286,7 +1286,7 @@
                   (%# 16 T)
                   ($ 1 T)
                   (%% 0 T)
-                  (^ 4 T)
+                  (↑ 4 T)
                   (* 53 T)
                   (%( 22 T)
                   (%) 8 T)
@@ -1494,7 +1494,7 @@
                            (M (370 42 29 29))
                            (; (402 42 29 29))
                            (%: (434 42 29 29))
-                           (_ (466 42 29 29))
+                           (← (466 42 29 29))
                            (RSHIFT (498 42 53 29))
                            (LINEFEED (554 42 29 29))
                            (CONTROL (106 74 53 29))
@@ -1559,7 +1559,7 @@
                   (ONE (|1| + NLS))
                   (TWO (|2| %" NLS))
                   (THREE (|3| * NLS))
-                  (FOUR (|4| ‡ NLS))
+                  (FOUR (|4|  NLS))
                   (SIX (|6| & NLS))
                   (SEVEN (|7| / NLS))
                   (EIGHT (|8| %( NLS))
@@ -1567,7 +1567,7 @@
                   (%: (%. %: NLS))
                   (; (%, ; NLS))
                   (? (%' ? NLS))
-                  (AUMLAUT (… „ NLS))
+                  (AUMLAUT (  NLS))
                   (CAPSLOCK CTRLDOWN . CTRLUP)
                   (CONTROL LOCKDOWN . LOCKUP)
                   (CR (CR CR))
@@ -1591,10 +1591,10 @@
                   (NUMERIC8 (|8| |8|))
                   (NUMERIC9 (|9| |9|))
                   (NUMERIC= (= =))
-                  (OUMLAUT (‚ ” NLS))
-                  (UUMLAUT (Š <20> NLS))
+                  (OUMLAUT (  NLS))
+                  (UUMLAUT (  NLS))
                   (%[ (%] %[ NLS))
-                  (_ (- _ NLS))
+                  (← (- ← NLS))
                   ({ (< { NLS))
                   (} (> } NLS)))
                  ((HELP 0)
@@ -1658,7 +1658,7 @@
                   (%. 49)
                   (%: 49)
                   (- 50)
-                  (_ 50)
+                  (← 50)
                   (RSHIFT 51)
                   (LINEFEED 52)
                   (CONTROL 53)

lispusers/BROKEN-ATOMS

@@ -0,0 +1,187 @@
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
+
+
(FILECREATED "14-Apr-2026 12:14:44" {PROJECTS}<BROKENATOMS>BROKEN-ATOMS.;10
 7207   
+
+      :CHANGES-TO (FUNCTIONS WITHOUT-BROKEN-ATOMS TEST-PRETTY-FILE TEST-DEEP-COMPUTATION 
+                         CURE-BROKEN-ATOM)
+                  (VARS BROKEN-ATOMSCOMS)
+
+      :PREVIOUS-DATE "18-Feb-2026 16:08:40" {PROJECTS}<BROKENATOMS>BROKEN-ATOMS.;3)
+
+
+(PRETTYCOMPRINT BROKEN-ATOMSCOMS)
+
+(RPAQQ BROKEN-ATOMSCOMS

+       (
+        (* ;; "the representation of a broken atom")

+
+        (RECORDS BROKEN-ATOM)
+        (FUNCTIONS CURE-BROKEN-ATOM)
+        
+        (* ;; "for DEFPRINT")

+
+        (FNS BROKEN-ATOM-PRINTER)
+        
+        (* ;; "special form")

+
+        (FUNCTIONS WITHOUT-BROKEN-ATOMS)
+        
+        (* ;; "setup")

+
+        (P (DEFPRINT 'BROKEN-ATOM 'BROKEN-ATOM-PRINTER))
+        
+        (* ;; "Debugging/testing")

+
+        (FUNCTIONS TEST-INTERNAL-BA TEST-EXTERNAL-BA TEST-DEEP-COMPUTATION TEST-PRETTY-FILE)))
+
+
+
+(* ;; "the representation of a broken atom")

+
+(DECLARE%: EVAL@COMPILE
+
+(DATATYPE BROKEN-ATOM
 ((PACKAGE POINTER)
+                       (NAME POINTER)
+                       (EXTERNAL FLAG)))
+)
+
+(/DECLAREDATATYPE 'BROKEN-ATOM '(POINTER POINTER FLAG)
+       '((BROKEN-ATOM 0 POINTER)
+         (BROKEN-ATOM 2 POINTER)
+         (BROKEN-ATOM 2 (FLAGBITS . 0)))
+       '4)
+
+(CL:DEFUN CURE-BROKEN-ATOM
 (CONDITION)
+   "Given an XCL:MISSING-EXTERNAL-SYMBOL condition, return a corresponding BROKEN-ATOM"
+   (COND
+      ((TYPEP CONDITION 'XCL:MISSING-PACKAGE)                (* ; "no such package ")

+       (create
 BROKEN-ATOM
+              PACKAGE _ (XCL:MISSING-PACKAGE-PACKAGE-NAME CONDITION)
+              NAME _ (XCL:MISSING-PACKAGE-SYMBOL-NAME CONDITION)
+              EXTERNAL _ (XCL:MISSING-PACKAGE-EXTERNAL CONDITION)))
+      ((TYPEP CONDITION 'XCL:MISSING-EXTERNAL-SYMBOL)        (* ; 
+
                                                            "package exists, no such external symbol")

+       (create
 BROKEN-ATOM
+              PACKAGE _ (CL:PACKAGE-NAME (XCL:MISSING-EXTERNAL-SYMBOL-PACKAGE CONDITION))
+              NAME _ (XCL:MISSING-EXTERNAL-SYMBOL-NAME CONDITION)
+              EXTERNAL _ NIL))
+      (T (HELP "Don't know how to cure" CONDITION))))
+
+
+
+(* ;; "for DEFPRINT")

+
+(DEFINEQ
+
+(BROKEN-ATOM-PRINTER

+  [LAMBDA (BROKEN-ATOM STREAM)
+    (CONS (CONCAT (fetch
 (BROKEN-ATOM PACKAGE) of
 BROKEN-ATOM)
+                 (if
 (fetch
 (BROKEN-ATOM EXTERNAL) of
 BROKEN-ATOM)
+                     then
 ":"
+                   else
 "::")
+                 (fetch
 (BROKEN-ATOM NAME) of
 BROKEN-ATOM])
+)
+
+
+
+(* ;; "special form")

+
+
+(DEFMACRO WITHOUT-BROKEN-ATOMS
 (&BODY FORMS)
+   "Handle any broken-atom errors by producing a BROKEN-ATOM that prints as if the original atom were intact"
+   `[HANDLER-BIND [[XCL:MISSING-PACKAGE #'(CL:LAMBDA (C)
+                                                 (CONDITIONS:INVOKE-RESTART 
+                                                        'CREATE-MISSING-PACKAGE-BA (CURE-BROKEN-ATOM

+                                                                                    C]
+                   (XCL:MISSING-EXTERNAL-SYMBOL #'(CL:LAMBDA (C)
+                                                         (CONDITIONS:INVOKE-RESTART 
+                                                                'CREATE-EXTERNAL-BA (CURE-BROKEN-ATOM

+                                                                                     C]
+           (CONDITIONS:RESTART-BIND [(CREATE-MISSING-PACKAGE-BA
+                                      #'(CL:LAMBDA (V)
+                                               (RETFROM (FUNCTION RESOLVE-MISSING-PACKAGE)
+                                                      V)
+                                               V))
+                                     (CREATE-EXTERNAL-BA #'(CL:LAMBDA (V)
+                                                                  (RETFROM (FUNCTION 
+                                                                      RESOLVE-MISSING-EXTERNAL-SYMBOL
+                                                                            )
+                                                                         V)
+                                                                  V]
+                  (PROGN ,@FORMS])
+
+
+
+(* ;; "setup")

+
+
+(DEFPRINT 'BROKEN-ATOM 'BROKEN-ATOM-PRINTER)
+
+
+
+(* ;; "Debugging/testing")

+
+
+(CL:DEFUN TEST-INTERNAL-BA
 ()
+   [LET ((FILE NIL))
+        (CL:WITH-OPEN-STREAM (OUT (OPENSTREAM "{nodircore}" 'OUTPUT))
+               (SETQ FILE OUT)
+               (PRINTOUT OUT "BROKEN::INTERNAL-ATOM" T))
+        (CL:WITH-OPEN-STREAM (IN
 (OPENSTREAM FILE 'INPUT))
+               (WITHOUT-BROKEN-ATOMS
 (RATOM IN])
+
+(CL:DEFUN TEST-EXTERNAL-BA
 ()
+   [LET ((FILE NIL))
+        (CL:WITH-OPEN-STREAM (OUT (OPENSTREAM "{nodircore}" 'OUTPUT))
+               (SETQ FILE OUT)
+               (PRINTOUT OUT "BROKEN:EXTERNAL-ATOM" T))
+        (CL:WITH-OPEN-STREAM (IN
 (OPENSTREAM FILE 'INPUT))
+               (WITHOUT-BROKEN-ATOMS
 (RATOM IN])
+
+(CL:DEFUN TEST-DEEP-COMPUTATION
 ()
+   "Test that we can handle internal calls to READ that encounter broken atoms"
+
+   (* ;; "make sure it works when there's no error")

+
+   (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT X]
+        (PRINTOUT T "No error loop result: " RESULT T))
+
+   (* ;; "and when reading legit atoms")

+
+   (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT (CL:READ-FROM-STRING
+                                                                               (CONCAT "IL:ATOM" X]
+        (PRINTOUT T "No error read loop result: " RESULT T))
+
+   (* ;; "test XCL:MISSING-PACKAGE.")

+
+   (COND
+      ((CL:FIND-PACKAGE :BROKEN)
+       (DELETE-PACKAGE :BROKEN)))
+   (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT (CL:READ-FROM-STRING
+                                                                               (CONCAT "BROKEN:ATOM"
+                                                                                      X]
+        (PRINTOUT T "No such package loop result: " RESULT T))
+
+   (* ;; "test XCL:MISSING-EXTERNAL-SYMBOL")

+
+   (CL:UNWIND-PROTECT
+       (PROGN (CL:MAKE-PACKAGE :BROKEN)
+              (LET [(RESULT (WITHOUT-BROKEN-ATOMS
 (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT
+                                                         (CL:READ-FROM-STRING (CONCAT "BROKEN:ATOM" X
+                                                                                     ]
+                   (PRINTOUT T "Not external symbol loop result: " RESULT T)))
+       [COND
+          ((CL:FIND-PACKAGE :BROKEN)
+           (DELETE-PACKAGE 'BROKEN]))
+
+(CL:DEFUN TEST-PRETTY-FILE
 (SOURCE-FILE-NAME OUTPUT-FILE-NAME OUTPUT-TYPE)
+   "Prettyprint a Lisp source file to an imagestream file"
+   (CL:WITH-OPEN-STREAM (OUTPUT-STREAM (OPENIMAGESTREAM OUTPUT-FILE-NAME OUTPUT-TYPE))
+          (WITHOUT-BROKEN-ATOMS
 (PRETTYFILEINDEX SOURCE-FILE-NAME NIL OUTPUT-STREAM T))
+          (FULLNAME OUTPUT-STREAM)))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1403 2315 (CURE-BROKEN-ATOM 1403 . 2315)) (2346 2699 (BROKEN-ATOM-PRINTER 2356 . 2697))
+ (2731 4397 (WITHOUT-BROKEN-ATOMS 2731 . 4397)) (4503 4831 (TEST-INTERNAL-BA 4503 . 4831)) (4833 5160 
+(TEST-EXTERNAL-BA 4833 . 5160)) (5162 6829 (TEST-DEEP-COMPUTATION 5162 . 6829)) (6831 7184 (
+TEST-PRETTY-FILE 6831 . 7184)))))
+STOP

lispusers/COMPAREDIRECTORIES

@@ -1,12 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "10-Feb-2026 21:28:55" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;286
 138607 
+
(FILECREATED "28-Apr-2026 23:41:24" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;289
 139726 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS CD-MENUFN)
+      :CHANGES-TO (FNS CDFILES.PATS CDFILES.MATCH CDBROWSER-COPY)
 
-      :PREVIOUS-DATE " 8-Nov-2025 13:07:39" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;285)
+      :PREVIOUS-DATE "28-Apr-2026 21:38:49" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;288)
 
 
 (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
@@ -507,32 +507,37 @@
             UNLESS
 (CDFILES.MATCH
 SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT
 FULLNAME])
 
 (CDFILES.MATCH

-  [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS)
               (* ; "Edited 26-Jan-2022 15:33 by rmk")


+  [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS)
               (* ; "Edited 28-Apr-2026 23:40 by rmk")


+                                                             (* ; "Edited 26-Jan-2022 15:33 by rmk")


                                                              (* ; "Edited 23-Dec-2021 21:47 by rmk")

+    (thereis
 P in
 PATTERNS suchthat
 
 
-    (* ;; "True if the components of the fullname match at least one of the patterns")

+                                 (* ;; "The SUBDIR test is tricky.  If the exclusion pattern was internal/fonts/**, this shows up as (* * internal/fonts 65535), it has to match  internal/fonts/display/completed/.  Below we test for an initial substring")

 
-    (THEREIS
 P IN
 PATTERNS SUCHTHAT
 (AND [OR (STRING.EQUAL NAME (CAR P)
-                                                    FILEDIRCASEARRAY)
-                                             (EQ '* (CAR P))
-                                             (AND (EQ (CHARCODE %.)
-                                                      (CHCON1 (CAR P)))
-                                                  (EQ (CHARCODE %.)
-                                                      (CHCON1 NAME))
-                                                  (OR (STRING.EQUAL NAME (SUBATOM (CAR P)
-                                                                                2))
-                                                      (EQ (CHARCODE *
)
-                                                          (NTHCHARCODE (CAR P)
-                                                                 2]
-                                         (OR (STRING.EQUAL EXT (CADR P))
-                                             (EQ '* (CADR P)))
-                                         (OR (STRING.EQUAL SUBDIR (CADDR P))
-                                             (NULL (CADDR P))
-                                             (EQ '* (CADDR P)))
-                                         (ILEQ THISDEPTH (CADDDR P])
+                                 (AND [OR (STRING.EQUAL NAME (CAR P)
+                                                 FILEDIRCASEARRAY)
+                                          (EQ '* (CAR P))
+                                          (AND (EQ (CHARCODE %.)
+                                                   (CHCON1 (CAR P)))
+                                               (EQ (CHARCODE %.)
+                                                   (CHCON1 NAME))
+                                               (OR (STRING.EQUAL NAME (SUBATOM (CAR P)
+                                                                             2))
+                                                   (EQ (CHARCODE *
)
+                                                       (NTHCHARCODE (CAR P)
+                                                              2]
+                                      (OR (STRING.EQUAL EXT (CADR P))
+                                          (EQ '* (CADR P)))
+                                      (ILEQ THISDEPTH (CADDDR P))
+                                      (OR (STRING.EQUAL SUBDIR (CADDR P))
+                                          (NULL (CADDR P))
+                                          (EQ '* (CADDR P))
+                                          (STRPOS (CADDR P)
+                                                 SUBDIR 1 NIL T])
 
 (CDFILES.PATS

-  [LAMBDA (PATTERNS)
                                         (* ; "Edited 17-Jun-2023 23:36 by rmk")


+  [LAMBDA (PATTERNS)
                                         (* ; "Edited 28-Apr-2026 23:01 by rmk")


+                                                             (* ; "Edited 17-Jun-2023 23:36 by rmk")


                                                              (* ; "Edited 23-Dec-2021 17:02 by rmk")

 
     (* ;; "Returns (NAME EXT SUBDIR DEPTH) items where NAME or EXT may be the wildcard *, SD is the subdirectory (if any) and DEPTH is the number of / or > in the subdirectory")

@@ -544,15 +549,15 @@
          (* * NIL 1)

 )
       ELSE
 (FOR
 P N E SD DEPTH UNPACK INSIDE
 PATTERNS
-              JOIN
 (SETQ UNPACK (UNPACKFILENAME.STRING P))   (* ; 
+              JOIN
 (SETQ UNPACK (UNPACKFILENAME P))          (* ; 
 
                                              "String so we can tell the difference between x and x.")

-                   [SETQ SD (MKATOM (LISTGET UNPACK 'SUBDIRECTORY] 
+                   (SETQ SD (LISTGET UNPACK 'SUBDIRECTORY)) 
 
                    (* ;; "Count the subdirectory depth")

 
-                   [SETQ DEPTH (IF
 (EQ SD '*)
-                                   THEN
 MAX.SMALLP
-                                 ELSE
 (FOR
 I (CNT _ 1) FROM
 1 DO
 (SELCHARQ (NTHCHARCODE SD I)
+                   [SETQ DEPTH (if
 (EQ SD '*)
+                                   then
 MAX.SMALLP
+                                 else
 (for
 I (CNT _ 1) from
 1 do
 (SELCHARQ (NTHCHARCODE SD I)
                                                                       ((/ >) 
                                                                            (ADD
 CNT 1))
                                                                       (NIL (RETURN CNT))
@@ -560,28 +565,31 @@
                    (SETQ N (LISTGET UNPACK 'NAME))
                    (SETQ N (if
 (NULL N)
                                then
 '*
+                             elseif
 (EQ N '**)
+                               then
 (SETQ DEPTH MAX.SMALLP)
+                                    '*
                              elseif
 (NEQ 0 (NCHARS N))
-                               then
 (MKATOM N)))
+                               then
 N))
                    (SETQ E (LISTGET UNPACK 'EXTENSION))
                    (SETQ E (if
 (NULL E)
                                then
 '*
                              elseif
 (NEQ 0 (NCHARS E))
-                               then
 (MKATOM E)))
-                   (if
 [OR (AND (STRING.EQUAL N 'COM)
+                               then
 E))
+                   (if
 [OR (AND (EQ N 'COM)
                                 (NULL E))
-                           (AND (STRING.EQUAL E 'COM)
+                           (AND (EQ E 'COM)
                                 (MEMB N '                    (* NIL)
]
-                       THEN
 (FOR
 CE IN
 *COMPILED-EXTENSIONS* COLLECT
 (LIST '* CE SD DEPTH))
-                     ELSE
 (CONS (IF
 N
-                                    THEN
 (LIST N E SD DEPTH)
-                                  ELSEIF
 E
-                                    THEN
 
+                       then
 (for
 CE in
 *COMPILED-EXTENSIONS* collect
 (LIST '* CE SD DEPTH))
+                     else
 (CONS (if
 N
+                                    then
 (LIST N E SD DEPTH)
+                                  elseif
 E
+                                    then
 
 
                                  (* ;; "This is the case .XXX, which presumably identifies a dotted file.  If this is supposed to be all files with extension XXX, it shoud be specified as *.XXX, the case above.  So we move .E into the N field.")

 
                                          (LIST (PACK* '%. E)
                                                NIL SD DEPTH)
-                                  ELSE
 `
+                                  else
 `
 
          (* * (\, SD) (\, DEPTH))

 ])
@@ -2146,7 +2154,9 @@
                                                              NIL])
 
 (CDBROWSER-COPY

-  [LAMBDA (CDBROWSER
 TBITEM SOURCE UNIXDEST)
                 (* ; "Edited 28-Oct-2025 17:39 by rmk")


+  [LAMBDA (CDBROWSER
 TBITEM SOURCE UNIXDEST)
                 (* ; "Edited 28-Apr-2026 18:54 by rmk")


+                                                             (* ; "Edited 31-Mar-2026 10:49 by rmk")


+                                                             (* ; "Edited 28-Oct-2025 17:39 by rmk")


                                                              (* ; "Edited 25-Oct-2025 23:58 by rmk")


                                                              (* ; "Edited 24-May-2022 15:49 by rmk")


                                                              (* ; "Edited 25-Apr-2022 09:24 by rmk")


@@ -2184,7 +2194,8 @@
                    (PRIN3 "No source file to copy" T)
                    (RETURN NIL))
                (CL:WHEN [AND (EQ DATERELBAD (FETCH
 (CDENTRY
 DATEREL) OF
 CDENTRY))
-                             (PROGN (FLASHWINDOW T)
+                             (PROGN (GIVE.TTY.PROCESS T)
+                                    (FLASHWINDOW T)
                                     (EQ 'N (ASKUSER NIL NIL 
                                                   "Target is newer than source.  Really copy? "]
                       (RETURN NIL))
@@ -2194,6 +2205,7 @@
                                                                         ))
                                                       'VERSION))
                              (PROGN (FLASHWINDOW T)
+                                    (GIVE.TTY.PROCESS T)
                                     (EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE 
                                                          " is not the newest version.  Really copy? "
                                                                    ]
@@ -2202,8 +2214,10 @@
                (CL:UNLESS DESTFILE
                    (SETQ DESTFILE (CD-SWAPDIRS
 SOURCEFILE SOURCEDIR DESTDIR)))
                [SETQ RESULT (if
 UNIXDEST
-                                then
 (SPUTMULTI (fetch
 (TABLEBROWSER TBUSERDATA) of
 CDBROWSER)
-                                            'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE))
+                                then
 (CL:WHEN (INFILEP DESTFILE)
+                                         (SPUTMULTI (fetch
 (TABLEBROWSER TBUSERDATA) of
 CDBROWSER)
+                                                'ORIGINALFILES DESTFILE (COPYFILE DESTFILE
+                                                                               '{NODIRCORE})))
                                      [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY
                                                             (COPYFILE SOURCEFILE (PACKFILENAME
                                                                                   'HOST
@@ -2323,25 +2337,25 @@
 
 (MOVD? 'NILL 'TEDIT.FILEDATE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2653 23632 (COMPAREDIRECTORIES 2663 . 7998) (COMPAREDIRECTORIES.INFOS 8000 . 11229) (
-COMPAREDIRECTORIES.CANDIDATES 11231 . 14616) (CDENTRIES.SELECT 14618 . 19520) (
-COMPAREDIRECTORIES.INFOS.TYPE 19522 . 20866) (MATCHNAME 20868 . 21548) (CD.INSURECDVALUE 21550 . 23164
-) (CD.UPDATEWIDTHS 23166 . 23630)) (23633 34338 (CDFILES 23643 . 29740) (CDFILES.MATCH 29742 . 31367) 
-(CDFILES.PATS 31369 . 34336)) (34339 52357 (CDPRINT 34349 . 36866) (CDPRINT.HEADER 36868 . 37765) (
-CDPRINT.LINE 37767 . 41196) (CDPRINT.MAXWIDTHS 41198 . 45313) (CDPRINT.COLHEADERS 45315 . 46600) (
-CDPRINT.COLUMNS 46602 . 51722) (CDTEDIT 51724 . 52355)) (52358 61479 (CDMAP 52368 . 53800) (CDENTRY 
-53802 . 54111) (CDSUBSET 54113 . 55552) (CDMERGE 55554 . 59538) (CDMERGE.COMMON 59540 . 60855) (
-CD.SORT 60857 . 61477)) (61480 69018 (BINCOMP 61490 . 65779) (EOLTYPE 65781 . 68343) (EOLTYPE.SHOW 
-68345 . 69016)) (69546 82073 (FIND-UNCOMPILED-FILES 69556 . 73199) (FIND-UNSOURCED-FILES 73201 . 75585
-) (FIND-SOURCE-FILES 75587 . 77325) (FIND-COMPILED-FILES 77327 . 79204) (FIND-UNLOADED-FILES 79206 . 
-80059) (FIND-LOADED-FILES 80061 . 80489) (FIND-MULTICOMPILED-FILES 80491 . 82071)) (82074 90505 (
-CREATED-AS 82084 . 86881) (SOURCE-FOR-COMPILED-P 86883 . 89810) (COMPILE-SOURCE-DATE-DIFF 89812 . 
-90503)) (90506 101269 (FIX-DIRECTORY-DATES 90516 . 93966) (FIX-EQUIV-DATES 93968 . 95493) (
-COPY-COMPARED-FILES 95495 . 97316) (COPY-MISSING-FILES 97318 . 99475) (COMPILED-ON-SAME-SOURCE 99477
- . 101267)) (101463 109341 (CDBROWSER 101473 . 105440) (CDBROWSER.STRINGS 105442 . 109339)) (109503 
-111239 (CD.TABLEITEM 109513 . 109733) (CD.TABLEITEM.PRINTFN 109735 . 109934) (CD.TABLEITEM.COPYFN 
-109936 . 110994) (CDTABLEBROWSER.HEADING.REPAINTFN 110996 . 111237)) (111240 138091 (
-CDTABLEBROWSER.WHENSELECTEDFN 111250 . 111718) (CD.COMMANDSELECTEDFN 111720 . 117893) (CD-MENUFN 
-117895 . 124372) (CD-COMPARE-FILES 124374 . 127901) (CDBROWSER-COPY 127903 . 132965) (
-CDBROWSER-DELETE-FILE 132967 . 137570) (CD-SWAPDIRS 137572 . 138089)))))
+  (FILEMAP (NIL (2683 23662 (COMPAREDIRECTORIES 2693 . 8028) (COMPAREDIRECTORIES.INFOS 8030 . 11259) (
+COMPAREDIRECTORIES.CANDIDATES 11261 . 14646) (CDENTRIES.SELECT 14648 . 19550) (
+COMPAREDIRECTORIES.INFOS.TYPE 19552 . 20896) (MATCHNAME 20898 . 21578) (CD.INSURECDVALUE 21580 . 23194
+) (CD.UPDATEWIDTHS 23196 . 23660)) (23663 34971 (CDFILES 23673 . 29770) (CDFILES.MATCH 29772 . 31782) 
+(CDFILES.PATS 31784 . 34969)) (34972 52990 (CDPRINT 34982 . 37499) (CDPRINT.HEADER 37501 . 38398) (
+CDPRINT.LINE 38400 . 41829) (CDPRINT.MAXWIDTHS 41831 . 45946) (CDPRINT.COLHEADERS 45948 . 47233) (
+CDPRINT.COLUMNS 47235 . 52355) (CDTEDIT 52357 . 52988)) (52991 62112 (CDMAP 53001 . 54433) (CDENTRY 
+54435 . 54744) (CDSUBSET 54746 . 56185) (CDMERGE 56187 . 60171) (CDMERGE.COMMON 60173 . 61488) (
+CD.SORT 61490 . 62110)) (62113 69651 (BINCOMP 62123 . 66412) (EOLTYPE 66414 . 68976) (EOLTYPE.SHOW 
+68978 . 69649)) (70179 82706 (FIND-UNCOMPILED-FILES 70189 . 73832) (FIND-UNSOURCED-FILES 73834 . 76218
+) (FIND-SOURCE-FILES 76220 . 77958) (FIND-COMPILED-FILES 77960 . 79837) (FIND-UNLOADED-FILES 79839 . 
+80692) (FIND-LOADED-FILES 80694 . 81122) (FIND-MULTICOMPILED-FILES 81124 . 82704)) (82707 91138 (
+CREATED-AS 82717 . 87514) (SOURCE-FOR-COMPILED-P 87516 . 90443) (COMPILE-SOURCE-DATE-DIFF 90445 . 
+91136)) (91139 101902 (FIX-DIRECTORY-DATES 91149 . 94599) (FIX-EQUIV-DATES 94601 . 96126) (
+COPY-COMPARED-FILES 96128 . 97949) (COPY-MISSING-FILES 97951 . 100108) (COMPILED-ON-SAME-SOURCE 100110
+ . 101900)) (102096 109974 (CDBROWSER 102106 . 106073) (CDBROWSER.STRINGS 106075 . 109972)) (110136 
+111872 (CD.TABLEITEM 110146 . 110366) (CD.TABLEITEM.PRINTFN 110368 . 110567) (CD.TABLEITEM.COPYFN 
+110569 . 111627) (CDTABLEBROWSER.HEADING.REPAINTFN 111629 . 111870)) (111873 139210 (
+CDTABLEBROWSER.WHENSELECTEDFN 111883 . 112351) (CD.COMMANDSELECTEDFN 112353 . 118526) (CD-MENUFN 
+118528 . 125005) (CD-COMPARE-FILES 125007 . 128534) (CDBROWSER-COPY 128536 . 134084) (
+CDBROWSER-DELETE-FILE 134086 . 138689) (CD-SWAPDIRS 138691 . 139208)))))
 STOP

lispusers/CONVERT-TO-UTF8

@@ -0,0 +1,52 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "25-Feb-2026 09:09:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;16
 2573   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS CONVERT-TO-UTF8)
+
+      :PREVIOUS-DATE "24-Feb-2026 22:45:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;14)
+
+
+(PRETTYCOMPRINT CONVERT-TO-UTF8COMS)
+
+(RPAQQ CONVERT-TO-UTF8COMS
 ((FNS CONVERT-TO-UTF8)))
+(DEFINEQ
+
+(CONVERT-TO-UTF8

+  [LAMBDA (FILENAME FILETYPE)
                                (* ; "Edited 25-Feb-2026 09:09 by rmk")

+
+    (* ;; "This produces a new version of the source FILENAME with :UTF-8 external format.")

+
+    (* ;; "If we had a list of problematic functions (multiple definitions on multiple files, MOVD's), we could check that against the functions in FILENAME, and at least produce a warning.")

+
+    (* ;; "Compiling may be tricky:  some files have CL:COMPILE-FILE FILETYPE properties that don't correspond to the fact that they actually have only an LCOM.  This tries to revert the filetype back to FAKE-COMPILE-FILE so that we don't get confused when a DFASL mysteriously appears.")

+
+    (SETQ FILENAME (PSEUDOFILENAME FILENAME))
+    (SETQ FILENAME (OR (FINDFILE FILENAME T)
+                       (ERROR "FILE NOT FOUND" FILENAME)))
+    (if
 [EQ :UTF-8 (CL:WITH-OPEN-FILE (STREAM FILENAME :DIRECTION :INPUT)
+                          (fetch
 (READER-ENVIRONMENT REFORMAT) of
 (GET-ENVIRONMENT-AND-FILEMAP STREAM
+                                                                         T]
+        then
 (PRINTOUT T FILENAME " is already " .P2 :UTF-8 T)
+             NIL
+      else
 (LOAD? (MEDLEYDIR "loadups" 'EXPORTS.ALL))        (* ; "Maybe this should load SYSEDIT ?")

+           (LOAD FILENAME 'PROP)
+           (LOADCOMP FILENAME)
+           (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY FILENAME))
+           (CL:WHEN [AND (EQ 'CL:COMPILE-FILE (GETPROP (ROOTFILENAME FILENAME)
+                                                     'FILETYPE))
+                         (FINDFILE (PACKFILENAME 'EXTENSION 'LCOM 'BODY FILENAME))
+                         (NOT (FINDFILE (PACKFILENAME 'EXTENSION 'DFASL 'BODY FILENAME]
+               (CL:UNLESS FILETYPE (SETQ FILETYPE :FAKE-COMPILE-FILE))
+               (PRINTOUT T "Changing FILETYPE back to " .P2 FILETYPE T)
+               (PUTPROP (ROOTFILENAME FILENAME)
+                      'FILETYPE FILETYPE))
+           [SETQ FILENAME (MAKEFILE FILENAME '(NEW :UTF-8]
+           (MAKEFILE1 FILENAME NIL '(F))
+           FILENAME])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (406 2550 (CONVERT-TO-UTF8 416 . 2548)))))
+STOP

lispusers/EDITFONT

@@ -1,13 +1,13 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "12-Oct-2025 17:39:29" {WMEDLEY}<lispusers>EDITFONT.;41
 26261  
+
(FILECREATED "16-Mar-2026 23:19:02" {WMEDLEY}<lispusers>EDITFONT.;42
 26474  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (RECORDS CHARITEM)
-                  (FNS EF.SAVE)
+      :CHANGES-TO (FNS EDITFONT)
+                  (RECORDS CHARITEM)
 
-      :PREVIOUS-DATE " 7-Oct-2025 14:56:00" {WMEDLEY}<lispusers>EDITFONT.;40)
+      :PREVIOUS-DATE "12-Oct-2025 17:39:29" {WMEDLEY}<lispusers>EDITFONT.;41)
 
 
 (PRETTYCOMPRINT EDITFONTCOMS)
@@ -429,7 +429,8 @@
           (RETURN FONT])
 
 (EDITFONT

-  [LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG)
          (* ; "Edited  7-Oct-2025 14:55 by rmk")


+  [LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG)
          (* ; "Edited 16-Mar-2026 23:17 by rmk")


+                                                             (* ; "Edited  7-Oct-2025 14:55 by rmk")


                                                              (* ; "Edited  5-Oct-2025 15:06 by rmk")


                                                              (* ; "Edited  4-Sep-2025 09:27 by rmk")


                                                              (* ; "Edited 29-Aug-2025 22:34 by rmk")


@@ -440,6 +441,8 @@
                                                              (* kbr%: "21-Oct-85 15:35")

                                                              (* kbr%: "21-Oct-85 15:35")

     (SETQ FONT (FONTCREATE FONT))
+    (CL:UNLESS (EQ 'DISPLAY (FONTPROP FONT 'DEVICE))
+           (ERROR FONT " is not a display font"))
     (SETQ CHARSET (OR (CHARSET.DECODE CHARSET)
                       0))
     (LET (CHARITEMS MENU TITLE HEIGHT WIDTH REGION POS WINDOW)
@@ -494,10 +497,10 @@
 
 (EF.INIT
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1146 16903 (EF.INIT 1156 . 1790) (EF.PROMPT 1792 . 2374) (EF.MESSAGE 2376 . 2588) (
-EF.CLOSEFN 2590 . 3117) (EF.CHARITEMS 3119 . 4955) (EF.BUTTONEVENTFN 4957 . 5369) (EF.WHENSELECTEDFN 
-5371 . 5775) (EF.EDITBM 5777 . 7271) (EF.MIDDLEBUTTONFN 7273 . 7518) (EF.CHANGESIZE 7520 . 8849) (
-EF.DELETE 8851 . 10032) (EF.ENTER 10034 . 10975) (EF.REPLACE 10977 . 11950) (EF.SAVE 11952 . 16195) (
-COPYFONT 16197 . 16472) (READSTRIKEFONTFILE 16474 . 16901)) (16904 26073 (BLANKCHARSETCREATE 16914 . 
-22999) (EDITFONT 23001 . 26071)))))
+  (FILEMAP (NIL (1147 16904 (EF.INIT 1157 . 1791) (EF.PROMPT 1793 . 2375) (EF.MESSAGE 2377 . 2589) (
+EF.CLOSEFN 2591 . 3118) (EF.CHARITEMS 3120 . 4956) (EF.BUTTONEVENTFN 4958 . 5370) (EF.WHENSELECTEDFN 
+5372 . 5776) (EF.EDITBM 5778 . 7272) (EF.MIDDLEBUTTONFN 7274 . 7519) (EF.CHANGESIZE 7521 . 8850) (
+EF.DELETE 8852 . 10033) (EF.ENTER 10035 . 10976) (EF.REPLACE 10978 . 11951) (EF.SAVE 11953 . 16196) (
+COPYFONT 16198 . 16473) (READSTRIKEFONTFILE 16475 . 16902)) (16905 26286 (BLANKCHARSETCREATE 16915 . 
+23000) (EDITFONT 23002 . 26284)))))
 STOP

lispusers/GITFNS

@@ -1,12 +1,14 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
 
-
(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}<lispusers>GITFNS.;569
 131593 
+
(FILECREATED "29-Apr-2026 12:51:53" {MEDLEY}<lispusers>GITFNS.;592
 137200 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES)
+      :CHANGES-TO (FNS GIT-GWC-COMMAND)
+                  (COMMANDS gwc)
+                  (VARS GITFNSCOMS)
 
-      :PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}<lispusers>GITFNS.;568)
+      :PREVIOUS-DATE "29-Apr-2026 09:00:33" {MEDLEY}<lispusers>GITFNS.;588)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -51,7 +53,7 @@
         (INITVARS (GIT-MERGE-COMPARES T)
                (GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
         (COMMANDS gwc bbc prc cob b? cdg cdw)
-        (FNS PRC-COMMAND)
+        (FNS PRC-COMMAND GIT-GWC-COMMAND)
         
         (* ;; "")

 
@@ -60,7 +62,7 @@
 
         (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
         (FNS TOGIT FROMGIT)
-        (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
+        (FNS WORKINGSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
         (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
         
         (* ;; "")

@@ -74,7 +76,7 @@
         
         (* ;; "Differences")

 
-        (FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
+        (FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS GIT-MODIFIED)
         
         (* ;; "")

 
@@ -169,6 +171,10 @@
 
 (GIT-MAKE-PROJECT

   [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)

+                                                             (* ; "Edited 29-Apr-2026 09:00 by rmk")


+                                                             (* ; "Edited 17-Apr-2026 12:33 by rmk")


+                                                             (* ; "Edited 15-Apr-2026 16:33 by rmk")


+                                                             (* ; "Edited 25-Feb-2026 23:25 by rmk")


                                                              (* ; "Edited 25-Oct-2025 16:53 by rmk")


                                                              (* ; "Edited 22-Oct-2025 12:45 by rmk")


                                                              (* ; "Edited 20-Oct-2025 18:10 by rmk")


@@ -234,9 +240,8 @@
              (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY 
                                                       CLONEPATH)))
                  (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE :EXTERNAL-FORMAT :UTF-8)
-                                        (bind
 L until
 (EOFP STREAM)
-                                           while
 (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL 
-                                                                :EOF-VALUE NIL))
+                                        (bind
 L until
 (EOFP STREAM) while
 (SETQ L (CL:READ-LINE
+                                                                                   STREAM NIL))
                                            unless
 (OR (EQ 0 (NCHARS L))
                                                       (STRPOS "#" L)) collect
 L))))
              (SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for
 E inside
 EXCLUSIONS
@@ -274,16 +279,17 @@
                                                           "")
                                                       "for " PROJECTNAME]
              (SETQ PROJECT (create
 GIT-PROJECT
-                                  PROJECTNAME _ PROJECTNAME
-                                  GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
+                                  PROJECTNAME ← PROJECTNAME
+                                  GITHOST ← (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
+                                                              CLONEPATH)
                                                    "}")
-                                  WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" 
+                                  WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" 
                                                                                          PROJECTNAME)
                                                                              WORKINGPATH)
                                                                   "}"))
-                                  EXCLUSIONS _ EXCLUSIONS
-                                  DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
-                                  CLONEPATH _ CLONEPATH))
+                                  EXCLUSIONS ← EXCLUSIONS
+                                  DEFAULTSUBDIRS ← (MKLIST DEFAULTSUBDIRS)
+                                  CLONEPATH ← CLONEPATH))
              (/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
                           (CAR (push
 GIT-PROJECTS (CONS PROJECTNAME]
                     PROJECT)
@@ -358,7 +364,7 @@
 
 (FIND-ANCESTOR-DIRECTORY

   [LAMBDA (STARTDIR PREDFN)
                                  (* ; "Edited  8-May-2022 12:17 by rmk")

-    (BIND
 POS (A _ STARTDIR) WHILE
 (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T))
+    (BIND
 POS (A ← STARTDIR) WHILE
 (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T))
        DO
 (SETQ A (SUBSTRING A 1 POS))
           (CL:WHEN (APPLY* PREDFN A)
                  (RETURN A])
@@ -372,7 +378,7 @@
         (GIT-CLONEP
 (GIT-PROJECT-PATH
 PROJECTNAME PROJECTPATH)
                T T)
         [FIND-ANCESTOR-DIRECTORY
 PROJECTPATH (FUNCTION (LAMBDA (A)
-                                                         (BIND
 D (GEN _ (\GENERATEFILES A NIL NIL 1))
+                                                         (BIND
 D (GEN ← (\GENERATEFILES A NIL NIL 1))
                                                             WHILE
 (SETQ D (\GENERATENEXTFILE GEN))
                                                             WHEN
 (GIT-CLONEP
 D T)
                                                             DO
 (RETFROM (FUNCTION 
@@ -439,18 +445,7 @@
 
 (RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS
 T)
 
-(DEFCOMMAND gwc (SUBDIR . OTHERS)
-
-   (* ;; "Compares the specified local git-medley subdirectories against my working Medley.  The SUBDIRS are the arguments up to one that looks like a project")

-
-    (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
-          PROJECT)
-         (SETQ SUBDIRS (FOR
 STAIL ON
 SUBDIRS COLLECT
 (IF
 (GIT-GET-PROJECT
 (CAR STAIL)
-                                                                NIL T)
-                                                         THEN
 (SETQ PROJECT (CAR STAIL))
-                                                              (GO $$OUT))
-                                                   (CAR STAIL)))
-         (GIT-WORKING-COMPARE-DIRECTORIES
 SUBDIRS NIL NIL NIL T PROJECT)))
+(DEFCOMMAND gwc (SUBDIR . OTHERS) (GIT-GWC-COMMAND
 SUBDIR OTHERS))
 
 (DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
 
@@ -535,7 +530,8 @@
 (DEFINEQ
 
 (PRC-COMMAND

-  [LAMBDA (REMOTEBRANCH DRAFTS PROJECT)
                      (* ; "Edited 29-Jan-2025 19:19 by rmk")


+  [LAMBDA (REMOTEBRANCH DRAFTS PROJECT)
                      (* ; "Edited 16-Mar-2026 11:54 by rmk")


+                                                             (* ; "Edited 29-Jan-2025 19:19 by rmk")


                                                              (* ; "Edited 13-May-2024 18:49 by rmk")


                                                              (* ; "Edited  2-May-2024 11:44 by rmk")


                                                              (* ; "Edited  1-Apr-2024 20:24 by rmk")


@@ -592,7 +588,10 @@
                       then
 (SETQ MENUWINDOW (ADDMENU (GIT-BRANCH-MENU
 (GIT-PRC-BRANCHES
 DRAFTS 
                                                                              PROJECT PRS)
                                                             (CONCAT (LENGTH PRS)
-                                                                   " pull requests"))
+                                                                   " pull requests in "
+                                                                   (GIT-GET-PROJECT
 PROJECT
+                                                                          'PROJECTNAME))
+                                                            PROJECT)
                                                    NIL NIL T)) 
 
                            (* ;; "Position the new menu just under the current TTY window, to keep it out of the way of the comparison windows.  If we have menus open for other projects, those probably should be pushed down to make room for the new menu, and moved up when a higher menu is closed.  An edge case that is not worth the effort. ")

@@ -612,6 +611,32 @@
                                 PROJECT))
            else
 (CONCAT "No open " (OR REMOTEBRANCH "")
                        " pull requests"])
+
+(GIT-GWC-COMMAND

+  [LAMBDA (SUBDIR OTHERS)
                                    (* ; "Edited 29-Apr-2026 12:51 by rmk")

+
+    (* ;; "Compares the specified local git-medley subdirectories against my working Medley.  The SUBDIRS are the arguments up to one that looks like a project, which may be followed by - and some excluded files")

+
+    (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
+          EXCLUDEDFILES PROJECT)
+         (SETQ SUBDIRS (for
 STAIL on
 SUBDIRS unless
 (CL:WHEN (AND (NULL PROJECT)
+                                                                  (SETQ PROJECT (GIT-GET-PROJECT

+                                                                                 (CAR STAIL)
+                                                                                 NIL T)))
+                                                        (CL:UNLESS (EQ '- (CADR STAIL))
+                                                               (RETURN $$VAL))
+                                                        T) collect
 (CL:WHEN (EQ '- (CAR STAIL))
+                                                                       (SETQ EXCLUDEDFILES
+                                                                        (CDR STAIL))
+                                                                       (RETURN $$VAL))
+                                                                 (CAR STAIL)))
+         (CL:UNLESS PROJECT
+             (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT)))
+         (if
 (AND (fetch
 GITHOST of
 PROJECT)
+                  (fetch
 WHOST of
 PROJECT))
+             then
 (GIT-WORKING-COMPARE-DIRECTORIES
 SUBDIRS NIL EXCLUDEDFILES NIL T PROJECT)
+           else
 (PRINTOUT T "gwc requires " (fetch
 PROJECTNAME of
 PROJECT)
+                       " to have both git and working directories" T T])
 )
 
 
@@ -684,7 +709,7 @@
 
     (GIT-MAINBRANCH?
 (GIT-WHICH-BRANCH
 PROJECT)
            PROJECT)
-    (FOR
 MF GF DEST (MEDLEYSUBDIRS
 _ (MEDLEYSUBDIRS
 PROJECT)) INSIDE
 MFILES
+    (FOR
 MF GF DEST (MEDLEYSUBDIRS
 ← (MEDLEYSUBDIRS
 PROJECT)) INSIDE
 MFILES
        COLLECT
 (SETQ MF (OR (FINDFILE MF NIL MEDLEYSUBDIRS)
                             (ERROR "FILE NOT FOUND" MF)))
              (CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME 'VERSION NIL 'BODY MF))
@@ -709,7 +734,7 @@
     (* ;; "Does anybody call this?")

 
     (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-    (FOR
 GF MF DEST (GITSUBDIRS
 _ (GITSUBDIRS
 PROJECT)) INSIDE
 GFILES
+    (FOR
 GF MF DEST (GITSUBDIRS
 ← (GITSUBDIRS
 PROJECT)) INSIDE
 GFILES
        COLLECT
 (SETQ GF (OR (FINDFILE GF NIL GITSUBDIRS)
                             (ERROR "FILE NOT FOUND" GF)))
              (SETQ MF (MFILE4GFILE
 GF))
@@ -723,7 +748,7 @@
 )
 (DEFINEQ
 
-(MYMEDLEYSUBDIR

+(WORKINGSUBDIR

   [LAMBDA (SUBDIR STAR PROJECT)
                              (* ; "Edited 13-May-2022 10:40 by rmk")


                                                              (* ; "Edited  7-May-2022 23:15 by rmk")

     (UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH
 WHOST OF
 PROJECT)
@@ -742,8 +767,8 @@
                         "")])
 
 (STRIPDIR

-  [LAMBDA (FILE DIRECTORY)                                   (* ; "Edited 18-Jan-2022 16:09 by rmk")

-                                                             (* ; "Edited  8-Nov-2021 11:50 by rmk:")

+  [LAMBDA (FILE DIRECTORY)
                                   (* ; "Edited 18-Jan-2022 16:09 by rmk")


+                                                            (* ; "Edited  8-Nov-2021 11:50 by rmk:")

     (IF
 (STRPOS DIRECTORY FILE 1 NIL T NIL FILEDIRCASEARRAY)
         THEN
 (SUBSTRING FILE (ADD1 (NCHARS DIRECTORY)))
       ELSE
 FILE])
@@ -1023,7 +1048,7 @@
                        ": ")
                 (IF
 (EQ (CAR X)
                         'Comments)
-                    THEN
 (FOR
 CC (POS _ (POSITION T)) IN
 (CDR X)
+                    THEN
 (FOR
 CC (POS ← (POSITION T)) IN
 (CDR X)
                             DO
 (IF
 (EQ CC T)
                                    THEN
 (TERPRI T)
                                  ELSE
 (PRINTOUT T .TAB0 POS CC)))
@@ -1163,7 +1188,7 @@
 
     (* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2")

 
-    (GIT-COMMAND
 (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"­" BUTNOTBRANCH2 "%"")
+    (GIT-COMMAND
 (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"^" BUTNOTBRANCH2 "%"")
            NIL NIL PROJECT])
 
 (GIT-BRANCH-RELATIONS

@@ -1227,6 +1252,16 @@
                                              then
 (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
                                            else
 (SORT DATUM]
               (RETURN (LIST SUPERSETS EQUALS
])
+
+(GIT-MODIFIED

+  [LAMBDA (PROJECT)
                                          (* ; "Edited 25-Dec-2025 13:39 by rmk")

+
+    (* ;; 
+
 "A list of files that have been modified M or introduced but not committed ??.  see git help status")

+
+    (for
 X POS in
 (GIT-COMMAND
 "git status --porcelain")
+       when
 (SETQ POS (OR (STRPOS " M " X NIL NIL NIL T)
+                          (STRPOS "?? " X NIL NIL NIL T))) collect
 (SUBSTRING X POS])
 )
 
 
@@ -1353,7 +1388,7 @@
          (CL:WHEN (thereis
 B in
 BRANCHES suchthat
 (STRPOS "HEAD detached" B))
                 (PRINTOUT T "Execute %"git gc%" to eliminate a branch with a detached HEAD" T))
          (CL:WHEN EXCLUDEMERGED
-             (SETQ BRANCHES (for
 B (MAINBRANCH _ (GIT-MAINBRANCH
 PROJECT 'LOCAL)) in
 BRANCHES
+             (SETQ BRANCHES (for
 B (MAINBRANCH ← (GIT-MAINBRANCH
 PROJECT 'LOCAL)) in
 BRANCHES
                                when
 (EQUAL (GIT-COMMAND
 (CONCAT "git merge-base %"" B "%" %"" 
                                                                MAINBRANCH "%""))
                                            (GIT-COMMAND
 (CONCAT "git rev-parse %"" B "%"")))
@@ -1384,22 +1419,22 @@
                                                      " branches"])
 
 (GIT-BRANCH-MENU

-  [LAMBDA (BRANCHES TITLE PIN?)
                              (* ; "Edited  1-May-2024 14:36 by rmk")


+  [LAMBDA (BRANCHES TITLE)
                                   (* ; "Edited 18-Apr-2026 21:36 by rmk")


+                                                             (* ; "Edited  1-May-2024 14:36 by rmk")


                                                              (* ; "Edited  6-Jul-2023 22:31 by rmk")


                                                              (* ; "Edited 30-Jun-2023 16:58 by rmk")


                                                              (* ; "Edited 18-May-2022 13:44 by rmk")

     (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
-        (CL:WHEN PIN?
-            [SETQ BRANCHES (APPEND BRANCHES '(("      Pin menu" 'PinMenu])
         (create
 MENU
-               TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
+               TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
                                         " branches"))
-               ITEMS _ BRANCHES
-               MENUFONT _ DEFAULTFONT
-               WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
+               ITEMS ← BRANCHES
+               MENUFONT ← DEFAULTFONT
+               WHENSELECTEDFN ← (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
 
 (GIT-BRANCH-WHENSELECTEDFN

-  [LAMBDA (ITEM MENU BUTTON)
                                 (* ; "Edited  2-Oct-2025 23:08 by rmk")


+  [LAMBDA (ITEM MENU BUTTON)
                                 (* ; "Edited 16-Mar-2026 12:05 by rmk")


+                                                             (* ; "Edited  2-Oct-2025 23:08 by rmk")


                                                              (* ; "Edited 30-Sep-2025 14:58 by rmk")


                                                              (* ; "Edited 21-Mar-2025 19:07 by rmk")


                                                              (* ; "Edited 11-May-2024 11:05 by rmk")


@@ -1410,9 +1445,11 @@
 
     (LET [(PR (CAR (LAST ITEM]
          (if
 (EQ BUTTON 'MIDDLE)
-             then
 (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/" (fetch
 (PULLREQUEST
-                                                                                         PRNUMBER)
-                                                                                    of
 PR)))
+             then
 (ShellOpen (CONCAT "https://github.com/Interlisp/"
+                                    (L-CASE (GIT-GET-PROJECT
 (fetch
 PRPROJECT of
 PR)
+                                                   'PROJECTNAME))
+                                    "/pull/"
+                                    (fetch
 (PULLREQUEST PRNUMBER) of
 PR)))
            else
 
                 (* ;; "This prints notices in its own TTY window")

 
@@ -1446,20 +1483,20 @@
             eachtime
 [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] when
 (OR INCLUDEDRAFTS
                                                                               (NOT DRAFT))
             collect
 [SETQ PR (create
 PULLREQUEST
-                                    PRNUMBER _ (JSON-GET JSOBJ 'number)
-                                    PRNAME _ (JSON-GET JSOBJ 'headRefName)
-                                    PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
-                                    PRSTATUS _ (CL:IF DRAFT
+                                    PRNUMBER ← (JSON-GET JSOBJ 'number)
+                                    PRNAME ← (JSON-GET JSOBJ 'headRefName)
+                                    PRDESCRIPTION ← (JSON-GET JSOBJ 'title)
+                                    PRSTATUS ← (CL:IF DRAFT
                                                    'D
                                                    (SELECTQ (MKATOM (JSON-GET JSOBJ 'reviewDecision))
-                                                       (CHANGES¬REQUESTED 
+                                                       (CHANGES_REQUESTED 
                                                             'C)
-                                                       (REVIEW¬REQUIRED 
+                                                       (REVIEW_REQUIRED 
                                                             " ")
                                                        'A))
-                                    PRPROJECT _ PROJECT
-                                    PRURL _ (JSON-GET JSOBJ 'url)
-                                    PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login]
+                                    PRPROJECT ← PROJECT
+                                    PRURL ← (JSON-GET JSOBJ 'url)
+                                    PRLOGIN ← (JSON-GET JSOBJ '(headRepositoryOwner login]
                   (CL:WHEN (STRPOS ":" (fetch
 (PULLREQUEST PRNAME) of
 PR))
 
                       (* ;; "From Nick:  Git commands to bring install and deal with the remotes:")

@@ -1510,8 +1547,8 @@
         (LET ((RELATIONS (GIT-BRANCH-RELATIONS
 (for
 PR in
 PRS
                                                   collect
 (GITORIGIN
 (fetch
 PRNAME of
 PR)))
                                 NIL T PROJECT)))
-             (SORT (for
 PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
-                        (EQUALS _ (CADR RELATIONS)) in
 PRS
+             (SORT (for
 PR REL LABEL PRNAME STATUS (SUPERSETS ← (CAR RELATIONS))
+                        (EQUALS ← (CADR RELATIONS)) in
 PRS
                       eachtime
 (SETQ PRNAME (fetch
 PRNAME of
 PR))
                             (SETQ LABEL (CONCAT "#" (fetch
 (PULLREQUEST PRNUMBER) of
 PR)
                                                " "
@@ -1558,15 +1595,33 @@
     (GIT-BRANCH-NUM
 (OR BRANCH (GIT-WHICH-BRANCH
 PROJECT T])
 
 (GIT-MY-NEXT-BRANCH

-  [LAMBDA (PROJECT)
                                          (* ; "Edited 19-May-2022 14:08 by rmk")


+  [LAMBDA (PROJECT)
                                          (* ; "Edited  2-Mar-2026 14:00 by rmk")


+                                                             (* ; "Edited 19-May-2022 14:08 by rmk")


                                                              (* ; "Edited  8-Jan-2022 09:43 by rmk")

 
     (* ;; "Figures out the number of my next incremental branch would be.  ")

 
     (PACK* (GIT-INITIALS
)
-           (ADD1 (OR (GIT-MY-BRANCHP
 (GIT-MY-CURRENT-BRANCH
 PROJECT)
-                            PROJECT)
-                     0])
+           (LET (PROJECTLIST PROJECTENTRY NEXTNUM)
+                (CL:WITH-OPEN-FILE (STRM "{LI}GIT-MY-CURRENT-BRANCH-NUMS;1" :DIRECTION :IO 
+                                         :IF-DOES-NOT-EXIST :CREATE :IF-EXISTS :OVERWRITE)
+                       (SETQ PROJECTLIST (CL:UNLESS (EQ 0 (GETEOFPTR STRM))
+                                                (READ STRM)))
+                       (SETQ PROJECTENTRY (ASSOC (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME)
+                                                 PROJECTLIST))
+                       (CL:UNLESS PROJECTENTRY
+                           (SETQ PROJECTENTRY (LIST (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME)
+                                                    (OR (GIT-MY-BRANCHP
 (GIT-MY-CURRENT-BRANCH
 
+                                                                               PROJECT)
+                                                               PROJECT)
+                                                        0)))
+                           (push
 PROJECTLIST PROJECTENTRY))
+                       (SETQ NEXTNUM (ADD1 (CADR PROJECTENTRY)))
+                       (RPLACA (CDR PROJECTENTRY)
+                              NEXTNUM)
+                       (SETFILEPTR STRM 0)
+                       (PRINT PROJECTLIST STRM)
+                       NEXTNUM])
 
 (GIT-MY-BRANCHES

   [LAMBDA (PROJECT EXCLUDEMERGED INITS)
                      (* ; "Edited 19-May-2022 19:10 by rmk")

@@ -1647,14 +1702,14 @@
          (CL:WHEN (STRPOS "fatal: " (CAR LINES)
                          1 NIL T)
                 (ERROR "Could not remove worktree for " BRANCH))
-                                                             (* (DELFILE (CONCAT PATH "/.DS_Store"))
+                                                             (* (DELFILE (CONCAT PATH "/.DS←Store"))
 
                                                             (GIT-COMMAND (CONCAT "rmdir " DIR) NIL 
 
                                                             NIL PROJECT))

          BRANCH])
 
 (GIT-LIST-WORKTREES

-  [LAMBDA NIL                                                (* ; "Edited 12-Dec-2021 12:13 by rmk")

-                                                             (* ; "Edited 19-Nov-2021 18:53 by rmk:")

+  [LAMBDA NIL
                                                (* ; "Edited 12-Dec-2021 12:13 by rmk")


+                                                            (* ; "Edited 19-Nov-2021 18:53 by rmk:")

 
     (* ;; "The git command tells us what the clone thinks about it, but then we look to see what is actually in our worktrees directory, to make sure that the subdirectory wasn't deleted in a wy that the clone didn't know about.")

 
@@ -1880,14 +1935,14 @@
 
                                                    (replace
 (CDENTRY INFO2) of
 CDE
                                                       with
 (create
 CDINFO
-                                                                  FULLNAME _ (CADR MAP)
-                                                                  DATE _ (CL:IF (EQ 'R (CADDR MAP))
+                                                                  FULLNAME ← (CADR MAP)
+                                                                  DATE ← (CL:IF (EQ 'R (CADDR MAP))
                                                                              " <-"
                                                                              " ==")
-                                                                  LENGTH _ ""
-                                                                  AUTHOR _ ""
-                                                                  TYPE _ ""
-                                                                  EOL _ ""))
+                                                                  LENGTH ← ""
+                                                                  AUTHOR ← ""
+                                                                  TYPE ← ""
+                                                                  EOL ← ""))
                                                    (replace
 (CDENTRY DATEREL) of
 CDE
                                                       with
 (CADDR MAP]
                   (TERPRI T)
@@ -1915,6 +1970,8 @@
 (GIT-WORKING-COMPARE-DIRECTORIES

   [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
 
+    (* ;; "Edited 29-Apr-2026 08:46 by rmk")

+
     (* ;; "Edited 28-Oct-2025 14:00 by rmk")

 
     (* ;; "Edited 25-Oct-2025 23:32 by rmk")

@@ -1925,18 +1982,12 @@
 
     (* ;; "Edited 26-Sep-2023 22:41 by rmk")

 
-    (* ;; "Edited 17-Jun-2023 22:54 by rmk")

-
-    (* ;; "Edited 10-Jun-2023 21:32 by rmk")

-
     (* ;; "Edited 20-Jul-2022 21:18 by rmk")

 
     (* ;; "Edited 25-Jun-2022 21:37 by rmk")

 
     (* ;; "Edited 17-May-2022 17:39 by rmk")

 
-    (* ;; "Edited 10-May-2022 10:41 by rmk")

-
     (* ;; 
 
  "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")

 
@@ -1956,19 +2007,21 @@
     (LET ((SUBDIRSTRING (if
 (EQ SUBDIRS 'all)
                             then
 (SETQ SUBDIRS (ALLSUBDIRS
 PROJECT))
                                  "ALL subdirectories"
-                          else
 SUBDIRS)))
-         (for
 SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
+                          else
 SUBDIRS))
+          (EXCLUSIONS))
+         (for
 SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                                                     T)))
-              (NENTRIES _ 0)
-              (BRANCH2 _ (GIT-WHICH-BRANCH
 PROJECT T))
+              (NENTRIES ← 0)
+              (BRANCH2 ← (GIT-WHICH-BRANCH
 PROJECT T))
             first
 (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
                   (BKSYSBUF " ") inside
 SUBDIRS
             collect
 (TERPRI T)
-                  (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR
 SUBDIR T PROJECT)
+                  (SETQ CDVAL (COMPAREDIRECTORIES (WORKINGSUBDIR
 SUBDIR T PROJECT)
                                      (GITSUBDIR
 SUBDIR T PROJECT)
                                      (OR SELECT '(> < ~= -* *-))
                                      '(*.* *>*.* .* *>.*)
-                                     (for
 E DPOS in
 (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS)
+                                     (for
 E DPOS in
 (APPEND (MKLIST EXCLUDEDFILES)
+                                                           (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS))
                                         collect
 (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
                                                                                  'DIRECTORY)
                                                                   1 NIL T T FILEDIRCASEARRAY))
@@ -2132,12 +2185,12 @@
                                            NIL]
          (CL:WHEN (OR COPYITEM COMPAREITEMS)
              (SELECTQ (MENU (CREATE
 MENU
-                                   TITLE _ (CONCAT (WINDOWPROP WINDOW 'SUBDIR)
+                                   TITLE ← (CONCAT (WINDOWPROP WINDOW 'SUBDIR)
                                                   "/"
                                                   (FETCH
 MATCHNAME OF
 CDENTRY))
-                                   ITEMS _ (APPEND COPYITEM COMPAREITEMS)
-                                   MENUFONT _ FONT
-                                   MENUTITLEFONT _ FONT))
+                                   ITEMS ← (APPEND COPYITEM COMPAREITEMS)
+                                   MENUFONT ← FONT
+                                   MENUTITLEFONT ← FONT))
                  (TOGIT (CL:WHEN (TOGIT
 (FETCH
 (CDINFO FULLNAME) OF
 INFO1)
                                         WINDOW)
                             (IMAGEOBJPROP OBJ 'COPIED T)
@@ -2162,18 +2215,18 @@
                  NIL)))])
 
 (GIT-CD-LABELFN

-  [LAMBDA (FILE1 FILE2 USERDATA)                             (* ; "Edited  5-Jan-2022 15:10 by rmk")

-                                                             (* ; "Edited 16-Dec-2021 12:25 by rmk")

+  [LAMBDA (FILE1 FILE2 USERDATA)
                             (* ; "Edited  5-Jan-2022 15:10 by rmk")


+                                                             (* ; "Edited 16-Dec-2021 12:25 by rmk")


                                                              (* ; "Edited 13-Dec-2021 22:13 by rmk")

     (DECLARE
 (USEDFREE CDVALUE))
     (LET (NC B LABEL1 LABEL2)
          (CL:WHEN (SETQ NC (FETCH
 NCDIR OF
 (FETCH
 CDMAXNC1 OF
 CDVALUE)))
-             (SETQ LABEL1 (SLASHIT
 (SUBSTRING FILE1 (ADD1 NC))
+             (SETQ LABEL1 (SLASHIT (SUBSTRING FILE1 (ADD1 NC))
                                  T))
              (CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH1))
                  (SETQ LABEL1 (CONCAT B "/" LABEL1))))
          (CL:WHEN (SETQ NC (FETCH
 NCDIR OF
 (FETCH
 CDMAXNC2 OF
 CDVALUE)))
-             (SETQ LABEL2 (SLASHIT
 (SUBSTRING FILE2 (ADD1 NC))
+             (SETQ LABEL2 (SLASHIT (SUBSTRING FILE2 (ADD1 NC))
                                  T))
              (CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH2))
                  (SETQ LABEL2 (CONCAT B "/" LABEL2))))
@@ -2181,7 +2234,7 @@
                (OR LABEL2 FILE2])
 
 (GIT-CD-MENUFN

-  [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
                    (* ; "Edited 28-Oct-2025 11:50 by rmk")


+  [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
                    (* ; "Edited 28-Oct-2025 11:30 by rmk")


                                                              (* ; "Edited 25-Oct-2025 23:44 by rmk")


                                                              (* ; "Edited 21-Sep-2022 21:34 by rmk")


                                                              (* ; "Edited 22-May-2022 19:13 by rmk")


@@ -2190,9 +2243,32 @@
 
     (* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo).  The selector for the selectq is either the CAR of the extrainfo or the display atom")

 
-    (DECLARE
 (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW))
+    (DECLARE
 (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA))
     (SELECTQ (OR (CADDR MENUITEM)
                  (CAR MENUITEM))
+        (Delete% -> (FLASHWINDOW PWINDOW)
+                    (GIVE.TTY.PROCESS PWINDOW)
+                    (CL:WHEN [OR (EQ KEY 'MIDDLE)
+                                 (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "]
+                        (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T)))
+        (|Delete ALL <-| 
+             (FLASHWINDOW PWINDOW)
+             (GIVE.TTY.PROCESS PWINDOW)
+             (if
 (NAMEFIELD LABEL1 T)
+                 then
 (CL:WHEN [OR (EQ KEY 'MIDDLE)
+                                   (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of "
+                                                                 (NAMEFIELD LABEL1 T)
+                                                                 " ? "]
+                          (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T))
+               else
 (PRINTOUT T "Nothing to delete")))
+        (Delete% BOTH (FLASHWINDOW PWINDOW)
+                      (GIVE.TTY.PROCESS PWINDOW)
+                      (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT 
+                                                             "Delete all Medley and git versions of "
+                                                             (NAMEFIELD LABEL1 T)
+                                                             " ? ")))
+                          (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T)
+                          (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T T)))
         (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
         (SHOULDNT])
 
@@ -2367,15 +2443,15 @@
                  NIL])
 
 (GIT-RESULT-TO-LINES

-  [LAMBDA (FILE ALL)
                                         (* ; "Edited 31-Mar-2025 15:19 by rmk")


+  [LAMBDA (FILE ALL)
                                         (* ; "Edited 25-Feb-2026 23:24 by rmk")


+                                                             (* ; "Edited 31-Mar-2025 15:19 by rmk")


                                                              (* ; "Edited 16-Jul-2022 22:21 by rmk")

 
     (* ;; "Suppress .git lines unless ALL  SYSTEM-EXTERNALFORMAT may make the wrong guess, but at least we ensure here that lines get broken.")

 
     (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (LIST (SYSTEM-EXTERNALFORMAT)
                                                                              'ANY))
-           (bind
 LINE until
 (EOFP STREAM) when
 [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P 
-                                                                        NIL :EOF-VALUE NIL))
+           (bind
 LINE until
 (EOFP STREAM) when
 [PROGN (SETQ LINE (CL:READ-LINE STREAM NIL))
                                                       (OR ALL (NOT (STRPOS ".git" LINE 1]
               collect
 LINE])
 
@@ -2394,32 +2470,33 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 . 
-14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632
- . 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112
- . 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 (
-ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 (
-TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR 
-37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) (
-STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) (
-GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) (
-GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS? 
-46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973
- . 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 . 
-52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) (
-GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324
- . 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197
-) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) (
-GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME 
-78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 (
-GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004)
- (GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE 
-87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 (
-GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) (
-GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) (
-GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) (
-GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) (
-GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 . 
-125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 . 
-129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524)))))
+  (FILEMAP (NIL (4257 21537 (GIT-CLONEP 4267 . 5698) (GIT-INIT 5700 . 6330) (GIT-MAKE-PROJECT 6332 . 
+14591) (GIT-GET-PROJECT 14593 . 16518) (GIT-PUT-PROJECT-FIELD 16520 . 18161) (GIT-PROJECT-PATH 18163
+ . 19207) (FIND-ANCESTOR-DIRECTORY 19209 . 19560) (GIT-FIND-CLONE 19562 . 20645) (GIT-MAINBRANCH 20647
+ . 21042) (GIT-MAINBRANCH? 21044 . 21535)) (26309 33483 (PRC-COMMAND 26319 . 31601) (GIT-GWC-COMMAND 
+31603 . 33481)) (33539 36327 (ALLSUBDIRS 33549 . 34835) (MEDLEYSUBDIRS 34837 . 35530) (GITSUBDIRS 
+35532 . 36325)) (36328 38733 (TOGIT 36338 . 37746) (FROMGIT 37748 . 38731)) (38734 41743 (
+WORKINGSUBDIR 38744 . 39199) (GITSUBDIR 39201 . 39644) (STRIPDIR 39646 . 40024) (STRIPHOST 40026 . 
+40266) (STRIPNAME 40268 . 41021) (STRIPWHERE 41023 . 41741)) (41744 43979 (GFILE4MFILE 41754 . 42450) 
+(MFILE4GFILE 42452 . 43021) (GIT-REPO-FILENAME 43023 . 43977)) (44028 54285 (GIT-COMMIT 44038 . 44864)
+ (GIT-PUSH 44866 . 45626) (GIT-PULL 45628 . 46380) (GIT-APPROVAL 46382 . 46731) (GIT-GET-FILE 46733 . 
+48648) (GIT-FILE-EXISTS? 48650 . 48924) (GIT-REMOTE-UPDATE 48926 . 49761) (GIT-REMOTE-ADD 49763 . 
+50070) (GIT-FILE-DATE 50072 . 51119) (GIT-FILE-HISTORY 51121 . 53055) (GIT-PRINT-FILE-HISTORY 53057 . 
+54109) (GIT-FETCH 54111 . 54283)) (54315 66267 (GIT-BRANCH-DIFF 54325 . 61214) (GIT-COMMIT-DIFFS 61216
+ . 62107) (GIT-BRANCH-RELATIONS 62109 . 65793) (GIT-MODIFIED 65795 . 66265)) (66312 85259 (
+GIT-BRANCH-NUM 66322 . 66895) (GIT-CHECKOUT 66897 . 68183) (GIT-WHICH-BRANCH 68185 . 68592) (
+GIT-MAKE-BRANCH 68594 . 71173) (GIT-BRANCHES 71175 . 73772) (GIT-BRANCH-EXISTS? 73774 . 74645) (
+GIT-PICK-BRANCH 74647 . 75137) (GIT-BRANCH-MENU 75139 . 76040) (GIT-BRANCH-WHENSELECTEDFN 76042 . 
+77749) (GIT-PULL-REQUESTS 77751 . 81636) (GIT-SHORT-BRANCH-NAME 81638 . 81929) (GIT-LONG-NAME 81931 . 
+82248) (GIT-PRC-BRANCHES 82250 . 85257)) (85289 90043 (GIT-MY-CURRENT-BRANCH 85299 . 85669) (
+GIT-MY-BRANCHP 85671 . 86289) (GIT-MY-NEXT-BRANCH 86291 . 88091) (GIT-MY-BRANCHES 88093 . 90041)) (
+90089 94173 (GIT-ADD-WORKTREE 90099 . 91706) (GIT-REMOVE-WORKTREE 91708 . 92640) (GIT-LIST-WORKTREES 
+92642 . 93453) (WORKTREEDIR 93455 . 94171)) (94221 128732 (GIT-GET-DIFFERENT-FILES 94231 . 101139) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 101141 . 108780) (GIT-WORKING-COMPARE-DIRECTORIES 108782 . 114597) (
+GIT-COMPARE-WORKTREE 114599 . 118577) (GITCDOBJBUTTONFN 118579 . 123077) (GIT-CD-LABELFN 123079 . 
+124165) (GIT-CD-MENUFN 124167 . 126713) (GIT-WORKING-COMPARE-FILES 126715 . 127335) (
+GIT-BRANCHES-COMPARE-FILES 127337 . 128501) (GIT-PR-COMPARE 128503 . 128730)) (128802 137133 (CDGITDIR
+ 128812 . 129499) (GIT-COMMAND 129501 . 131059) (GITORIGIN 131061 . 131758) (GIT-INITIALS 131760 . 
+132064) (GIT-COMMAND-TO-FILE 132066 . 135551) (GIT-RESULT-TO-LINES 135553 . 136466) (STRIPLOCAL 136468
+ . 137131)))))
 STOP

lispusers/HELPSYS

@@ -1,13 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
 
-
(FILECREATED "27-Jan-2026 13:21:10" {WMEDLEY}<lispusers>HELPSYS.;21
 88654  
+
(FILECREATED "20-Apr-2026 08:07:50" {MEDLEY}<lispusers>HELPSYS.;24
 89018  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS DOCS.LOOKUP GENERIC.MAN.LOOKUP)
-                  (VARS HELPSYSCOMS)
+      :CHANGES-TO (FNS REPO.LOOKUP)
 
-      :PREVIOUS-DATE " 5-May-2025 22:04:32" {WMEDLEY}<lispusers>HELPSYS.;15)
+      :PREVIOUS-DATE "27-Jan-2026 13:21:10" {MEDLEY}<lispusers>HELPSYS.;21)
 
 
 (PRETTYCOMPRINT HELPSYSCOMS)
@@ -340,21 +339,27 @@
                       else
 "git web--browse"])
 
 (REPO.LOOKUP

-  [LAMBDA (ENTRY TYPES)
                                      (* ; "Edited 13-Jan-2023 10:46 by lmm")


+  [LAMBDA (ENTRY TYPES)
                                      (* ; "Edited 20-Apr-2026 08:06 by rmk")


+                                                             (* ; "Edited 13-Jan-2023 10:46 by lmm")


                                                              (* ; "Edited 16-Aug-2022 16:26 by lmm")

-    (for
 FL in
 (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
-                             T)
-                      (LIST ENTRY)) bind
 POS FND
+    (for
 FL POS FND TSTREAM in
 (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
+                                             T)
+                                      (LIST ENTRY))
        when
 [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
                           (AND (SETQ POS (STRPOS "-" FL))
                                (FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
                                       NIL
                                       '(TEDIT TXT TTY TED]
-       join
 (CL:WITH-OPEN-FILE (STR (PATHNAME FND)
-                                    :DIRECTION :INPUT)
-                   (CL:WHEN (SETQ POS (FFILEPOS ENTRY STR))
-                       (TEDIT-SEE STR NIL NIL (CL:FORMAT NIL "~a [~a]" FL ENTRY))
-                       (LIST FL))])
+       collect
 (SETQ TSTREAM (OPENTEXTSTREAM FND))
+             [TEDIT TSTREAM NIL NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE
+                                            ,(CL:IF (EQ FL ENTRY)
+                                                 FL
+                                                 (CONCAT ENTRY " on " FL))]
+             (CL:UNLESS (EQ FL ENTRY)
+                 (CL:WHEN (SETQ POS (TEDIT.FIND TSTREAM ENTRY))
+                     (TEDIT.SETSEL TSTREAM POS (NCHARS ENTRY))
+                     (TEDIT.NORMALIZECARET TSTREAM)))
+             FL])
 )
 
 (RPAQQ CLHS.INDEX

@@ -1716,14 +1721,14 @@
 
 (PUTPROPS HELPSYS
 FILETYPE
 :FAKE-COMPILE-FILE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4640 10992 (HELPSYS 4650 . 6491) (IRM.LOOKUP 6493 . 8131) (GENERIC.MAN.LOOKUP 8133 . 
-10001) (IRM.SMART.LOOKUP 10003 . 10159) (IRM.RESET 10161 . 10570) (DOCS.LOOKUP 10572 . 10990)) (11249 
-18568 (CLHS.INDEX 11259 . 14223) (CLHS.LOOKUP 14225 . 16231) (CLHS.OPENER 16233 . 17556) (REPO.LOOKUP 
-17558 . 18566)) (71663 73181 (IRM.GET.DINFOGRAPH 71673 . 72548) (IRM.DISPLAY.REF 72550 . 73179)) (
-73183 73545 (IRM.LOAD-GRAPH 73183 . 73545)) (73870 79374 (IRM.DISPLAY.CREF 73880 . 75594) (
-IRM.CREF.BOX 75596 . 76423) (IRM.PUT.CREF 76425 . 76650) (IRM.GET.CREF 76652 . 77023) (
-IRM.CREF.BUTTONEVENTFN 77025 . 79372)) (79929 88235 (\IRM.GET.REF 79939 . 81270) (\IRM.SMART.REF 81272
- . 83199) (\IRM.CHOOSE.REF 83201 . 84452) (\IRM.WILD.REF 84454 . 85709) (\IRM.WILDCARD 85711 . 86077) 
-(\IRM.WILD.MATCH 86079 . 87309) (\IRM.GET.HASHFILE 87311 . 87774) (\IRM.GET.KEYWORDS 87776 . 88233)) (
-88372 88528 (\IRM.AROUND-EXIT 88372 . 88528)))))
+  (FILEMAP (NIL (4582 10934 (HELPSYS 4592 . 6433) (IRM.LOOKUP 6435 . 8073) (GENERIC.MAN.LOOKUP 8075 . 
+9943) (IRM.SMART.LOOKUP 9945 . 10101) (IRM.RESET 10103 . 10512) (DOCS.LOOKUP 10514 . 10932)) (11191 
+18932 (CLHS.INDEX 11201 . 14165) (CLHS.LOOKUP 14167 . 16173) (CLHS.OPENER 16175 . 17498) (REPO.LOOKUP 
+17500 . 18930)) (72027 73545 (IRM.GET.DINFOGRAPH 72037 . 72912) (IRM.DISPLAY.REF 72914 . 73543)) (
+73547 73909 (IRM.LOAD-GRAPH 73547 . 73909)) (74234 79738 (IRM.DISPLAY.CREF 74244 . 75958) (
+IRM.CREF.BOX 75960 . 76787) (IRM.PUT.CREF 76789 . 77014) (IRM.GET.CREF 77016 . 77387) (
+IRM.CREF.BUTTONEVENTFN 77389 . 79736)) (80293 88599 (\IRM.GET.REF 80303 . 81634) (\IRM.SMART.REF 81636
+ . 83563) (\IRM.CHOOSE.REF 83565 . 84816) (\IRM.WILD.REF 84818 . 86073) (\IRM.WILDCARD 86075 . 86441) 
+(\IRM.WILD.MATCH 86443 . 87673) (\IRM.GET.HASHFILE 87675 . 88138) (\IRM.GET.KEYWORDS 88140 . 88597)) (
+88736 88892 (\IRM.AROUND-EXIT 88736 . 88892)))))
 STOP

lispusers/ISO8859IO

@@ -1,26 +1,27 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Feb-2026 13:03:18" {WMEDLEY}<lispusers>ISO8859IO.;19
 23459  
+
(FILECREATED "22-Feb-2026 12:22:12" {WMEDLEY}<lispusers>ISO8859IO.;22
 21861  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \MAKERECODEMAP MAKEISOFORMAT \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN)
+      :CHANGES-TO (FNS ISO1TOMSTRING MTOISO1STRING)
                   (VARS ISO8859IOCOMS)
 
-      :PREVIOUS-DATE " 8-Aug-2021 13:22:31" {WMEDLEY}<lispusers>ISO8859IO.;11)
+      :PREVIOUS-DATE " 2-Feb-2026 23:20:20" {WMEDLEY}<lispusers>ISO8859IO.;20)
 
 
 (PRETTYCOMPRINT ISO8859IOCOMS)
 
 (RPAQQ ISO8859IOCOMS

        (
-        (* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.")

+        (* ;; "This package defines EXTERNALFORMATS for files that are encoded in ISIO8859/1, the standard IBM extended ascii, or the legacy MAC encoding.")

 
-        (COMS                                                (* ; "ISO8859/1")

-              (FNS \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN)
-              (GLOBALVARS *MCCSTOISO8859MAP* *ISO8859TOMCCSMAP*)
-              (FNS MAKEISOFORMAT)
-              (P (MAKEISOFORMAT)))
+        [COMS                                                (* ; "ISO8859/1")

+              (FNS ISO1TOMCODE MTOISO1CODE \CREATE.ISO1.FORMAT)
+              (FNS ISO1TOMSTRING MTOISO1STRING)
+              (VARS ISO1TOMCCS)
+              (GLOBALVARS ISO1TOMCCS)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.ISO1.FORMAT]
         (COMS                                                (* ; "IBM-PC Extended Ascii")

               (FNS \IBMOUTCHARFN \IBMINCCODEFN \IBMPEEKCCODEFN)
               (GLOBALVARS *XEROXTOIBMMAP* *IBMTOXEROXMAP*)
@@ -37,7 +38,7 @@
 
 
 (* ;; 
-"This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding."
+"This package defines EXTERNALFORMATS for files that are encoded in ISIO8859/1, the standard IBM extended ascii, or the legacy MAC encoding."
 )

 
 
@@ -47,152 +48,150 @@
 
 (DEFINEQ
 
-(\8859OUTCHARFN

-  [LAMBDA (STREAM CHARCODE)
-    (DECLARE
 (GLOBALVARS *XEROXTOISO8859MAP*))
               (* ; "Edited  1-Feb-2026 10:11 by rmk")


-                                                            (* ; "Edited  8-Aug-2021 13:21 by rmk:")

-                                                             (* ; "Edited  7-Dec-95 14:34 by ")

-                                                             (* ; "Edited  7-Dec-95 14:32 by ")

+(ISO1TOMCODE

+  [LAMBDA (ICODE)
                                            (* ; "Edited  5-Feb-2026 12:09 by rmk")


+                                                             (* ; "Edited  2-Feb-2026 23:14 by rmk")


+                                                             (* ; "Edited  7-Sep-2025 22:39 by rmk")


+                                                             (* ; "Edited  3-Sep-2025 10:21 by rmk")


+                                                             (* ; "Edited  7-Aug-2025 09:37 by rmk")

 
-    (* ;; "Converts CHARCODE from internal encoding to ISO8859 before printing.")

+    (* ;; "ISO codes are 8bit, MCODES maybe not. Caller shouldn't pass a fat code.")

 
-    (* ;; "Unconverted codes are left unchanged (no error).")

+    (OR [CAR (find
 PAIR in
 ISO1TOMCCS suchthat
 (EQ ICODE (CADR PAIR]
+        ICODE])
 
-    (* ;; "If any remaining codes are out of charset 0, the streams external format will be used. ")

+(MTOISO1CODE

+  [LAMBDA (MCODE)
                                            (* ; "Edited  5-Feb-2026 12:26 by rmk")


+                                                             (* ; "Edited  2-Feb-2026 22:58 by rmk")

+    (OR (CADR (ASSOC MCODE ISO1TOMCCS))
+        MCODE])
 
-    (IF
 (EQ CHARCODE (CHARCODE EOL))
-        THEN
 (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
-             (\BOUTEOL STREAM)
-      ELSE
 (CHANGE
 (FFETCH
 (STREAM CHARPOSITION) OF
 STREAM)
-                  (IPLUS16 1 DATUM))
-           (\BOUT STREAM (IF
 (IGREATERP CHARCODE 127)
-                             THEN
 
-
-                                 (* ;; "We know that ISO doesn't have floating accents, so only singletons are returned.  We also know that it agrees with MCCS on first 128, except for cirumflex and underscore")

-
-                                  (\RECODECCODE
 CHARCODE *MCCSTOISO8859MAP*)
-                           ELSE
 CHARCODE])
-
-(\8859INCCODEFN

-  [LAMBDA (STRM COUNTP)
                                      (* ; "Edited  1-Feb-2026 10:10 by rmk")


-                                                            (* ; "Edited  6-Aug-2021 16:10 by rmk:")

-                                                             (* ; "Edited  7-Dec-95 15:24 by ")

-                                                             (* ; "Edited  7-Dec-95 15:19 by ")

-    (DECLARE
 (USEDFREE *BYTECOUNTER*))
-    (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
-    (\RECODECCODE
 (\BIN STRM)
-           *ISO8859TOMCCSMAP*])
-
-(\8859PEEKCCODEFN

-  [LAMBDA (STRM NOERROR)
                                     (* ; "Edited  1-Feb-2026 10:10 by rmk")


-                                                            (* ; "Edited  5-May-2021 17:44 by rmk:")

-                                                             (* ; "Edited  3-Jan-96 14:21 by ")

-                                                             (* ; "Edited  7-Dec-95 15:51 by ")

-                                                             (* ; "Edited  7-Dec-95 15:19 by ")

-    (\RECODECCODE
 (\PEEKCCODE STRM NOERROR)
-           *ISO8859TOMCCSMAP*])
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS *MCCSTOISO8859MAP* *ISO8859TOMCCSMAP*)
-)
-(DEFINEQ
-
-(MAKEISOFORMAT

-  [LAMBDA NIL
                                                (* ; "Edited  1-Feb-2026 11:18 by rmk")


+(\CREATE.ISO1.FORMAT

+  [LAMBDA NIL
                                                (* ; "Edited  5-Feb-2026 10:42 by rmk")


+                                                             (* ; "Edited  2-Feb-2026 23:37 by rmk")


+                                                             (* ; "Edited  1-Feb-2026 11:18 by rmk")


                                                             (* ; "Edited  5-Aug-2021 22:15 by rmk:")


                                                              (* ; "Edited  9-Mar-99 17:19 by rmk:")

                                                              (* ; "Edited  7-Dec-95 16:24 by ")

                                                              (* ; "Edited  7-Dec-95 16:20 by ")

-    (LET [(MCCSTOISO '(("0,255" "0,136")
-                       ("0,254" "0,137")
-                       ("357,41" "0,240")
-                       ("357,153" "0,246")
-                       ("43,42" "0,250")
-                       ("0,323" "0,251")
-                       ("0,343" "0,252")
-                       ("357,152" "0,254")
-                       ("357,43" "0,255")
-                       ("0,322" "0,256")
-                       ("43,176" "0,257")
-                       ("43,47" "0,264")
-                       ("0,313" "0,270")
-                       ("0,321" "0,271")
-                       ("0,353" "0.272")
-                       ("361,41" "0,300")
-                       ("361,42" "0,301")
-                       ("361,43" "0,302")
-                       ("361,44" "0,303")
-                       ("361,47" "0,304")
-                       ("361,50" "0,305")
-                       ("0,341" "0,306")
-                       ("361,55" "0,307")
-                       ("361,60" "0,310")
-                       ("361,61" "0,311")
-                       ("361,62" "0,312")
-                       ("361,65" "0,313")
-                       ("361,76" "0,314")
-                       ("361,77" "0,315")
-                       ("361,100" "0,316")
-                       ("361,104" "0,317")
-                       ("0,342" "0,320")
-                       ("361,114" "0,321")
-                       ("361,117" "0,322")
-                       ("361,120" "0,323")
-                       ("361,121" "0,324")
-                       ("361,122" "0,325")
-                       ("361,124" "0,326")
-                       ("0,264" "0,327")
-                       ("0,351" "0,330")
-                       ("361,137" "0,331")
-                       ("361,140" "0,332")
-                       ("361,141" "0,333")
-                       ("361,145" "0,334")
-                       ("361,153" "0,335")
-                       ("0,354" "0,336")
-                       ("0,373" "0,337")
-                       ("361,241" "0,340")
-                       ("361,242" "0,341")
-                       ("361,243" "0,342")
-                       ("361,244" "0,343")
-                       ("361,247" "0,344")
-                       ("361,250" "0,345")
-                       ("0,361" "0,346")
-                       ("361,255" "0,347")
-                       ("361,260" "0,350")
-                       ("361,261" "0,351")
-                       ("361,262" "0,352")
-                       ("361,265" "0,353")
-                       ("361,276" "0,354")
-                       ("361,277" "0,355")
-                       ("361,300" "0,356")
-                       ("361,304" "0,357")
-                       ("0,363" "0,360")
-                       ("361,314" "0,361")
-                       ("361,317" "0,362")
-                       ("361,320" "0,363")
-                       ("361,321" "0,364")
-                       ("361,322" "0,365")
-                       ("361,324" "0,366")
-                       ("0,270" "0,367")
-                       ("0,371" "0,370")
-                       ("361,337" "0,371")
-                       ("361,340" "0,372")
-                       ("361,341" "0,373")
-                       ("361,345" "0,374")
-                       ("361,353" "0,375")
-                       ("0,374" "0,376")
-                       ("361,355" "0,377")
-                       ("361,155" "Meta,170"]
-         (SETQ *MCCSTOISO8859MAP* (\MAKERECODEMAP
 MCCSTOISO))
-         (SETQ *ISO8859TOMCCSMAP* (\MAKERECODEMAP
 MCCSTOISO T)))
-    (MAKE-EXTERNALFORMAT :ISO8859/1 (FUNCTION \8859INCCODEFN)
-           (FUNCTION \8859PEEKCCODEFN)
-           (FUNCTION \COMMONBACKCCODEFN)
-           (FUNCTION \8859OUTCHARFN])
+    (MAKE-EXTERNALFORMAT :ISO8859/1 [FUNCTION (LAMBDA (STREAM COUNTP)
+                                                (ISO1TOMCODE
 (\THROUGHIN STREAM COUNTP]
+           [FUNCTION (LAMBDA (STREAM NOERRORFLG)
+                       (ISO1TOMCODE
 (\PEEKBIN STREAM NOERRORFLG]
+           (FUNCTION \THROUGHBACKCCODE)
+           (FUNCTION NILL)
+           (FUNCTION NILL)
+           NIL NIL (FUNCTION MTOISO1STRING)
+           NIL
+           (FUNCTION NILL)
+           (FUNCTION ISO1TOMSTRING])
+)
+(DEFINEQ
+
+(ISO1TOMSTRING

+  [LAMBDA (ISTRING DESTRUCTIVE)
                              (* ; "Edited 22-Feb-2026 12:21 by rmk")


+                                                             (* ; "Edited  5-Feb-2026 11:01 by rmk")


+                                                             (* ; "Edited  2-Feb-2026 23:46 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 12:14 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 13:08 by rmk")

+
+    (* ;; "Converts ISO8859/1 codes to MCCS codes in MSTRING.")

+
+    (for
 I ICODE (MSTRING _ (CL:IF DESTRUCTIVE
+                                ISTRING
+                                (CONCAT ISTRING))) from
 1 while
 (SETQ ICODE (NTHCHARCODE ISTRING I))
+       do
 (RPLCHARCODE MSTRING I (ISO1TOMCODE
 ICODE)) finally
 (RETURN MSTRING])
+
+(MTOISO1STRING

+  [LAMBDA (MSTRING DESTRUCTIVE)
                              (* ; "Edited 22-Feb-2026 12:22 by rmk")


+                                                             (* ; "Edited  2-Feb-2026 23:47 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 12:22 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 13:08 by rmk")

+
+    (* ;; "Converts MCCS to ISO8859/1 codes in MSTRING.")

+
+    (for
 I MCODE (ISTRING _ (CL:IF DESTRUCTIVE
+                                MSTRING
+                                (CONCAT MSTRING))) from
 1 while
 (SETQ MCODE (NTHCHARCODE MSTRING I))
+       do
 (RPLCHARCODE ISTRING I (MTOISO1CODE
 MCODE)) finally
 (RETURN ISTRING])
 )
 
-(MAKEISOFORMAT
)
+(RPAQQ ISO1TOMCCS

+       ((94 8593)
+        (95 8592)
+        (169 8216)
+        (170 8220)
+        (172 95)
+        (173 94)
+        (174 8594)
+        (175 8595)
+        (180 215)
+        (184 247)
+        (185 8217)
+        (186 8221)
+        (193 768)
+        (194 769)
+        (195 770)
+        (196 771)
+        (197 772)
+        (198 774)
+        (199 775)
+        (200 776)
+        (202 778)
+        (203 807)
+        (204 818)
+        (205 779)
+        (206 808)
+        (207 780)
+        (208 8213)
+        (209 185)
+        (210 174)
+        (211 169)
+        (212 8482)
+        (213 9834)
+        (220 8539)
+        (221 8540)
+        (222 8541)
+        (223 8542)
+        (224 8486)
+        (225 198)
+        (226 208)
+        (227 170)
+        (228 294)
+        (229 567)
+        (230 306)
+        (231 319)
+        (232 321)
+        (233 216)
+        (234 338)
+        (235 186)
+        (236 222)
+        (237 358)
+        (238 330)
+        (239 329)
+        (240 312)
+        (241 230)
+        (242 273)
+        (243 240)
+        (244 295)
+        (245 305)
+        (246 307)
+        (247 320)
+        (248 322)
+        (249 248)
+        (250 339)
+        (251 223)
+        (252 254)
+        (253 359)
+        (254 331)))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS ISO1TOMCCS)
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(\CREATE.ISO1.FORMAT
)
+)
 
 
 
@@ -553,10 +552,10 @@
                                                              (* ; "Edited 21-Jun-95 10:18 by rmk:")

 
     (* ;; "Recodes a singleton charcode.  Leaves everything else unchanged.")

-
-    (LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
-         (OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
-             CODE])
-)
-(DECLARE%: DONTCOPY
+
+    (LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
+         (OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
+             CODE])
+)
+(DECLARE%: DONTCOPY
   (FILEMAP (NIL (1834 4154 (ISO1TOMCODE 1844 . 2593) (MTOISO1CODE 2595 . 2885) (\CREATE.ISO1.FORMAT 2887

lispusers/UNIXYCD

@@ -1,24 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-
(FILECREATED "12-Aug-2022 12:29:18" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1
 568    
-
-      :CHANGES-TO (VARS UNIXYCDCOMS)
-
-      :PREVIOUS-DATE "12-Aug-2022 11:14:47" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
-
-
-(PRETTYCOMPRINT UNIXYCDCOMS)
-
-(RPAQQ UNIXYCDCOMS
 ((COMMANDS "cd" "ls" "pwd")))
-
-(DEFCOMMAND "cd"
 (DIR)
-   (/CNDIR DIR))
-
-(DEFCOMMAND "ls"
 (FIRST
 . REST)
-   (DODIR (CONS FIRST REST)))
-
-(DEFCOMMAND "pwd"
 ()
-   (DIRECTORYNAME T))
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL)))
-STOP

lispusers/UNIXYCD.LCOM

@@ -1,13 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-(FILECREATED "12-Aug-2022 12:29:30" ("compiled on " {DSK}<home>larry>medley>lispusers>UNIXYCD.;1) 
-"12-Aug-2022 10:18:11" bcompl'd in "Welcome to Fuller sysout 12-Aug-2022 ..." dated 
-"12-Aug-2022 10:22:21")
-(FILECREATED "12-Aug-2022 12:29:18" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1 568 :CHANGES-TO (VARS
- UNIXYCDCOMS) :PREVIOUS-DATE "12-Aug-2022 11:14:47" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
-(PRETTYCOMPRINT UNIXYCDCOMS)
-(RPAQQ UNIXYCDCOMS ((COMMANDS "cd" "ls" "pwd")))
-(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))
-(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST)))
-(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))
-NIL

lispusers/UNIXYCD.TXT

@@ -1,13 +0,0 @@
-	UNIXYCD & .LCOM .TXT
-
-
-This file implements little commands:
-
-cd               change Lisp's current directory to home
-cd dir           dir can be a path separated by / or >.
-                 if no "hostname" is given, it's assumed {DSK}
-ls [dir]         list current directory or a directory that's given
-                 non-feature: ls foo only prints foo; you need to
-		 specify        ls foo/
-pwd		 print working directory
-

lispusers/VERSIONDEFS

@@ -1,22 +1,21 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
 
-
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12
 5880   
+
(FILECREATED " 7-Mar-2026 22:55:43" {WMEDLEY}<lispusers>VERSIONDEFS.;18
 6534   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS GETVINFO)
-
-      :PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
+      :PREVIOUS-DATE " 6-Mar-2026 22:47:25" {WMEDLEY}<lispusers>VERSIONDEFS.;17)
 
 
 (PRETTYCOMPRINT VERSIONDEFSCOMS)
 
-(RPAQQ VERSIONDEFSCOMS
 [(FNS FINDFILEVERSION GETVINFO VERSIONP)
-                        (FNS EDV DFV)
-                        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
-                               (ADDVARS (NLAMA DFV EDV)
-                                      (NLAML)
-                                      (LAMA])
+(RPAQQ VERSIONDEFSCOMS

+       [(FNS FINDFILEVERSION GETVINFO VERSIONP)
+        (FNS EDV DFV)
+        (PROP ARGNAMES EDV DFV)
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DFV EDV)
+                                                                             (NLAML)
+                                                                             (LAMA])
 (DEFINEQ
 
 (FINDFILEVERSION

@@ -119,16 +118,26 @@
           (CAR VINFO])
 
 (DFV

-  [NLAMBDA ARGS
                                              (* ; "Edited  6-Dec-2024 21:29 by rmk")


+  [NLAMBDA ARGS
                                              (* ; "Edited  6-Mar-2026 22:42 by rmk")


+                                                             (* ; "Edited  6-Dec-2024 21:29 by rmk")


                                                              (* ; "Edited  2-Dec-2024 00:08 by rmk")

     (SETQ ARGS (MKLIST ARGS))
-    (APPLY (FUNCTION EDV)
-           (LIST (POP
 ARGS)
-                 NIL
-                 (POP
 ARGS)
-                 (POP
 ARGS)
-                 (POP
 ARGS])
+    (LET ((NAME (POP
 ARGS)))                                 (* ; "If FNS and FUNCTIONS, show both")

+         (CL:WHEN (HASDEF NAME 'FUNCTIONS '?)
+             (APPLY (FUNCTION EDV)
+                    (LIST NAME 'FUNCTIONS (POP
 ARGS)
+                          (POP
 ARGS)
+                          (POP
 ARGS))))
+         (CL:WHEN (HASDEF NAME 'FNS '?)
+             (APPLY (FUNCTION EDV)
+                    (LIST NAME 'FNS (POP
 ARGS)
+                          (POP
 ARGS)
+                          (POP
 ARGS))))])
 )
+
+(PUTPROPS EDV
 ARGNAMES
 (NAME TYPE FILE VERSION DIRLST . VINFO))
+
+(PUTPROPS DFV
 ARGNAMES
 (NAME FILE VERSION DIRLST . VINFO))
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 DFV EDV)
@@ -138,6 +147,6 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
-4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
+  (FILEMAP (NIL (706 4605 (FINDFILEVERSION 716 . 2163) (GETVINFO 2165 . 4288) (VERSIONP 4290 . 4603)) (
+4606 6230 (EDV 4616 . 5316) (DFV 5318 . 6228)))))
 STOP

obsolete/clos/2.0/braid.lisp

@@ -1,503 +0,0 @@
-;;;-*-Mode:LISP; Package:(CLOS (LISP WALKER)); Base:10; Syntax:Common-lisp -*-
-;;;
-;;; *************************************************************************
-;;; Copyright (c) 1991 Venue
-;;; All rights reserved.
-;;; *************************************************************************
-;;;
-;;; Bootstrapping the meta-braid.
-;;;
-;;; The code in this file takes the early definitions that have been saved
-;;; up and actually builds those class objects.  This work is largely driven
-;;; off of those class definitions, but the fact that STANDARD-CLASS is the
-;;; class of all metaclasses in the braid is built into this code pretty
-;;; deeply.
-;;;
-;;; 
-
-(in-package 'clos)
-
-(defun early-class-definition (class-name)
-  (or (find class-name *early-class-definitions* :key #'ecd-class-name)
-      (error "~S is not a class in *early-class-definitions*." class-name)))
-
-(defun canonical-slot-name (canonical-slot)
-  (getf canonical-slot :name))
-
-(defun early-collect-inheritance (class-name)
-  (declare (values slots cpl default-initargs direct-subclasses))
-  (let ((cpl (early-collect-cpl class-name)))
-    (values (early-collect-slots cpl)
-	    cpl
-	    (early-collect-default-initargs cpl)
-	    (gathering1 (collecting)
-	      (dolist (definition *early-class-definitions*)
-		(when (memq class-name (ecd-superclass-names definition))
-		  (gather1 (ecd-class-name definition))))))))
-
-(defun early-collect-cpl (class-name)
-  (labels ((walk (c)
-	     (let* ((definition (early-class-definition c))
-		    (supers (ecd-superclass-names definition)))
-	       (cons c
-		     (apply #'append (mapcar #'early-collect-cpl supers))))))
-    (remove-duplicates (walk class-name) :from-end nil :test #'eq)))
-
-(defun early-collect-slots (cpl)
-  (let* ((definitions (mapcar #'early-class-definition cpl))
-	 (super-slots (mapcar #'ecd-canonical-slots definitions))
-	 (slots (apply #'append (reverse super-slots))))
-    (dolist (s1 slots)
-      (let ((name1 (canonical-slot-name s1)))
-	(dolist (s2 (cdr (memq s1 slots)))
-	  (when (eq name1 (canonical-slot-name s2))
-	    (error "More than one early class defines a slot with the~%~
-                    name ~S.  This can't work because the bootstrap~%~
-                    object system doesn't know how to compute effective~%~
-                    slots."
-		   name1)))))
-    slots))
-
-(defun early-collect-default-initargs (cpl)
-  (let ((default-initargs ()))
-    (dolist (class-name cpl)
-      (let ((definition (early-class-definition class-name)))
-	(dolist (option (ecd-other-initargs definition))
-	  (unless (eq (car option) :default-initargs)
-	    (error "The defclass option ~S is not supported by the bootstrap~%~
-                    object system."
-		   (car option)))
-	  (setq default-initargs
-		(nconc default-initargs (reverse (cdr option)))))))
-    (reverse default-initargs)))
-
-
-;;;
-;;; bootstrap-get-slot and bootstrap-set-slot are used to access and change
-;;; the values of slots during bootstrapping.  During bootstrapping, there
-;;; are only two kinds of objects whose slots we need to access, CLASSes
-;;; and SLOTDs.  The first argument to these functions tells whether the
-;;; object is a CLASS or a SLOTD.
-;;;
-;;; Note that the way this works it stores the slot in the same place in
-;;; memory that the full object system will expect to find it later.  This
-;;; is critical to the bootstrapping process, the whole changeover to the
-;;; full object system is predicated on this.
-;;;
-;;; One important point is that the layout of standard classes and standard
-;;; slots must be computed the same way in this file as it is by the full
-;;; object system later.
-;;; 
-(defun bootstrap-get-slot (type object slot-name)
-  (let ((index (bootstrap-slot-index type slot-name)))
-    (svref (std-instance-slots object) index)))
-
-(defun bootstrap-set-slot (type object slot-name new-value)
-  (let ((index (bootstrap-slot-index type slot-name)))
-    (setf (svref (std-instance-slots object) index) new-value)))
-
-(defvar *std-class-slots*
-	(mapcar #'canonical-slot-name
-		(early-collect-inheritance 'standard-class)))
-
-(defvar *bin-class-slots*
-	(mapcar #'canonical-slot-name
-		(early-collect-inheritance 'built-in-class)))
-
-(defvar *std-slotd-slots*
-	(mapcar #'canonical-slot-name
-		(early-collect-inheritance 'standard-slot-definition)))
-
-(defun bootstrap-slot-index (type slot-name)
-  (or (position slot-name (ecase type
-			    (std-class *std-class-slots*)
-			    (bin-class *bin-class-slots*)
-			    (std-slotd *std-slotd-slots*)))
-      (error "~S not found" slot-name)))
-
-
-;;;
-;;; bootstrap-meta-braid
-;;;
-;;; This function builds the base metabraid from the early class definitions.
-;;;   
-(defun bootstrap-meta-braid ()
-  (let* ((std-class-size (length *std-class-slots*))
-         (std-class (%allocate-instance--class std-class-size))
-         (std-class-wrapper (make-wrapper std-class))
-	 (built-in-class (%allocate-instance--class std-class-size))
-	 (built-in-class-wrapper (make-wrapper built-in-class))
-	 (direct-slotd    (%allocate-instance--class std-class-size))
-	 (effective-slotd (%allocate-instance--class std-class-size))
-	 (direct-slotd-wrapper    (make-wrapper direct-slotd))
-	 (effective-slotd-wrapper (make-wrapper effective-slotd)))
-    ;;
-    ;; First, make a class metaobject for each of the early classes.  For
-    ;; each metaobject we also set its wrapper.  Except for the class T,
-    ;; the wrapper is always that of STANDARD-CLASS.
-    ;; 
-    (dolist (definition *early-class-definitions*)
-      (let* ((name (ecd-class-name definition))
-	     (meta (ecd-metaclass definition))
-             (class (case name
-                      (standard-class                     std-class)
-                      (standard-direct-slot-definition    direct-slotd)
-		      (standard-effective-slot-definition effective-slotd)
-		      (built-in-class                     built-in-class)
-                      (otherwise
-			(%allocate-instance--class std-class-size)))))
-	(unless (eq name t)
-	  (inform-type-system-about-class class name))
-	(setf (std-instance-wrapper class)
-	      (ecase meta
-		(standard-class std-class-wrapper)
-		(built-in-class built-in-class-wrapper)))
-        (setf (find-class name) class)))
-    ;;
-    ;;
-    ;;
-    (dolist (definition *early-class-definitions*)
-      (let ((name (ecd-class-name definition))
-	    (source (ecd-source definition))
-	    (direct-supers (ecd-superclass-names definition))
-	    (direct-slots  (ecd-canonical-slots definition))
-	    (other-initargs (ecd-other-initargs definition)))
-	(let ((direct-default-initargs
-		(getf other-initargs :default-initargs)))
-	  (multiple-value-bind (slots cpl default-initargs direct-subclasses)
-	      (early-collect-inheritance name)
-	    (let* ((class (find-class name))
-		   (wrapper
-		     (cond
-		       ((eq class std-class)       std-class-wrapper)
-		       ((eq class direct-slotd)    direct-slotd-wrapper)
-		       ((eq class effective-slotd) effective-slotd-wrapper)
-		       ((eq class built-in-class)  built-in-class-wrapper)
-		       (t (make-wrapper class))))
-		   (proto nil))
-	      (cond ((eq name 't)
-		     (setq *the-wrapper-of-t* wrapper
-			   *the-class-t* class))
-		    ((memq name '(standard-object 
-				  standard-class
-				  standard-effective-slot-definition))
-		     (set (intern (format nil "*THE-CLASS-~A*" (symbol-name name))
-				  *the-clos-package*)
-			  class)))
-	      (dolist (slot slots)
-		(unless (eq (getf slot :allocation :instance) :instance)
-		  (error "Slot allocation ~S not supported in bootstrap.")))
-	      
-	      (setf (wrapper-instance-slots-layout wrapper)
-		    (mapcar #'canonical-slot-name slots))
-	      (setf (wrapper-class-slots wrapper)
-		    ())
-	      
-	      (setq proto (%allocate-instance--class (length slots)))
-	      (setf (std-instance-wrapper proto) wrapper)
-	    
-	      (setq direct-slots
-		    (bootstrap-make-slot-definitions name direct-slots
-						     direct-slotd-wrapper nil))
-	      (setq slots
-		    (bootstrap-make-slot-definitions name slots
-						     effective-slotd-wrapper t))
-	      
-	      (bootstrap-initialize-std-class
-		class name source
-		direct-supers direct-subclasses cpl wrapper
-		direct-slots slots direct-default-initargs default-initargs
-		proto)
-	      
-	      (dolist (slotd direct-slots)
-		(bootstrap-accessor-definitions
-		  name
-		  (bootstrap-get-slot 'std-slotd slotd 'name)
-		  (bootstrap-get-slot 'std-slotd slotd 'readers)
-		  (bootstrap-get-slot 'std-slotd slotd 'writers))))))))))
-
-(defun bootstrap-accessor-definitions (class-name slot-name readers writers)
-  (flet ((do-reader-definition (reader)
-	   (add-method
-	     (ensure-generic-function reader)
-	     (make-a-method
-	       'standard-reader-method
-	       ()
-	       (list class-name)
-	       (list class-name)
-	       (make-std-reader-method-function slot-name)
-	       "automatically generated reader method"
-	       slot-name)))
-	 (do-writer-definition (writer)
-	   (add-method
-	     (ensure-generic-function writer)
-	     (make-a-method
-	       'standard-writer-method
-	       ()
-	       (list 'new-value class-name)
-	       (list 't class-name)
-	       (make-std-writer-method-function slot-name)
-	       "automatically generated writer method"
-	       slot-name))))
-    (dolist (reader readers) (do-reader-definition reader))
-    (dolist (writer writers) (do-writer-definition writer))))
-
-;;;
-;;; Initialize a standard class metaobject.
-;;;
-(defun bootstrap-initialize-std-class
-       (class
-	name definition-source direct-supers direct-subclasses cpl wrapper
-	direct-slots slots direct-default-initargs default-initargs proto)
-  (flet ((classes (names) (mapcar #'find-class names))
-	 (set-slot (slot-name value)
-	   (bootstrap-set-slot 'std-class class slot-name value)))
-    
-    (set-slot 'name name)
-    (set-slot 'source definition-source)
-    (set-slot 'class-precedence-list (classes cpl))
-    (set-slot 'direct-superclasses (classes direct-supers))
-    (set-slot 'direct-slots direct-slots)
-    (set-slot 'direct-subclasses (classes direct-subclasses))
-    (set-slot 'direct-methods (cons nil nil))
-    (set-slot 'no-of-instance-slots (length slots))
-    (set-slot 'slots slots)
-    (set-slot 'wrapper wrapper)
-    (set-slot 'prototype proto)
-    (set-slot 'plist
-	      `(,@(and direct-default-initargs
-		       `(direct-default-initargs ,direct-default-initargs))
-		,@(and default-initargs
-		       `(default-initargs ,default-initargs))))
-    ))
-
-;;;
-;;; Initialize a built-in-class metaobject.
-;;;
-(defun bootstrap-initialize-bin-class
-       (class
-	name definition-source direct-supers direct-subclasses cpl wrapper)
-  (flet ((classes (names) (mapcar #'find-class names))
-	 (set-slot (slot-name value)
-	   (bootstrap-set-slot 'bin-class class slot-name value)))
-    
-    (set-slot 'name name)
-    (set-slot 'source definition-source)
-    (set-slot 'direct-superclasses (classes direct-supers))
-    (set-slot 'direct-subclasses (classes direct-subclasses))
-    (set-slot 'direct-methods (cons nil nil))
-    (set-slot 'class-precedence-list (classes cpl))
-    (set-slot 'wrapper wrapper)))
-
-(defun bootstrap-make-slot-definitions (name slots wrapper e-p)
-  (mapcar #'(lambda (slot) (bootstrap-make-slot-definition name slot wrapper e-p))
-          slots))
-
-(defun bootstrap-make-slot-definition (name slot wrapper e-p)  
-  (let ((slotd (%allocate-instance--class (length *std-slotd-slots*))))
-    (setf (std-instance-wrapper slotd) wrapper)
-    (flet ((get-val (name) (getf slot name))
-	   (set-val (name val) (bootstrap-set-slot 'std-slotd slotd name val)))
-      (set-val 'name         (get-val :name))
-      (set-val 'initform     (get-val :initform))
-      (set-val 'initfunction (get-val :initfunction))      
-      (set-val 'initargs     (get-val :initargs))
-      (set-val 'readers      (get-val :readers))
-      (set-val 'writers      (get-val :writers))
-      (set-val 'allocation   :instance)
-      (set-val 'type         (get-val :type))
-      (set-val 'class        nil)
-      (set-val 'instance-index nil)
-      (when (and (eq name 'standard-class) (eq (get-val :name) 'slots) e-p)
-	(setq *the-eslotd-standard-class-slots* slotd))
-      slotd)))
-
-(defun bootstrap-built-in-classes ()
-  ;;
-  ;; First make sure that all the supers listed in *built-in-class-lattice*
-  ;; are themselves defined by *built-in-class-lattice*.  This is just to
-  ;; check for typos and other sorts of brainos.
-  ;; 
-  (dolist (e *built-in-classes*)
-    (dolist (super (cadr e))
-      (unless (or (eq super 't)
-		  (assq super *built-in-classes*))
-	(error "In *built-in-classes*: ~S has ~S as a super,~%~
-                but ~S is not itself a class in *built-in-classes*."
-	       (car e) super super))))
-
-  ;;
-  ;; In the first pass, we create a skeletal object to be bound to the
-  ;; class name.
-  ;;
-  (let* ((built-in-class (find-class 'built-in-class))
-	 (built-in-class-wrapper (class-wrapper built-in-class))
-	 (bin-class-size (length *bin-class-slots*)))
-    (dolist (e *built-in-classes*)
-      (let ((class (%allocate-instance--class bin-class-size)))
-	(setf (std-instance-wrapper class) built-in-class-wrapper)
-	(setf (find-class (car e)) class))))
-
-  ;;
-  ;; In the second pass, we initialize the class objects.
-  ;;
-  (dolist (e *built-in-classes*)
-    (destructuring-bind (name supers subs cpl) e
-      (let* ((class (find-class name))
-	     (wrapper (make-wrapper class)))
-	(set (get-built-in-class-symbol name) class)
-	(set (get-built-in-wrapper-symbol name) wrapper)
-
-	(setf (wrapper-instance-slots-layout wrapper) ()
-	      (wrapper-class-slots wrapper) ())
-
-	(bootstrap-initialize-bin-class class
-					name nil
-					supers subs
-					(cons name cpl) wrapper)
-	))))
-
-
-;;;
-;;;
-;;;
-
-(defun class-of (x) (wrapper-class (wrapper-of x)))
-
-(defun wrapper-of (x) 
-  (or (and (std-instance-p x)
-	   (std-instance-wrapper x))
-      (and (fsc-instance-p x)
-	   (fsc-instance-wrapper x))
-      (built-in-wrapper-of x)
-      (error "Can't determine wrapper of ~S" x)))
-
-
-(eval-when (compile eval)
-
-(defun make-built-in-class-subs ()
-  (mapcar #'(lambda (e)
-	      (let ((class (car e))
-		    (class-subs ()))
-		(dolist (s *built-in-classes*)
-		  (when (memq class (cadr s)) (pushnew (car s) class-subs)))
-		(cons class class-subs)))
-	  (cons '(t) *built-in-classes*)))
-
-(defun make-built-in-class-tree ()
-  (let ((subs (make-built-in-class-subs)))
-    (labels ((descend (class)
-	       (cons class (mapcar #'descend (cdr (assq class subs))))))
-      (descend 't))))
-
-(defun make-built-in-wrapper-of-body ()
-  (make-built-in-wrapper-of-body-1 (make-built-in-class-tree)
-				   'x
-				   #'get-built-in-wrapper-symbol))
-
-(defun make-built-in-wrapper-of-body-1 (tree var get-symbol)
-  (let ((*specials* ()))
-    (declare (special *specials*))
-    (let ((inner (make-built-in-wrapper-of-body-2 tree var get-symbol)))
-      `(locally (declare (special .,*specials*)) ,inner))))
-
-(defun make-built-in-wrapper-of-body-2 (tree var get-symbol)
-  (declare (special *specials*))
-  (let ((symbol (funcall get-symbol (car tree))))
-    (push symbol *specials*)
-    (let ((sub-tests
-	    (mapcar #'(lambda (x)
-			(make-built-in-wrapper-of-body-2 x var get-symbol))
-		    (cdr tree))))
-      `(and (typep ,var ',(car tree))
-	    ,(if sub-tests
-		 `(or ,.sub-tests ,symbol)
-		 symbol)))))
-)
-
-(defun built-in-wrapper-of (x)
-  #.(make-built-in-wrapper-of-body))
-
-
-
-
-(eval-when (load eval)
-  (clrhash *find-class*)
-  (bootstrap-meta-braid)
-  (bootstrap-built-in-classes)
-  (setq *boot-state* 'braid)
-  (setf (symbol-function 'load-defclass) #'real-load-defclass)
-  )
-
-
-;;;
-;;; All of these method definitions must appear here because the bootstrap
-;;; only allows one method per generic function until the braid is fully
-;;; built.
-;;;
-(defmethod print-object (instance stream)
-  (printing-random-thing (instance stream)
-    (let ((name (class-name (class-of instance))))
-      (if name
-	  (format stream "~S" name)
-	  (format stream "Instance")))))
-
-(defmethod print-object ((class class) stream)
-  (named-object-print-function class stream))
-
-(defmethod print-object ((slotd standard-slot-definition) stream)
-  (named-object-print-function slotd stream))
-
-(defun named-object-print-function (instance stream
-				    &optional (extra nil extra-p))
-  (printing-random-thing (instance stream)
-    (if extra-p					
-	(format stream "~A ~S ~:S"
-		(capitalize-words (class-name (class-of instance)))
-		(slot-value-or-default instance 'name)
-		extra)
-	(format stream "~A ~S"
-		(capitalize-words (class-name (class-of instance)))
-		(slot-value-or-default instance 'name)))))
-
-
-;;;
-;;;
-;;;
-;(defmethod shared-initialize :after ((class class) slot-names &key name)
-;  (declare (ignore slot-names))
-;  (setf (slot-value class 'name) name))
-;
-;
-;(defmethod shared-initialize :after ((class std-class)
-;				     slot-names
-;				     &key direct-superclasses
-;					  direct-slots)
-; (declare (ignore slot-names))
-; (setf (slot-value class 'direct-superclasses) direct-superclasses
-;	(slot-value class 'direct-slots) direct-slots))
-
-;;;
-;;;
-;;;
-(defmethod shared-initialize :after ((slotd standard-slot-definition)
-				     slot-names
-				     &key class
-					  name
-					  initform
-					  initfunction
-					  initargs 
-					  (allocation :instance)
-					  (type t)
-					  readers
-					  writers)
-  (declare (ignore slot-names))
-  (setf (slot-value slotd 'name) name
-	(slot-value slotd 'initform) initform
-	(slot-value slotd 'initfunction) initfunction
-	(slot-value slotd 'initargs) initargs 
-	(slot-value slotd 'allocation) (if (eq allocation :class) class allocation)
-	(slot-value slotd 'type) type
-	(slot-value slotd 'readers) readers
-	(slot-value slotd 'writers) writers))
-

obsolete/clos/2.0/clos-env-internal.lisp

@@ -1,260 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "XCL" READTABLE "XCL")
-(il:filecreated "28-Aug-87 18:42:36" il:{phylum}<clos>clos-env-internal.\;1 8356   
-
-      il:|changes| il:|to:|  (il:vars il:clos-env-internalcoms)
-                             (il:props (il:clos-env-internal il:makefile-environment))
-                             (il:functions stack-eql stack-pointer-frame stack-frame-valid-p 
-                                    stack-frame-fn-header stack-frame-pc fnheader-debugging-info 
-                                    stack-frame-name compiled-closure-fnheader compiled-closure-env)
-)
-
-
-; Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
-
-(il:prettycomprint il:clos-env-internalcoms)
-
-(il:rpaqq il:clos-env-internalcoms (
-
-(il:* il:|;;;| "***************************************")
-
-                                   
-
-(il:* il:|;;;| " Copyright (c) 1987 Xerox Corporation.  All rights reserved.")
-
-                                   
-
-(il:* il:|;;;| "")
-
-                                   
-
-(il:* il:|;;;| "Use and copying of this software and preparation of derivative works based upon this software are permitted.  Any distribution of this software or derivative works must comply with all applicable United States export control laws.")
-
-                                   
-
-(il:* il:|;;;| " ")
-
-                                   
-
-(il:* il:|;;;| "This software is made available AS IS, and Xerox Corporation makes no  warranty about the software, its performance or its conformity to any  specification.")
-
-                                   
-
-(il:* il:|;;;| " ")
-
-                                   
-
-(il:* il:|;;;| "Any person obtaining a copy of this software is requested to send their name and post office or electronic mail address to:")
-
-                                   
-
-(il:* il:|;;;| "   CommonLoops Coordinator")
-
-                                   
-
-(il:* il:|;;;| "   Xerox Artifical Intelligence Systems")
-
-                                   
-
-(il:* il:|;;;| "   2400 Hanover St.")
-
-                                   
-
-(il:* il:|;;;| "   Palo Alto, CA 94303")
-
-                                   
-
-(il:* il:|;;;| "(or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)")
-
-                                   
-
-(il:* il:|;;;| "")
-
-                                   
-
-(il:* il:|;;;| " Suggestions, comments and requests for improvements are also welcome.")
-
-                                   
-
-(il:* il:|;;;| " *************************************************************************")
-
-                                   
-
-(il:* il:|;;;| "")
-
-                                   (il:declare\: il:dontcopy (il:prop il:makefile-environment 
-                                                                    il:clos-env-internal))
-                                                             (il:* il:\; 
-                                                             "We're off to hack the system...")
-
-                                   (il:declare\: il:eval@compile il:dontcopy (il:files clos::abc)
-                                          
-          
-          (il:* il:|;;| "The Deltas and The East and The Freeze")
-)
-                                   (il:functions stack-eql stack-pointer-frame stack-frame-valid-p 
-                                          stack-frame-fn-header stack-frame-pc 
-                                          fnheader-debugging-info stack-frame-name 
-                                          compiled-closure-fnheader compiled-closure-env)))
-
-
-
-(il:* il:|;;;| "***************************************")
-
-
-
-
-(il:* il:|;;;| " Copyright (c) 1987 Xerox Corporation.  All rights reserved.")
-
-
-
-
-(il:* il:|;;;| "")
-
-
-
-
-(il:* il:|;;;| 
-"Use and copying of this software and preparation of derivative works based upon this software are permitted.  Any distribution of this software or derivative works must comply with all applicable United States export control laws."
-)
-
-
-
-
-(il:* il:|;;;| " ")
-
-
-
-
-(il:* il:|;;;| 
-"This software is made available AS IS, and Xerox Corporation makes no  warranty about the software, its performance or its conformity to any  specification."
-)
-
-
-
-
-(il:* il:|;;;| " ")
-
-
-
-
-(il:* il:|;;;| 
-"Any person obtaining a copy of this software is requested to send their name and post office or electronic mail address to:"
-)
-
-
-
-
-(il:* il:|;;;| "   CommonLoops Coordinator")
-
-
-
-
-(il:* il:|;;;| "   Xerox Artifical Intelligence Systems")
-
-
-
-
-(il:* il:|;;;| "   2400 Hanover St.")
-
-
-
-
-(il:* il:|;;;| "   Palo Alto, CA 94303")
-
-
-
-
-(il:* il:|;;;| "(or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)")
-
-
-
-
-(il:* il:|;;;| "")
-
-
-
-
-(il:* il:|;;;| " Suggestions, comments and requests for improvements are also welcome.")
-
-
-
-
-(il:* il:|;;;| " *************************************************************************")
-
-
-
-
-(il:* il:|;;;| "")
-
-(il:declare\: il:dontcopy 
-
-(il:putprops il:clos-env-internal il:makefile-environment (:package "XCL" :readtable "XCL"))
-)
-
-
-
-(il:* il:\; "We're off to hack the system...")
-
-(il:declare\: il:eval@compile il:dontcopy 
-(il:filesload clos::abc)
-)
-
-(defun stack-eql (x y) "Test two stack pointers for equality" (and (il:stackp x)
-                                                                   (il:stackp y)
-                                                                   (eql (il:fetch (il:stackp il:edfxp
-                                                                                         )
-                                                                           il:of x)
-                                                                        (il:fetch (il:stackp il:edfxp
-                                                                                         )
-                                                                           il:of y))))
-
-
-(defun stack-pointer-frame (stack-pointer) (il:|fetch| (il:stackp il:edfxp) il:|of| stack-pointer))
-
-
-(defun stack-frame-valid-p (frame) (not (il:|fetch| (il:fx il:invalidp) il:|of| frame)))
-
-
-(defun stack-frame-fn-header (frame) (il:|fetch| (il:fx il:fnheader) il:|of| frame))
-
-
-(defun stack-frame-pc (frame) (il:|fetch| (il:fx il:pc) il:|of| frame))
-
-
-(defun fnheader-debugging-info (fnheader) (let* ((start-pc (il:fetch (il:fnheader il:startpc)
-                                                              il:of fnheader))
-                                                 (name-table-words
-                                                  (let ((size (il:fetch (il:fnheader il:ntsize)
-                                                                 il:of fnheader)))
-                                                       (if (zerop size)
-                                                           il:wordsperquad
-                                                           (* size 2))))
-                                                 (past-name-table-in-words (+ (il:fetch (il:fnheader
-                                                                                         
-                                                                                     il:overheadwords
-                                                                                         )
-                                                                                 il:of fnheader)
-                                                                              name-table-words)))
-                                                (and (= (- start-pc (* il:bytesperword 
-                                                                       past-name-table-in-words))
-                                                        il:bytespercell)
-          
-          (il:* il:|;;| "It's got a debugging-info list.")
-
-                                                     (il:\\getbaseptr fnheader 
-                                                            past-name-table-in-words))))
-
-
-(defun stack-frame-name (frame) (il:|fetch| (il:fx il:framename) il:|of| frame))
-
-
-(defun compiled-closure-fnheader (closure) (il:|fetch| (il:compiled-closure il:fnheader) il:|of|
-                                                                                         closure))
-
-
-(defun compiled-closure-env (closure) (il:fetch (il:compiled-closure il:environment) il:of closure))
-
-(il:putprops il:clos-env-internal il:copyright ("Xerox Corporation" 1987))
-(il:declare\: il:dontcopy
-  (il:filemap (nil)))
-il:stop

obsolete/clos/2.0/combin.lisp

@@ -1,254 +0,0 @@
-;;;-*-Mode:LISP; Package: CLOS; Base:10; Syntax:Common-lisp -*-
-;;;
-;;; *************************************************************************
-;;; Copyright (c) 1991 Venue
-;;; All rights reserved.
-;;; *************************************************************************
-;;;
-
-(in-package 'clos)
-
-(defun make-effective-method-function (generic-function form)
-  (flet ((name-function (fn) (set-function-name fn 'a-combined-method) fn))
-    (if (and (listp form)
-	     (eq (car form) 'call-method)
-	     (method-p (cadr form))
-	     (every #'method-p (caddr form)))
-	;;
-	;; The effective method is just a call to call-method.  This opens up
-	;; the possibility of just using the method function of the method as
-	;; as the effective method function.
-	;;
-	;; But we have to be careful.  If that method function will ask for
-	;; the next methods we have to provide them.  We do not look to see
-	;; if there are next methods, we look at whether the method function
-	;; asks about them.  If it does, we must tell it whether there are
-	;; or aren't to prevent the leaky next methods bug.
-	;; 
-	(let* ((method-function (method-function (cadr form)))
-	       (arg-info (gf-arg-info generic-function))
-	       (metatypes (arg-info-metatypes arg-info))
-	       (applyp (arg-info-applyp arg-info)))
-	  (if (not (method-function-needs-next-methods-p method-function))
-	      method-function
-	      (let ((next-method-functions (mapcar #'method-function (caddr form))))
-		(name-function
-		  (get-function `(lambda ,(make-dfun-lambda-list metatypes applyp)
-				   (let ((*next-methods* .next-method-functions.))
-				     ,(make-dfun-call metatypes applyp '.method-function.)))
-		    #'default-test-converter	;This could be optimized by making
-						;the interface from here to the
-						;walker more clear so that the
-						;form wouldn't get walked at all.
-		    #'(lambda (form)
-			(if (memq form '(.next-method-functions. .method-function.))
-			    (values form (list form))
-			    form))
-		    #'(lambda (form)
-			(cond ((eq form '.next-method-functions.)
-			       (list next-method-functions))
-			      ((eq form '.method-function.)
-			       (list method-function)))))))))
-	;;
-	;; We have some sort of `real' effective method.  Go off and get a
-	;; compiled function for it.  Most of the real hair here is done by
-	;; the GET-FUNCTION mechanism.
-	;; 
-	(name-function (make-effective-method-function-internal generic-function form)))))
-
-(defvar *global-effective-method-gensyms* ())
-(defvar *rebound-effective-method-gensyms*)
-
-(defun get-effective-method-gensym ()
-  (or (pop *rebound-effective-method-gensyms*)
-      (let ((new (make-symbol "EFFECTIVE-METHOD-GENSYM-")))
-	(push new *global-effective-method-gensyms*)
-	new)))
-
-(eval-when (load)
-  (let ((*rebound-effective-method-gensyms* ()))
-    (dotimes (i 10) (get-effective-method-gensym))))
-
-(defun make-effective-method-function-internal (generic-function effective-method)
-  (let* ((*rebound-effective-method-gensyms* *global-effective-method-gensyms*)
-	 (arg-info (gf-arg-info generic-function))
-	 (metatypes (arg-info-metatypes arg-info))
-	 (applyp (arg-info-applyp arg-info)))
-    (labels ((test-converter (form)
-	       (if (and (consp form) (eq (car form) 'call-method))
-		   '.call-method.
-		   (default-test-converter form)))
-	     (code-converter (form)
-	       (if (and (consp form) (eq (car form) 'call-method))
-		   ;;
-		   ;; We have a `call' to CALL-METHOD.  There may or may not be next methods
-		   ;; and the two cases are a little different.  It controls how many gensyms
-		   ;; we will generate.
-		   ;;
-		   (let ((gensyms
-			   (if (cddr form)
-			       (list (get-effective-method-gensym)
-				     (get-effective-method-gensym))
-			       (list (get-effective-method-gensym)
-				     ()))))
-		     (values `(let ((*next-methods* ,(cadr gensyms)))
-				,(make-dfun-call metatypes applyp (car gensyms)))
-			     gensyms))
-		   (default-code-converter form)))
-	     (constant-converter (form)
-	       (if (and (consp form) (eq (car form) 'call-method))
-		   (if (cddr form)
-		       (list (check-for-make-method (cadr form))
-			     (mapcar #'check-for-make-method (caddr form)))
-		       (list (check-for-make-method (cadr form))
-			     ()))
-		   (default-constant-converter form)))
-	     (check-for-make-method (effective-method)
-	       (cond ((method-p effective-method)
-		      (method-function effective-method))
-		     ((and (listp effective-method)
-			   (eq (car effective-method) 'make-method))
-		      (make-effective-method-function generic-function
-						      (make-progn (cadr effective-method))))
-		     (t
-		      (error "Effective-method form is malformed.")))))
-      (get-function `(lambda ,(make-dfun-lambda-list metatypes applyp) ,effective-method)
-		  #'test-converter
-		  #'code-converter
-		  #'constant-converter))))
-
-
-
-(defvar *invalid-method-error*
-	#'(lambda (&rest args)
-	    (declare (ignore args))
-	    (error
-	      "INVALID-METHOD-ERROR was called outside the dynamic scope~%~
-               of a method combination function (inside the body of~%~
-               DEFINE-METHOD-COMBINATION or a method on the generic~%~
-               function COMPUTE-EFFECTIVE-METHOD).")))
-
-(defvar *method-combination-error*
-	#'(lambda (&rest args)
-	    (declare (ignore args))
-	    (error
-	      "METHOD-COMBINATION-ERROR was called outside the dynamic scope~%~
-               of a method combination function (inside the body of~%~
-               DEFINE-METHOD-COMBINATION or a method on the generic~%~
-               function COMPUTE-EFFECTIVE-METHOD).")))
-
-;(defmethod compute-effective-method :around        ;issue with magic
-;	   ((generic-function generic-function)     ;generic functions
-;	    (method-combination method-combination)
-;	    applicable-methods)
-;  (declare (ignore applicable-methods))
-;  (flet ((real-invalid-method-error (method format-string &rest args)
-;	   (declare (ignore method))
-;	   (apply #'error format-string args))
-;	 (real-method-combination-error (format-string &rest args)
-;	   (apply #'error format-string args)))
-;    (let ((*invalid-method-error* #'real-invalid-method-error)
-;	  (*method-combination-error* #'real-method-combination-error))
-;      (call-next-method))))
-
-(defun invalid-method-error (&rest args)
-  (declare (arglist method format-string &rest format-arguments))
-  (apply *invalid-method-error* args))
-
-(defun method-combination-error (&rest args)
-  (declare (arglist format-string &rest format-arguments))
-  (apply *method-combination-error* args))
-
-
-
-;;;
-;;; The STANDARD method combination type.  This is coded by hand (rather than
-;;; with define-method-combination) for bootstrapping and efficiency reasons.
-;;; Note that the definition of the find-method-combination-method appears in
-;;; the file defcombin.lisp, this is because EQL methods can't appear in the
-;;; bootstrap.
-;;;
-;;; The defclass for the METHOD-COMBINATION and STANDARD-METHOD-COMBINATION
-;;; classes has to appear here for this reason.  This code must conform to
-;;; the code in the file defcombin, look there for more details.
-;;;
-
-(defclass method-combination () ())
-
-(define-gf-predicate method-combination-p method-combination)
-
-(defclass standard-method-combination
-	  (definition-source-mixin method-combination)
-     ((type          :reader method-combination-type
-	             :initarg :type)
-      (documentation :reader method-combination-documentation
-		     :initarg :documentation)
-      (options       :reader method-combination-options
-	             :initarg :options)))
-
-(defmethod print-object ((mc method-combination) stream)
-  (printing-random-thing (mc stream)
-    (format stream
-	    "Method-Combination ~S ~S"
-	    (method-combination-type mc)
-	    (method-combination-options mc))))
-
-(eval-when (load eval)
-  (setq *standard-method-combination*
-	(make-instance 'standard-method-combination
-		       :type 'standard
-		       :documentation "The standard method combination."
-		       :options ())))
-
-;This definition appears in defcombin.lisp.
-;
-;(defmethod find-method-combination ((generic-function generic-function)
-;				     (type (eql 'standard))
-;				     options)
-;  (when options
-;    (method-combination-error
-;      "The method combination type STANDARD accepts no options."))
-;  *standard-method-combination*)
-
-(defun make-call-methods (methods)
-  (mapcar #'(lambda (method) `(call-method ,method ())) methods))
-
-(defmethod compute-effective-method ((generic-function generic-function)
-				     (combin standard-method-combination)
-				     applicable-methods)
-  (let ((before ())
-	(primary ())
-	(after ())
-	(around ()))
-    (dolist (m applicable-methods)
-      (let ((qualifiers (method-qualifiers m)))
-	(cond ((member ':before qualifiers)  (push m before))
-	      ((member ':after  qualifiers)  (push m after))
-	      ((member ':around  qualifiers) (push m around))
-	      (t
-	       (push m primary)))))
-    (setq before  (reverse before)
-	  after   (reverse after)
-	  primary (reverse primary)
-	  around  (reverse around))
-    (cond ((null primary)
-	   `(error "No primary method for the generic function ~S." ',generic-function))
-	  ((and (null before) (null after) (null around))
-	   ;;
-	   ;; By returning a single call-method `form' here we enable an important
-	   ;; implementation-specific optimization.
-	   ;; 
-	   `(call-method ,(first primary) ,(rest primary)))
-	  (t
-	   (let ((main-effective-method
-		   (if (or before after (rest primary))
-		       `(multiple-value-prog1
-			  (progn ,@(make-call-methods before)
-				 (call-method ,(first primary) ,(rest primary)))
-			  ,@(make-call-methods (reverse after)))
-		       `(call-method ,(first primary) ()))))
-	     (if around
-		 `(call-method ,(first around)
-			       (,@(rest around) (make-method ,main-effective-method)))
-		 main-effective-method))))))
-

obsolete/clos/2.0/compat.lisp

@@ -1,11 +0,0 @@
-;;;-*-Mode:LISP; Package: CLOS; Base:10; Syntax:Common-lisp; -*-
-;;;
-;;; *************************************************************************
-;;; Copyright (c) 1991 Venue
-;;; All rights reserved.
-;;; *************************************************************************
-;;;
-
-(in-package 'clos)
-
-()

obsolete/clos/2.0/cpl.lisp

@@ -1,271 +0,0 @@
-;;;-*- Package: CLOS; Syntax: Common-Lisp; Base: 10 -*-
-;;;. Copyright (c) 1991 by Venue
-
-
-(in-package "CLOS")
-
-
-;;; compute-class-precedence-list Knuth section 2.2.3 has some interesting notes on this. What
-;;; appears here is basically the algorithm presented there. The key idea is that we use
-;;; class-precedence-description (CPD) structures to store the precedence information as we proceed.
-;;; The CPD structure for a class stores two critical pieces of information: - a count of the number
-;;; of "reasons" why the class can't go into the class precedence list yet. - a list of the
-;;; "reasons" this class prevents others from going in until after it 
-
-
-
-;; 
-
-
-
-;;; A "reason" is essentially a single local precedence constraint.  If a constraint between two
-;;; classes arises more than once it generates more than one reason.  This makes things simpler,
-;;; linear, and isn't a problem as long as we make sure to keep track of each instance of a
-;;; "reason". This code is divided into three phases. - the first phase simply generates the CPD's
-;;; for each of the class and its superclasses.  The remainder of the code will manipulate these
-;;; CPDs rather than the class objects themselves.  At the end of this pass, the CPD-SUPERS field of
-;;; a CPD is a list of the CPDs of the direct superclasses of the class. - the second phase folds
-;;; all the local constraints into the CPD structure.  The CPD-COUNT of each CPD is built up, and
-;;; the CPD-AFTER fields are augmented to include precedence constraints from the CPD-SUPERS field
-;;; and from the order of classes in other CPD-SUPERS fields. After this phase, the CPD-AFTER field
-;;; of a class includes all the direct superclasses of the class plus any class that immediately
-;;; follows the class in the direct superclasses of another.  There can be duplicates in this list. 
-;;; The CPD-COUNT field is equal to the number of times this class appears in the CPD-AFTER field of
-;;; all the other CPDs. - In the third phase, classes are put into the precedence list one at a
-;;; time, with only those classes with a CPD-COUNT of 0 being candidates for insertion.  When a
-;;; class is inserted , every CPD in its CPD-AFTER field has its count decremented. In the usual
-;;; case, there is only one candidate for insertion at any point.  If there is more than one, the
-;;; specified tiebreaker rule is used to choose among them. 
-
-
-(defmethod compute-class-precedence-list ((root std-class)
-                                          direct-superclasses)
-       (compute-std-cpl root direct-superclasses))
-
-(defstruct (class-precedence-description (:conc-name nil)
-                  (:print-function (lambda (obj str depth)
-                                          (declare (ignore depth))
-                                          (format str "#<CPD ~S ~D>" (class-name (cpd-class obj))
-                                                 (cpd-count obj))))
-                  (:constructor make-cpd nil))
-       (cpd-class nil)
-       (cpd-supers nil)
-       (cpd-after nil)
-       (cpd-count 0))
-
-(defun compute-std-cpl (class supers)
-       (cond ((null supers)
-                                                             ; First two branches of COND
-              (list class))
-                                                             ; are implementing the single
-             ((null (cdr supers))
-                                                             ; inheritance optimization.
-              (cons class (compute-std-cpl (car supers)
-                                 (class-direct-superclasses (car supers)))))
-             (t (multiple-value-bind (all-cpds nclasses)
-                    (compute-std-cpl-phase-1 class supers)
-                  (compute-std-cpl-phase-2 all-cpds)
-                  (compute-std-cpl-phase-3 class all-cpds nclasses)))))
-
-(defvar *compute-std-cpl-class->entry-table-size* 60)
-
-(defun compute-std-cpl-phase-1 (class supers)
-       (let ((nclasses 0)
-             (all-cpds nil)
-             (table (make-hash-table :size *compute-std-cpl-class->entry-table-size* :test
-                           #'eq)))
-            (labels ((get-cpd (c)
-                            (or (gethash c table)
-                                (setf (gethash c table)
-                                      (make-cpd))))
-                     (walk (c supers)
-                           (if (forward-referenced-class-p c)
-                               (cpl-forward-referenced-class-error class c)
-                               (let ((cpd (get-cpd c)))
-                                    (unless (cpd-class cpd)
-                                                             ; If we have already done this class
-                                                             ; before, we can quit. 
-                                        (setf (cpd-class cpd)
-                                              c)
-                                        (incf nclasses)
-                                        (push cpd all-cpds)
-                                        (setf (cpd-supers cpd)
-                                              (mapcar #'get-cpd supers))
-                                        (dolist (super supers)
-                                            (walk super (class-direct-superclasses super))))))))
-                   (walk class supers)
-                   (values all-cpds nclasses))))
-
-(defun compute-std-cpl-phase-2 (all-cpds)
-       (dolist (cpd all-cpds)
-           (let ((supers (cpd-supers cpd)))
-                (when supers
-                    (setf (cpd-after cpd)
-                          (nconc (cpd-after cpd)
-                                 supers))
-                    (incf (cpd-count (car supers))
-                          1)
-                    (do* ((t1 supers t2)
-                          (t2 (cdr t1)
-                              (cdr t1)))
-                         ((null t2))
-                       (incf (cpd-count (car t2))
-                             2)
-                       (push (car t2)
-                             (cpd-after (car t1))))))))
-
-(defun
- compute-std-cpl-phase-3
- (class all-cpds nclasses)
- (let ((candidates nil)
-       (next-cpd nil)
-       (rcpl nil))
-      
-      ;; We have to bootstrap the collection of those CPD's that have a zero count.  Once we get
-      ;; going, we will maintain this list incrementally. 
-      (dolist (cpd all-cpds)
-          (when (zerop (cpd-count cpd))
-                (push cpd candidates)))
-      (loop (when (null candidates)
-                
-                ;; If there are no candidates, and enough classes have been put into the precedence
-                ;; list, then we are all done.  Otherwise it means there is a consistency problem. 
-                (if (zerop nclasses)
-                    (return (reverse rcpl))
-                    (cpl-inconsistent-error class all-cpds)))
-            
-            ;; Try to find the next class to put in from among the candidates. If there is only one,
-            ;; its easy, otherwise we have to use the famous RPG tiebreaker rule.  There is some
-            ;; hair here to avoid having to call DELETE on the list of candidates.  I dunno if its
-            ;; worth it but what the hell. 
-            (setq next-cpd
-                  (if (null (cdr candidates))
-                      (prog1 (car candidates)
-                             (setq candidates nil))
-                      (block tie-breaker
-                          (dolist (c rcpl)
-                              (let ((supers (class-direct-superclasses c)))
-                                   (if (memq (cpd-class (car candidates))
-                                             supers)
-                                       (return-from tie-breaker (pop candidates))
-                                       (do ((loc candidates (cdr loc)))
-                                           ((null (cdr loc)))
-                                         (let ((cpd (cadr loc)))
-                                              (when (memq (cpd-class cpd)
-                                                          supers)
-                                                  (setf (cdr loc)
-                                                        (cddr loc))
-                                                  (return-from tie-breaker cpd))))))))))
-            (decf nclasses)
-            (push (cpd-class next-cpd)
-                  rcpl)
-            (dolist (after (cpd-after next-cpd))
-                (when (zerop (decf (cpd-count after)))
-                      (push after candidates))))))
-
-
-;;; Support code for signalling nice error messages. 
-
-
-(defun cpl-error (class format-string &rest format-args)
-       (error "While computing the class precedence list of the class ~A.~%~A"
-              (if (class-name class)
-                  (format nil "named ~S" (class-name class))
-                  class)
-              (apply #'format nil format-string format-args)))
-
-(defun cpl-forward-referenced-class-error (class forward-class)
-       (flet ((class-or-name (class)
-                     (if (class-name class)
-                         (format nil "named ~S" (class-name class))
-                         class)))
-             (let ((names (mapcar #'class-or-name (cdr (find-superclass-chain class forward-class))))
-                   )
-                  (cpl-error class 
-                "The class ~A is a forward referenced class.~@
-                  The class ~A is ~A." (class-or-name forward-class)
-                         (class-or-name forward-class)
-                         (if (null (cdr names))
-                             (format nil "a direct superclass of the class ~A" (class-or-name class))
-                             (format nil "reached from the class ~A by following~@
-                              the direct superclass chain through: ~A~
-                              ~%  ending at the class ~A" (class-or-name class)
-                                    (format nil "~{~%  the class ~A,~}" (butlast names))
-                                    (car (last names))))))))
-
-(defun find-superclass-chain (bottom top)
-       (labels ((walk (c chain)
-                      (if (eq c top)
-                          (return-from find-superclass-chain (nreverse chain))
-                          (dolist (super (class-direct-superclasses c))
-                              (walk super (cons super chain))))))
-              (walk bottom (list bottom))))
-
-(defun cpl-inconsistent-error (class all-cpds)
-       (let ((reasons (find-cycle-reasons all-cpds)))
-            (cpl-error class "It is not possible to compute the class precedence list because~@
-       there ~A in the local precedence relations.~@
-       ~A because:~{~%  ~A~}." (if (cdr reasons)
-                                   "are circularities"
-                                   "is a circularity")
-                   (if (cdr reasons)
-                       "These arise"
-                       "This arises")
-                   (format-cycle-reasons (apply #'append reasons)))))
-
-(defun format-cycle-reasons (reasons)
-       (flet ((class-or-name (cpd)
-                     (let ((class (cpd-class cpd)))
-                          (if (class-name class)
-                              (format nil "named ~S" (class-name class))
-                              class))))
-             (mapcar #'(lambda (reason)
-                              (ecase (caddr reason)
-                                  (:super (format nil 
-                                                 "the class ~A appears in the supers of the class ~A"
-                                                 (class-or-name (cadr reason))
-                                                 (class-or-name (car reason))))
-                                  (:in-supers (format nil 
-                                    "the class ~A follows the class ~A in the supers of the class ~A"
-                                                     (class-or-name (cadr reason))
-                                                     (class-or-name (car reason))
-                                                     (class-or-name (cadddr reason))))))
-                    reasons)))
-
-(defun find-cycle-reasons (all-cpds)
-       (let ((been-here nil)
-                                                             ; List of classes we have visited.
-             (cycle-reasons nil))
-            (labels ((chase (path)
-                            (if (memq (car path)
-                                      (cdr path))
-                                (record-cycle (memq (car path)
-                                                    (nreverse path)))
-                                (unless (memq (car path)
-                                              been-here)
-                                    (push (car path)
-                                          been-here)
-                                    (dolist (after (cpd-after (car path)))
-                                        (chase (cons after path))))))
-                     (record-cycle
-                      (cycle)
-                      (let ((reasons nil))
-                           (do* ((t1 cycle t2)
-                                 (t2 (cdr t1)
-                                     (cdr t1)))
-                                ((null t2))
-                              (let ((c1 (car t1))
-                                    (c2 (car t2)))
-                                   (if (memq c2 (cpd-supers c1))
-                                       (push (list c1 c2 :super)
-                                             reasons)
-                                       (dolist (cpd all-cpds)
-                                           (when (memq c2 (memq c1 (cpd-supers cpd)))
-                                               (return (push (list c1 c2 :in-supers cpd)
-                                                             reasons)))))))
-                           (push (nreverse reasons)
-                                 cycle-reasons))))
-                   (dolist (cpd all-cpds)
-                       (unless (zerop (cpd-count cpd))
-                           (chase (list cpd))))
-                   cycle-reasons)))

obsolete/clos/2.0/ctypes.lisp

@@ -1,25 +0,0 @@
-;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*-
-;;;
-;;; *************************************************************************
-;;; Copyright (c) 1991 Venue
-;;; All rights reserved.
-;;; *************************************************************************
-;;;
-
-(in-package 'clos)
-
-;;;
-;;; The built-in method combination types as taken from page 1-31 of 88-002R.
-;;; Note that the STANDARD method combination type is defined by hand in the
-;;; file combin.lisp.
-;;;
-
-(define-method-combination +      :identity-with-one-argument t)
-(define-method-combination and    :identity-with-one-argument t)
-(define-method-combination append :identity-with-one-argument nil)
-(define-method-combination list   :identity-with-one-argument nil)
-(define-method-combination max    :identity-with-one-argument t)
-(define-method-combination min    :identity-with-one-argument t)
-(define-method-combination nconc  :identity-with-one-argument t)
-(define-method-combination or     :identity-with-one-argument t)
-(define-method-combination progn  :identity-with-one-argument t)

obsolete/clos/2.0/defclass.lisp

@@ -1,230 +0,0 @@
-;;;-*- Package: CLOS; Syntax: Common-Lisp; Base: 10 -*-
-
-;;;. Copyright (c) 1991 by Venue
-(in-package "CLOS")
-
-;;; ************************************************************************* 
-
-
-
-;;; MAKE-TOP-LEVEL-FORM is used by all PCL macros that appear `at top-level'. The original
-;;; motiviation for this function was to deal with the bug in the Genera compiler that prevents
-;;; lambda expressions in top-level forms other than DEFUN from being compiled. Now this function is
-;;; used to grab other functionality as well.  This includes: - Preventing the grouping of top-level
-;;; forms.  For example, a DEFCLASS followed by a DEFMETHOD may not want to be grouped into the same
-;;; top-level form. - Telling the programming environment what the pretty version of the name of
-;;; this form is.  This is used by WARN. 
-
-
-(defun make-top-level-form (name times form)
-       (flet ((definition-name nil (if (and (listp name)
-                                            (memq (car name)
-                                                  '(defmethod defclass class method 
-                                                          method-combination)))
-                                       (format nil "~A~{ ~S~}" (capitalize-words (car name)
-                                                                      nil)
-                                              (cdr name))
-                                       (format nil "~S" name))))
-             (definition-name)
-             (make-progn `',name `(eval-when ,times ,form))))
-
-(defun make-progn (&rest forms)
-       (let ((progn-form nil))
-            (labels ((collect-forms (forms)
-                            (unless (null forms)
-                                (collect-forms (cdr forms))
-                                (if (and (listp (car forms))
-                                         (eq (caar forms)
-                                             'progn))
-                                    (collect-forms (cdar forms))
-                                    (push (car forms)
-                                          progn-form)))))
-                   (collect-forms forms)
-                   (cons 'progn progn-form))))
-
-
-;;; Like the DEFMETHOD macro, the expansion of the DEFCLASS macro is fixed. DEFCLASS always expands
-;;; into a call to LOAD-DEFCLASS.  Until the meta- braid is set up, LOAD-DEFCLASS has a special
-;;; definition which simply collects all class definitions up, when the metabraid is initialized it
-;;; is done from those class definitions. After the metabraid has been setup, and the protocol for
-;;; defining classes has been defined, the real definition of LOAD-DEFCLASS is installed by the file
-;;; defclass.lisp 
-
-
-(defmacro defclass (name direct-superclasses direct-slots &rest options)
-       (declare (indentation 2 4 3 1))
-       (expand-defclass name direct-superclasses direct-slots options))
-
-(defun expand-defclass (name supers slots options)
-       (setq supers (copy-tree supers)
-             slots
-             (copy-tree slots)
-             options
-             (copy-tree options))
-       (let ((metaclass 'standard-class))
-            (dolist (option options)
-                (if (not (listp option))
-                    (error "~S is not a legal defclass option." option)
-                    (when (eq (car option)
-                              ':metaclass)
-                        (unless (legal-class-name-p (cadr option))
-                            (error 
-        "The value of the :metaclass option (~S) is not a~%~
-                      legal class name." (cadr option)))
-                        (setq metaclass (cadr option))
-                        (setf options (remove option options))
-                        (return t))))
-            (let ((*initfunctions* nil)
-                  (*accessors* nil))
-                                                             ; Truly a crock, but we got to have it
-                                                             ; to live nicely. 
-                 (declare (special *initfunctions* *accessors*))
-                 (let ((canonical-slots (mapcar #'(lambda (spec)
-                                                         (canonicalize-slot-specification name spec))
-                                               slots))
-                       (other-initargs (mapcar #'(lambda (option)
-                                                        (canonicalize-defclass-option name option))
-                                              options)))
-                      (do-standard-defsetfs-for-defclass *accessors*)
-;		      (load-defclass name metaclass supers
-;				     canonical-slots (apply #'append
-;							    other-initargs) *accessors*)))))
-                      (make-top-level-form `(defclass ,name nil nil)
-                             *defclass-times*
-                             `(let ,(mapcar #'cdr *initfunctions*)
-                                   (load-defclass ',name ',metaclass ',supers (list 
-                                                                                    ,@canonical-slots
-                                                                                    )
-                                          (list ,@(apply #'append other-initargs))
-                                          ',*accessors*)))))))
-
-(defun make-initfunction (initform)
-       (declare (special *initfunctions*))
-       (cond ((or (eq initform 't)
-                  (equal initform ''t))
-              '#'true)
-             ((or (eq initform 'nil)
-                  (equal initform ''nil))
-              '#'false)
-             ((or (eql initform '0)
-                  (equal initform ''0))
-              '#'zero)
-             (t (let ((entry (assoc initform *initfunctions* :test #'equal)))
-                     (unless entry
-                         (setq entry (list initform (gensym)
-                                           `#'(lambda nil ,initform)))
-                         (push entry *initfunctions*))
-                     (cadr entry)))))
-
-(defun canonicalize-slot-specification (class-name spec)
-       (declare (special *accessors*))
-       (cond ((and (symbolp spec)
-                   (not (keywordp spec))
-                   (not (memq spec '(t nil))))
-              `'(:name ,spec))
-             ((not (consp spec))
-              (error "~S is not a legal slot specification." spec))
-             ((null (cdr spec))
-              `'(:name ,(car spec)))
-             ((null (cddr spec))
-              (error 
-        "In DEFCLASS ~S, the slot specification ~S is obsolete.~%~
-                 Convert it to ~S" class-name spec (list (car spec)
-                                                         :initform
-                                                         (cadr spec))))
-             (t (let* ((name (pop spec))
-                       (readers nil)
-                       (writers nil)
-                       (initargs nil)
-                       (unsupplied (list nil))
-                       (initform (getf spec :initform unsupplied)))
-                      (doplist (key val)
-                             spec
-                             (case key
-                                 (:accessor 
-                                    (push val *accessors*)
-                                    (push val readers)
-                                    (push `(setf ,val)
-                                          writers))
-                                 (:reader (push val readers))
-                                 (:writer (push val writers))
-                                 (:initarg (push val initargs))))
-                      (loop (unless (remf spec :accessor)
-                                   (return)))
-                      (loop (unless (remf spec :reader)
-                                   (return)))
-                      (loop (unless (remf spec :writer)
-                                   (return)))
-                      (loop (unless (remf spec :initarg)
-                                   (return)))
-                      (setq spec `(:name ',name :readers ',readers
-				   :writers ',writers :initargs
-                                         ',initargs
-                                         ',spec))
-                      (if (eq initform unsupplied)
-                          `(list* ,@spec)
-                          `(list* :initfunction ,(make-initfunction initform)
-                                  ,@spec))))))
-
-(defun canonicalize-defclass-option (class-name option)
-       (declare (ignore class-name))
-       (case (car option)
-           (:default-initargs (let ((canonical nil))
-                                   (let (key val (tail (cdr option)))
-                                        (loop (when (null tail)
-                                                    (return nil))
-                                              (setq key (pop tail)
-                                                    val
-                                                    (pop tail))
-                                              (push ``(,',key ,,(make-initfunction val)
-                                                             ,',val)
-                                                    canonical))
-                                        `(':direct-default-initargs (list ,@(nreverse canonical))))))
-           (otherwise `(',(car option)
-                        ',(cdr option)))))
-
-
-;;; This is the early definition of load-defclass.  It just collects up all the class definitions in
-;;; a list.  Later, in the file braid1.lisp, these are actually defined. Each entry in
-;;; *early-class-definitions* is an early-class-definition. 
-
-
-(defparameter *early-class-definitions* nil)
-
-(defun make-early-class-definition (name source metaclass superclass-names canonical-slots 
-                                         other-initargs)
-       (list 'early-class-definition name source metaclass superclass-names canonical-slots 
-             other-initargs))
-
-(defun ecd-class-name (ecd)
-       (nth 1 ecd))
-
-(defun ecd-source (ecd)
-       (nth 2 ecd))
-
-(defun ecd-metaclass (ecd)
-       (nth 3 ecd))
-
-(defun ecd-superclass-names (ecd)
-       (nth 4 ecd))
-
-(defun ecd-canonical-slots (ecd)
-       (nth 5 ecd))
-
-(defun ecd-other-initargs (ecd)
-       (nth 6 ecd))
-
-(proclaim '(notinline load-defclass))
-
-(defun load-defclass (name metaclass supers canonical-slots canonical-options accessor-names)
-       (setq supers (copy-tree supers)
-             canonical-slots
-             (copy-tree canonical-slots)
-             canonical-options
-             (copy-tree canonical-options))
-       (do-standard-defsetfs-for-defclass accessor-names)
-       (let ((ecd (make-early-class-definition name (load-truename)
-                         metaclass supers canonical-slots (apply #'append canonical-options)))
-             (existing (find name *early-class-definitions* :key #'ecd-class-name)))
-            (setq *early-class-definitions* (cons ecd (remove existing *early-class-definitions*)))
-            ecd))