Update .github/ISSUE_TEMPLATE/what_people_are_saying.yml

Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com>
Signed-off-by: Bill Stumbo <wstumbo@charter.net>

.github/ISSUE_TEMPLATE/primer.yml

@@ -0,0 +1,68 @@
+name: Report an issue with the "Medley Interlisp for the Newcomer" primer
+description: Use this template to report issues or make suggestions.
+title: "[Primer] <short title here>"
+labels: 
+  - primer
+  - documentation
+body:
+  - type: dropdown
+    id: problemType
+    attributes:
+      label: "What type of issue are you reporting?"
+      options:
+        - Suggested improvement
+        - Incorrect explanation / code sample
+        - Confusing explanation
+        - Outdated information
+        - Broken link
+        - Typo / Grammar
+    validations:
+      required: true
+  - type: dropdown
+    id: location
+    attributes:
+      label: "Section of the primer where the issue occurs"
+      options:
+        - Introduction
+        - Medley online and Medley Local
+        - Understanding and Navigating the Interface
+        - Understanding Lisp Syntax
+        - Atoms, Functions and Lists
+        - Variable Bindings and Scope
+        - Iterators and Conditionals
+        - The File Browser
+        - Debugging
+        - Editing functions with SEdit
+        - Build Your First Interactive Program
+        - Saving Your Work
+        - TEdit, The WYSIWYG Editor
+        - Drawing and Displaystreams
+        - Making a Graph with Grapher
+        - Additional Resources
+        - General Feedback (not specific to a section)
+    validations:
+      required: true
+  - type: textarea
+    id: issueLocationDetails
+    attributes:
+      label: "Please provide more details about the location of the issue"
+      description: "For example, the specific page title, section heading, or url."
+    validations:
+      required: false
+  - type: textarea
+    id: issueDescription
+    attributes:
+      label: "Description of the issue"
+      description: "Please provide a detailed description of the issue you encountered."
+    validations:
+      required: true
+  - type: textarea
+    id: suggestedFix
+    attributes:
+      label: "Suggested fix or improvement"
+      description: "If you have a suggestion for how to fix or improve the issue, please provide it here."
+    validations:
+      required: false
+  - type: markdown
+    attributes:
+      value: "## Thank you for helping us improve the **Medley Interlisp for the Newcomer** primer!"

.github/ISSUE_TEMPLATE/what_people_are_saying.yml

@@ -1,6 +1,6 @@
-name: "New entry for **What People Are Saying**"
-description: "Suggest a new entry for the **What People are Saying** page"
-title: "What People are Saying suggestion"
+name: New "What People Are Saying" entry
+description: 'Suggest a new entry for the "What People Are Saying" page'
+title: "What People Are Saying suggestion"
 body:
   - type: dropdown
     id: contentType
@@ -24,7 +24,7 @@ body:
     id: additionalInformation
     attributes:
       label:  Additional information
-      description: "Use this space to supply any addiitonal information on the suggested item."
+      description: "Use this space to supply any additional information on the suggested item."
     validations:
       required: false
   - type: markdown

internal/loadups/LOADUP-LISP

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "18-Aug-2025 12:09:49" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;21|
 6713   
+
(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2|
 7333   
 
-      :EDIT-BY |rmk|
+      :EDIT-BY "lmm"
 
       :CHANGES-TO (FNS LOADUP-LISP)
 
-      :PREVIOUS-DATE "15-Jun-2025 14:39:57" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;20|)
+      :PREVIOUS-DATE "16-Oct-2025 16:55:27" 
+|{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|)
 
 
 (PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -19,7 +20,9 @@
 (DEFINEQ
 
 (LOADUP-LISP

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


+  (LAMBDA (DRIBBLEFILE)
                                     (* \; "Edited  5-Nov-2025 09:01 by lmm")


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


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


                                                             (* \; "Edited 15-Jun-2025 14:39 by rmk")


                                                             (* \; "Edited 24-May-2025 10:20 by rmk")


                                                             (* \; "Edited 21-May-2025 09:25 by rmk")


@@ -89,9 +92,11 @@
 
     (* |;;| "Before the MEDLEYFONT implementation, FONTPROFILE came after NEWPRINTDEF above, but the loadup failed for undiagnosed reasons.  After moving it around, it appears that it must come before MENU, because it creates thw WINDOWTITLEFONT, but after HLDISPLAY.  Not yet known what the HLDISPLAY dependency is.  ")

 
-    (LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ 
-                    WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT
-                    DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
+    (* |;;| "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 '(BREAK-AND-TRACE))
     (LOADUP '(FASDUMP XCL-COMPILER ADVISE))
 
@@ -123,7 +128,10 @@
 
     (* |;;| " Added late, LOAD late to avoid any dependencies")

 
+    (* |;;| "prevent medley from pinning CPU")

+
     (LOADUP '(XCL-LOOP XCL-HASH-LOOP))
+    (LOADUP '(BACKGROUND-YIELD))
 
     (* |;;| " networking code -- should make it optional but too many cross dependencies")

 
@@ -141,5 +149,5 @@
 (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (640 6507 (LOADUP-LISP 650 . 6505)))))
+  (FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125)))))
 STOP

library/UNICODE

@@ -1,20 +1,23 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Oct-2025 13:01:09" {WMEDLEY}<library>UNICODE.;179
 113928 
+
(FILECREATED "23-Oct-2025 08:31:21" {WMEDLEY}<library>UNICODE.;211
 82245  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS UNICODECOMS)
-                  (FNS XCCSTOMCCS-MAPPING READ-UNICODE-MAPPING MAKE-UNICODE-TRANSLATION-TABLES 
-                       MERGE-UNICODE-TRANSLATION-TABLES UNICODE-EXTEND-TRANSLATION?)
+      :CHANGES-TO (FNS UTOMCODE UTF8.INCCODEFN UTOMCODE? UTF8.PEEKCCODEFN)
+                  (VARS UNICODECOMS)
+                  (MACROS UNICODE.SMALLP)
 
-      :PREVIOUS-DATE " 5-Oct-2025 17:44:17" {WMEDLEY}<library>UNICODE.;174)
+      :PREVIOUS-DATE "22-Oct-2025 23:28:51" {WMEDLEY}<library>UNICODE.;210)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
 
 (RPAQQ UNICODECOMS

-       ((COMS                                                (* ; "External formats")

+       (
+        (* ;; "Unicode external formats and MCCS-to-Unicode mapping functions.  Must be loaded after UNICODE-TABLES.")

+
+        (COMS                                                (* ; "External formats")

               (FNS UTF8.OUTCHARFN UTF8.SLUG.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN 
                    \UTF8.BACKCCODEFN)
               (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16BE.BACKCCODEFN)
@@ -26,38 +29,16 @@
               (ADDVARS (*DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8)))
               (FNS UTF8.BINCODE \UTF8.FETCHCODE)
               (FNS UTF8.VALIDATE NUTF8-BYTE1-BYTES NUTF8-CODE-BYTES NUTF8-STRING-BYTES N-MCHARS)
-              (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE \UTF8.GETBASEBYTE))
-              (FNS MTOUCODE UTOMCODE MTOUCODE? UTOMCODE? MTOUSTRING UTOMSTRING MTOUTF8STRING 
-                   UTF8TOMSTRING)
-              (FNS XTOUCODE UTOXCODE XTOUCODE? UTOXCODE? XTOUSTRING UTOXSTRING XTOUTF8STRING))
+              (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE \UTF8.GETBASEBYTE 
+                                                      UNICODE.SMALLP)))
         
         (* ;; "")

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

-              (INITVARS (UNICODEDIRECTORIES NIL))
-              (VARS XCCS-CHARSETS)
-              (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 ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
-              (INITVARS (*MCCSTOUNICODE*)
-                     (*UNICODETOMCCS*)
-                     (*MCCS-LOADED-CHARSETS*)
-                     (*UNICODE-LOADED-CHARSETS*))
-              (GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* 
-                     *NEXT-PRIVATE-MCCSCODE* *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*)
-              (DECLARE%: EVAL@COMPILE DONTCOPY 
+        
+        (* ;; "These come after the translation tables have been loaded, since the Unix file names needed to read the mapping files depend on the UTF8 string coercions.  Those functions are defined as EVQ in UFS, cannot be used until the tables exist.  This assumes that previous files have only 7-bit MCCS characters in their names.")

 
-                     (* ;; "There are 6400 private Unicodes in 25 256-code charsets. For XCCS we map to a contiguous region of unused/reserved--private isn't big enough.")

-
-                     (CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000"))
-                            (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF"))
-                            (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0"))
-                            (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")))
-                     (MACROS TRUECODEP))
-              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL]
+        (FNS MTOUCODE UTOMCODE MTOUCODE? UTOMCODE? MTOUSTRING UTOMSTRING MTOUTF8STRING UTF8TOMSTRING)
+        (FNS XTOUCODE UTOXCODE XTOUCODE? UTOXCODE? XTOUSTRING UTOXSTRING XTOUTF8STRING)
         
         (* ;; "")

 
@@ -77,13 +58,20 @@
         (COMS                                                (* ; "debugging")

               (FNS SHOWCHARS)
               (DECLARE%: DOEVAL@LOAD DONTCOPY (MACROS HEXCHAR OCTALCHAR)))
-        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
-                                                EXPORTS.ALL))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
+                                                UNICODE-EXPORTS))
         (PROP (FILETYPE)
               UNICODE)))
 
 
 
+(* ;; 
+"Unicode external formats and MCCS-to-Unicode mapping functions.  Must be loaded after UNICODE-TABLES."
+)

+
+
+
+
 (* ; "External formats")

 
 (DEFINEQ
@@ -150,7 +138,8 @@
            T])
 
 (UTF8.INCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 24-Apr-2025 15:44 by rmk")


+  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 23-Oct-2025 08:31 by rmk")


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


                                                              (* ; "Edited  2-Feb-2024 11:44 by rmk")


                                                              (* ; "Edited 30-Jan-2024 22:56 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:02 by rmk:")


@@ -235,13 +224,15 @@
                                       (LLSH (LOADBYTE BYTE3 0 6)
                                             6)
                                       (LOADBYTE BYTE4 0 6])
-         (CL:UNLESS (OR RAW (NOT (SMALLP CODE)))
-             (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*)))
+         (CL:UNLESS RAW
+             (SETQ CODE (UNICODE.TRANSLATE (UNICODE.SMALLP CODE)
+                               *UNICODETOMCCS*)))
          (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
          CODE])
 
 (UTF8.PEEKCCODEFN

-  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 24-Apr-2025 15:44 by rmk")


+  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 23-Oct-2025 08:26 by rmk")


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


                                                              (* ; "Edited  2-Feb-2024 11:48 by rmk")


                                                             (* ; "Edited 14-Jun-2021 22:53 by rmk:")

 
@@ -324,7 +315,8 @@
                    elseif
 NOERROR
                    else
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4]
           (CL:WHEN (AND CODE (NOT RAW))
-              (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*)))
+              (SETQ CODE (UNICODE.TRANSLATE (UNICODE.SMALLP CODE)
+                                *UNICODETOMCCS*)))
           (RETURN CODE])
 
 (\UTF8.BACKCCODEFN

@@ -854,7 +846,7 @@
                                    (* ;; "If RETURNALL and there are alternatives in the RANG, the list is returned. Othewise just the first one if the fake flag allows ")

 
                                     (LET [(RANGE (OR (GETHASH CODE TRANSLATION-TABLE)
-                                                     (UNICODE.UNMAPPED
 CODE TRANSLATION-TABLE 
+                                                     (UNICODE.UNMAPPED CODE TRANSLATION-TABLE 
                                                             DONTFAKE]
                                          (CL:WHEN RANGE
                                              (if
 (AND RETURNALL (CDR RANGE))
@@ -872,8 +864,26 @@
                                                         (ERROR "INVALID UTF8 BYTE" BYTE))
                                                  BYTE)
                                      ELSE
 (\GETBASEBYTE BASE OFFSET))))
+
+(PUTPROPS UNICODE.SMALLP
 MACRO
 [OPENLAMBDA (UNICODE)         (* ; 
+
                                                "Cananonicalizes a large UNICODE for EQ hash-testing")

+                                 (OR (SMALLP UNICODE)
+                                     (CAR (OR (MEMBER UNICODE *LARGEUNICODES*)
+                                              (PUSH
 *LARGEUNICODES* UNICODE])
 )
 )
+
+
+
+(* ;; "")

+
+
+
+
+(* ;; 
+"These come after the translation tables have been loaded, since the Unix file names needed to read the mapping files depend on the UTF8 string coercions.  Those functions are defined as EVQ in UFS, cannot be used until the tables exist.  This assumes that previous files have only 7-bit MCCS characters in their names."
+)

+
 (DEFINEQ
 
 (MTOUCODE

@@ -883,10 +893,12 @@
     (UNICODE.TRANSLATE MCODE *MCCSTOUNICODE*])
 
 (UTOMCODE

-  [LAMBDA (UNNICODE)
                                         (* ; "Edited 24-Apr-2025 10:17 by rmk")


+  [LAMBDA (UNICODE)
                                          (* ; "Edited 23-Oct-2025 08:23 by rmk")


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


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


                                                             (* ; "Edited  9-Aug-2020 09:04 by rmk:")

-    (UNICODE.TRANSLATE UNNICODE *UNICODETOMCCS*])
+    (UNICODE.TRANSLATE (UNICODE.SMALLP UNICODE)
+           *UNICODETOMCCS*])
 
 (MTOUCODE?

   [LAMBDA (MCODE)
                                            (* ; "Edited  4-Sep-2025 15:09 by rmk")


@@ -902,7 +914,8 @@
     (UNICODE.TRANSLATE MCODE *MCCSTOUNICODE* T T])
 
 (UTOMCODE?

-  [LAMBDA (UNICODE)
                                          (* ; "Edited 24-Apr-2025 10:18 by rmk")


+  [LAMBDA (UNICODE)
                                          (* ; "Edited 23-Oct-2025 08:24 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 10:18 by rmk")


                                                              (* ; "Edited 19-Jan-2025 21:14 by rmk")


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


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


@@ -914,7 +927,10 @@
     (* ;; 
 
    " NOTE:  Alternative codes are returned in a list, the code itself is returned for a singleton.")

 
-    (UNICODE.TRANSLATE UNICODE *UNICODETOMCCS* T T])
+    (* ;; "Canonicalize unicodes outside of the 16-bit plane")

+
+    (UNICODE.TRANSLATE (UNICODE.SMALLP UNICODE)
+           *UNICODETOMCCS* T T])
 
 (MTOUSTRING

   [LAMBDA (MSTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 12:19 by rmk")


@@ -1002,7 +1018,9 @@
       else
 MSTRING])
 
 (UTF8TOMSTRING

-  [LAMBDA (UTF8STRING)
                                       (* ; "Edited  9-Sep-2025 08:59 by rmk")

+  [LAMBDA (UTF8STRING)
                                       (* ; "Edited 22-Oct-2025 22:00 by rmk")


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


+                                                             (* ; "Edited  9-Sep-2025 08:59 by rmk")

     (CL:UNLESS (OR (STRINGP UTF8STRING)
                    (LITATOM UTF8STRING))
         (SETQ UTF8STRING (MKSTRING UTF8STRING)))
@@ -1112,552 +1130,6 @@
 
 
 
-(* ; "Read Unicode mapping files")

-
-
-(RPAQ? UNICODEDIRECTORIES
 NIL)
-
-(RPAQQ XCCS-CHARSETS

-       ((LATIN "0")
-        (JAPANESE-SYMBOLS1 "41")
-        (JAPANESE-SYMBOLS2 "42")
-        (EXTENDED-LATIN "43")
-        (HIRAGANA "44")
-        (KATAKANA "45")
-        (GREEK "46")
-        (CYRILLIC "47")
-        (FORMS "50")
-        (RUNIC-GOTHIC "51")
-        (MORE-CYRILLIC "52")
-        (UNKNOWN1 "56")
-        (UNKNOWN2 "57")
-        (JIS "60-166")
-        (ARABIC "340")
-        (HEBREW "341")
-        (IPA "342")
-        (HANGUL "343")
-        (GEORGIAN-ARMENIAN "344")
-        (DEVANAGRI "345")
-        (BENGALI "346")
-        (GURMUKHI "347")
-        (THAI-LAO "350")
-        (SYMBOLS3 "353")
-        (EXTENDED-ITC-DINGBATS "354")
-        (ITC-DINGBATS1 "355")
-        (SYMBOLS2 "356")
-        (SYMBOLS1 "357")
-        (LIGATURES "360")
-        (ACCENTED-LATIN1 "361")
-        (ACCENTED-LATIN2 "362")
-        (ACCENTED-GREEK1 "363")
-        (ACCENTED-GREEK2 "364")
-        (MORE-ARABIC "365")
-        (GRAPHIC-VARIANTS "375")
-        (DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1 
-               JAPANESE-SYMBOLS2)
-        (JAPANESE HIRAGANA KATAKANA JIS)))
-(DEFINEQ
-
-(READ-UNICODE-MAPPING-FILENAMES

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


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


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


-                                                             (* ; "Edited 19-Jan-2025 12:21 by rmk")


-                                                             (* ; "Edited  3-Feb-2024 11:00 by rmk")


-                                                             (* ; "Edited 30-Jan-2024 08:45 by rmk")


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


-                                                          (* ; "Edited  5-Aug-2020 15:59 by kaplan")


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

-
-    (* ;; "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
-     [if
 (EQ FILESPEC 'ALL)
-         then
 
-              (* ;; 
-
          "Perhaps should figure out which files in the directories and subdirectories are relevant?")

-
-              (READ-UNICODE-MAPPING-FILENAMES
 (for
 N in
 XCCS-CHARSETS collect
 (CAR N)))
-       else
 (FOR
 F X CSI INSIDE
 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)               (* ; 
-
                                                        "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])
-
-(READ-UNICODE-MAPPING

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


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


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


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


-                                                             (* ; "Edited 17-Jan-2025 16:41 by rmk")


-                                                             (* ; "Edited  3-Feb-2024 00:21 by rmk")


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


-                                                            (* ; "Edited  3-Jul-2021 13:37 by rmk:")

-
-    (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format.  Comments prefixed by # and")

-
-    (* ;; "               Column 1:  XCCS input hex code in the format 0xXXXX")

-
-    (* ;; "               Column 2:  Corresponding Unicode code-sequence in the format")

-
-    (* ;; "                                            0xXXXX  ... 0xYYYY")

-
-    (* ;; "               Column 3:  (after #) Character name in some mapping files, utf-8 character")

-
-    (* ;; "                                     for XCCS mapping files")

-
-    (* ;; "")

-
-    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode, where fromcode is an XCCS code and the tocodes are corresponding Unicodes.")

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

-                                                                     FILESPEC)
-       join
 
-            (* ;; "External format  :THROUGH means read as bytes, so the Unicode UTF-8 comments cannot cause reading problems.")

-
-            (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT `(:THROUGH LF))
-                   (bind
 LINE NAME CHARSET START MAP
-                      first
 (CL:UNLESS (FILEPOS "Name:" STREAM NIL NIL NIL T)
-                                (ERROR "NOT A UNICODE MAPPING FILE" (FULLNAME STREAM)))
-                            (SETQ NAME (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL)))
-                            (SETQ CHARSET (CL:IF (FILEPOS "XCCS charset:" STREAM NIL NIL NIL T)
-                                              (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL))
-                                              ""))
-                            (CL:WHEN PRINT                   (* ; "Strip off XCCS in front of name")

-                                (PRINTOUT T T CHARSET " " [SUBSTRING NAME (CONSTANT
-                                                                           (ADD1 (NCHARS "XCCS"]
-                                       T)) while
 (SETQ LINE (CL:READ-LINE STREAM NIL NIL))
-                      when
 (SETQ START (STRPOSL SEPBITTABLE LINE 1 T))
-                      unless
 (EQ (CHARCODE %#)
-                                 (NTHCHARCODE LINE START))
-                      collect
 [SETQ MAP (bind
 END CODES while
 [SETQ END (OR (STRPOSL SEPBITTABLE LINE
-                                                                                   START)
-                                                                            (ADD1 (NCHARS LINE]
-                                           collect
 [CHARCODE.DECODE (SUBSTRING LINE START
-                                                                           (SUB1 END)
-                                                                           (CONSTANT (CONCAT]
-                                           repeatwhile
 (AND (SETQ START (STRPOSL SEPBITTABLE LINE END
-                                                                               T))
-                                                            (NEQ (CHARCODE %#)
-                                                                 (NTHCHARCODE LINE START)))
-                                           finally
 (CL:WHEN (CDDR $$VAL)
-                                                             (* ; "Combiners go into a CADR list")

-                                                       (RPLACD $$VAL (CONS (CDR $$VAL))))]
-                            MAP])
-)
-
-
-
-(* ; "Make translation tables for  UTF external formats")

-
-(DEFINEQ
-
-(MAKE-UNICODE-TRANSLATION-TABLES

-  [LAMBDA (MAPPING REINSTALL)
                                (* ; "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")


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


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


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


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


-                                                             (* ; "Edited  3-Feb-2024 00:24 by rmk")


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


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

-
-    (* ;; "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).")

-
-    (* ;; "")

-
-    (* ;; "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
-        then
 (SETQ *MCCS-LOADED-CHARSETS* (SETQ *UNICODE-LOADED-CHARSETS* NIL))
-             (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE)
-             (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE)
-             (LET [(TABLE (HASHARRAY (LENGTH MAPPING)))
-                   (INVERSETABLE (HASHARRAY (LENGTH MAPPING]
-                  (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING TABLE INVERSETABLE)
-                  (SETQ *MCCSTOUNICODE* TABLE)
-                  (SETQ *UNICODETOMCCS* INVERSETABLE)
-                  (LIST *MCCSTOUNICODE* *UNICODETOMCCS*))
-      else
 (CL:UNLESS (BOUNDP '*NEXT-PRIVATE-MCCSCODE*)
-               (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE)
-               (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
-           (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING])
-
-(XCCSTOMCCS-MAPPING

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

-
-    (* ;; 
-
    "This translates the pairs that map XCCS to Unicode into pairs that translate MCCS to Unicode.")

-
-    (* ;; 
-
   "We grab the affected pairs before we make any changes so that we don't get into ordering issues.")

-
-    (LET* ([XTOMCODES (CHARCODE ((Currency Dollar)
-                                 (Dollar Currency)
-                                 (Uparrow Circumflex)
-                                 (Circumflex Uparrow)
-                                 (Leftarrow Lowline)
-                                 (Lowline Leftarrow]
-           (AFFECTED (for
 MP in
 XTOUMAPPING when
 (thereis
 XP in
 XTOMCODES
-                                                    suchthat
 (EQ (CAR MP)
-                                                                 (CAR XP))) collect
 MP)))
-          (for
 AP in
 AFFECTED do
 (RPLACA AP (CADR (ASSOC (CAR AP)
-                                                         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")


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


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


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


-                                                             (* ; "Edited 19-Jan-2025 12:20 by rmk")


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


-                                                             (* ; "Edited 15-Jan-2025 09:49 by rmk")


-                                                             (* ; "Edited 27-Mar-2024 14:48 by rmk")


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


-                                                             (* ; "Edited  3-Feb-2024 09:16 by rmk")

-
-    (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps between MCCS codes and UNICODE codes, depending on INVERTED.")

-
-    (* ;; "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")

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

-
-    (* ;; "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)) 
-
-                         (* ;; 
-
       "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 ...).  (CADR is the first (and almost always) the only one.")

-
-                         (pushnew
 [CDR (OR (ASSOC DOMAIN (CDR CHARSET))
-                                           (CAR (push
 (CDR CHARSET)
-                                                      (CONS DOMAIN]
-                                RANGE))
-
-         (* ;; "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
 
-                                                                 (* ;; 
-
                                                                "Sort the range alternatives, if any")

-
-                                                                 (change
 (CDR M)
-                                                                        (SORT DATUM))) 
-
-                             (* ;; "Sort by domain codes and push down a level")

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

-         (if
 FILE
-             then
 (SETQ FILE (PACKFILENAME 'BODY (if
 (NEQ FILE T)
-                                                     then
 FILE
-                                                   elseif
 INVERTED
-                                                     then
 'UNICODE-TO-MCCS-MAPPINGS
-                                                   else
 'MCCS-TO-UNICODE-MAPPINGS)
-                                    'DIRECTORY
-                                    (CAR (MKLIST UNICODEDIRECTORIES))
-                                    'EXTENSION
-                                    'TXT))
-                  (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
-
-                         (* ;; 
-
         "We can FILEPOS for %"[nnn %" then READ for each segment. Or just READFILE to get them all.")

-
-                         (for
 I in
 INDEX do
 (PRINTOUT STREAM "[" (CAR I)
-                                                   " "
-                                                   (CADR I)
-                                                   "]" T T))
-                         (PRINTOUT STREAM "STOP" T)
-                         (FULLNAME STREAM))
-           else
 INDEX])
-
-(XCCSJAPANESECHARSETS

-  [LAMBDA (OCTAL FILE)
                                       (* ; "Edited 11-Jun-2025 23:00 by rmk")

-
-    (* ;; "Returns the list of numbers for the Japanese character sets.")

-
-    (for
 F POS CS in
 (READ-UNICODE-MAPPING-FILENAMES
 "JIS")
-       when
 (SETQ POS (STRPOS "XCCS-" F 1 NIL NIL T))
-       collect
 [SETQ CS (SUBSTRING F POS (SUB1 (STRPOS '=JIS F POS]
-             (CL:IF OCTAL
-                 CS
-                 (MKATOM (CONCAT CS "Q")))
-       finally
 (SORT $$VAL)
-             (CL:WHEN FILE
-                 (RETURN (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'BODY (CL:IF (EQ FILE T)
-                                                                            "JAPANESECHARSETS"
-                                                                            FILE)
-                                                           'DIRECTORY
-                                                           (CAR (MKLIST UNICODEDIRECTORIES))
-                                                           'EXTENSION
-                                                           'TXT)
-                                                   :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
-                                (PRINT $$VAL STREAM)
-                                (FULLNAME STREAM))))])
-)
-
-(RPAQ? *MCCSTOUNICODE*
 )
-
-(RPAQ? *UNICODETOMCCS*
 )
-
-(RPAQ? *MCCS-LOADED-CHARSETS*
 )
-
-(RPAQ? *UNICODE-LOADED-CHARSETS*
 )
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* 
-       *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*)
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQ FIRST-PRIVATE-UNICODE
 (HEXNUM? "E000"))
-
-(RPAQ LAST-PRIVATE-UNICODE
 (HEXNUM? "F8FF"))
-
-(RPAQ FIRST-PRIVATE-MCCSCODE
 (CHARCODE "200,0"))
-
-(RPAQ LAST-PRIVATE-MCCSCODE
 (CHARCODE "230,377"))
-
-
-(CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000"))
-       (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF"))
-       (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0"))
-       (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")))
-)
-
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS TRUECODEP
 MACRO
 (OPENLAMBDA (RANGE TABLE)
-
-                            (* ;; "Return NIL if RANGE is a fake range in TABLE, otherwise RANGE.")

-
-                            (CL:UNLESS (CL:IF (EQ TABLE *MCCSTOUNICODE*)
-                                           (AND (IGEQ RANGE FIRST-PRIVATE-UNICODE)
-                                                (ILEQ RANGE LAST-PRIVATE-UNICODE))
-                                           (AND (IGEQ RANGE FIRST-PRIVATE-MCCSCODE)
-                                                (ILEQ RANGE LAST-PRIVATE-MCCSCODE)))
-                                   RANGE)))
-)
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(MAKE-UNICODE-TRANSLATION-TABLES
 'ALL)
-)
-
-
-
-(* ;; "")

-
-
-
-
 (* ; "Write Unicode mapping files")

 
 (DEFINEQ
@@ -2005,31 +1477,27 @@
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
-(FILESLOAD (FROM
 LOADUPS)
-       EXPORTS.ALL)
+(FILESLOAD (LOADCOMP)
+       UNICODE-EXPORTS)
 )
 
 (PUTPROPS UNICODE
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4573 19821 (UTF8.OUTCHARFN 4583 . 7599) (UTF8.SLUG.OUTCHARFN 7601 . 8265) (
-UTF8.INCCODEFN 8267 . 13988) (UTF8.PEEKCCODEFN 13990 . 18839) (\UTF8.BACKCCODEFN 18841 . 19819)) (
-19822 24512 (UTF16BE.OUTCHARFN 19832 . 20851) (UTF16BE.INCCODEFN 20853 . 21978) (UTF16BE.PEEKCCODEFN 
-21980 . 23320) (\UTF16BE.BACKCCODEFN 23322 . 24510)) (24513 29236 (UTF16LE.OUTCHARFN 24523 . 25639) (
-UTF16LE.INCCODEFN 25641 . 26766) (UTF16LE.PEEKCCODEFN 26768 . 28044) (\UTF16LE.BACKCCODEFN 28046 . 
-29234)) (29237 32284 (READBOM 29247 . 31316) (WRITEBOM 31318 . 32282)) (32314 35879 (
-MAKE-UNICODE-FORMATS 32324 . 35877)) (35976 40470 (UTF8.BINCODE 35986 . 38674) (\UTF8.FETCHCODE 38676
- . 40468)) (40471 46098 (UTF8.VALIDATE 40481 . 43078) (NUTF8-BYTE1-BYTES 43080 . 43817) (
-NUTF8-CODE-BYTES 43819 . 44876) (NUTF8-STRING-BYTES 44878 . 45774) (N-MCHARS 45776 . 46096)) (47826 
-56695 (MTOUCODE 47836 . 48223) (UTOMCODE 48225 . 48615) (MTOUCODE? 48617 . 49650) (UTOMCODE? 49652 . 
-50616) (MTOUSTRING 50618 . 51203) (UTOMSTRING 51205 . 51790) (MTOUTF8STRING 51792 . 55798) (
-UTF8TOMSTRING 55800 . 56693)) (56696 62398 (XTOUCODE 56706 . 57224) (UTOXCODE 57226 . 57734) (
-XTOUCODE? 57736 . 58797) (UTOXCODE? 58799 . 59882) (XTOUSTRING 59884 . 60577) (UTOXSTRING 60579 . 
-61320) (XTOUTF8STRING 61322 . 62396)) (63635 71937 (READ-UNICODE-MAPPING-FILENAMES 63645 . 67442) (
-READ-UNICODE-MAPPING 67444 . 71935)) (72004 86230 (MAKE-UNICODE-TRANSLATION-TABLES 72014 . 75770) (
-XCCSTOMCCS-MAPPING 75772 . 76989) (MERGE-UNICODE-TRANSLATION-TABLES 76991 . 79644) (UNICODE.UNMAPPED 
-79646 . 82970) (UNICODE-EXTEND-TRANSLATION? 82972 . 86228)) (86231 93067 (ALL-UNICODE-MAPPINGS 86241
- . 91730) (XCCSJAPANESECHARSETS 91732 . 93065)) (94658 105926 (WRITE-UNICODE-MAPPING 94668 . 98418) (
-WRITE-UNICODE-INCLUDED 98420 . 103142) (WRITE-UNICODE-MAPPING-HEADER 103144 . 104392) (
-WRITE-UNICODE-MAPPING-FILENAME 104394 . 105924)) (105927 106603 (XCCS-UTF8-AFTER-OPEN 105937 . 106601)
-) (109128 111345 (UTF8HEXSTRING 109138 . 111343)) (111372 113414 (SHOWCHARS 111382 . 113412)))))
+  (FILEMAP (NIL (3488 19026 (UTF8.OUTCHARFN 3498 . 6514) (UTF8.SLUG.OUTCHARFN 6516 . 7180) (
+UTF8.INCCODEFN 7182 . 13035) (UTF8.PEEKCCODEFN 13037 . 18044) (\UTF8.BACKCCODEFN 18046 . 19024)) (
+19027 23717 (UTF16BE.OUTCHARFN 19037 . 20056) (UTF16BE.INCCODEFN 20058 . 21183) (UTF16BE.PEEKCCODEFN 
+21185 . 22525) (\UTF16BE.BACKCCODEFN 22527 . 23715)) (23718 28441 (UTF16LE.OUTCHARFN 23728 . 24844) (
+UTF16LE.INCCODEFN 24846 . 25971) (UTF16LE.PEEKCCODEFN 25973 . 27249) (\UTF16LE.BACKCCODEFN 27251 . 
+28439)) (28442 31489 (READBOM 28452 . 30521) (WRITEBOM 30523 . 31487)) (31519 35084 (
+MAKE-UNICODE-FORMATS 31529 . 35082)) (35181 39675 (UTF8.BINCODE 35191 . 37879) (\UTF8.FETCHCODE 37881
+ . 39673)) (39676 45303 (UTF8.VALIDATE 39686 . 42283) (NUTF8-BYTE1-BYTES 42285 . 43022) (
+NUTF8-CODE-BYTES 43024 . 44081) (NUTF8-STRING-BYTES 44083 . 44979) (N-MCHARS 44981 . 45301)) (47785 
+57213 (MTOUCODE 47795 . 48182) (UTOMCODE 48184 . 48710) (MTOUCODE? 48712 . 49745) (UTOMCODE? 49747 . 
+50916) (MTOUSTRING 50918 . 51503) (UTOMSTRING 51505 . 52090) (MTOUTF8STRING 52092 . 56098) (
+UTF8TOMSTRING 56100 . 57211)) (57214 62916 (XTOUCODE 57224 . 57742) (UTOXCODE 57744 . 58252) (
+XTOUCODE? 58254 . 59315) (UTOXCODE? 59317 . 60400) (XTOUSTRING 60402 . 61095) (UTOXSTRING 61097 . 
+61838) (XTOUTF8STRING 61840 . 62914)) (62979 74247 (WRITE-UNICODE-MAPPING 62989 . 66739) (
+WRITE-UNICODE-INCLUDED 66741 . 71463) (WRITE-UNICODE-MAPPING-HEADER 71465 . 72713) (
+WRITE-UNICODE-MAPPING-FILENAME 72715 . 74245)) (74248 74924 (XCCS-UTF8-AFTER-OPEN 74258 . 74922)) (
+77449 79666 (UTF8HEXSTRING 77459 . 79664)) (79693 81735 (SHOWCHARS 79703 . 81733)))))
 STOP

library/UNICODE-EXPORTS

@@ -0,0 +1,79 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "22-Oct-2025 23:27:50" {WMEDLEY}<library>UNICODE-EXPORTS.;1
 2673   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS UNICODE-EXPORTSCOMS))
+
+
+(PRETTYCOMPRINT UNICODE-EXPORTSCOMS)
+
+(RPAQQ UNICODE-EXPORTSCOMS

+       (
+        (* ;; "Compile-time declarations shared by UNICODE-TABLES and UNICODE")

+
+        (GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* 
+               *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS* *LARGEUNICODES*)
+        
+        (* ;; "There are 6400 private Unicodes in 25 256-code charsets. For MCCS we map to a contiguous region of unused/reserved--private isn't big enough.")

+
+        (CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000"))
+               (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF"))
+               (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0"))
+               (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")))
+        (MACROS TRUECODEP)
+        (FILES (FROM LOADUPS)
+               EXPORTS.ALL)))
+
+
+
+(* ;; "Compile-time declarations shared by UNICODE-TABLES and UNICODE")

+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* 
+       *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS* *LARGEUNICODES*)
+)
+
+
+
+(* ;; 
+"There are 6400 private Unicodes in 25 256-code charsets. For MCCS we map to a contiguous region of unused/reserved--private isn't big enough."
+)

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQ FIRST-PRIVATE-UNICODE
 (HEXNUM? "E000"))
+
+(RPAQ LAST-PRIVATE-UNICODE
 (HEXNUM? "F8FF"))
+
+(RPAQ FIRST-PRIVATE-MCCSCODE
 (CHARCODE "200,0"))
+
+(RPAQ LAST-PRIVATE-MCCSCODE
 (CHARCODE "230,377"))
+
+
+(CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000"))
+       (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF"))
+       (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0"))
+       (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")))
+)
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS TRUECODEP
 MACRO
 (OPENLAMBDA (RANGE TABLE)
+
+                            (* ;; "Return NIL if RANGE is a fake range in TABLE, otherwise RANGE.")

+
+                            (CL:UNLESS (CL:IF (EQ TABLE *MCCSTOUNICODE*)
+                                           (AND (IGEQ RANGE FIRST-PRIVATE-UNICODE)
+                                                (ILEQ RANGE LAST-PRIVATE-UNICODE))
+                                           (AND (IGEQ RANGE FIRST-PRIVATE-MCCSCODE)
+                                                (ILEQ RANGE LAST-PRIVATE-MCCSCODE)))
+                                   RANGE)))
+)
+
+(FILESLOAD (FROM
 LOADUPS)
+       EXPORTS.ALL)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

library/UNICODE-TABLES

@@ -0,0 +1,571 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "22-Oct-2025 23:28:42" {WMEDLEY}<library>UNICODE-TABLES.;4
 34028  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS UNICODE-TABLESCOMS)
+
+      :PREVIOUS-DATE "16-Oct-2025 16:47:54" {WMEDLEY}<library>UNICODE-TABLES.;3)
+
+
+(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.")

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

+              (INITVARS (UNICODEDIRECTORIES NIL))
+              (GLOBALVARS UNICODEDIRECTORIES)
+              (VARS XCCS-CHARSETS)
+              (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 ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
+              (INITVARS (*MCCSTOUNICODE*)
+                     (*UNICODETOMCCS*)
+                     (*MCCS-LOADED-CHARSETS*)
+                     (*UNICODE-LOADED-CHARSETS*)
+                     (*LARGEUNICODES*))
+              [DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL]
+              (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."
+)

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

+
+
+(RPAQ? UNICODEDIRECTORIES
 NIL)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS UNICODEDIRECTORIES)
+)
+
+(RPAQQ XCCS-CHARSETS

+       ((LATIN "0")
+        (JAPANESE-SYMBOLS1 "41")
+        (JAPANESE-SYMBOLS2 "42")
+        (EXTENDED-LATIN "43")
+        (HIRAGANA "44")
+        (KATAKANA "45")
+        (GREEK "46")
+        (CYRILLIC "47")
+        (FORMS "50")
+        (RUNIC-GOTHIC "51")
+        (MORE-CYRILLIC "52")
+        (UNKNOWN1 "56")
+        (UNKNOWN2 "57")
+        (JIS "60-166")
+        (ARABIC "340")
+        (HEBREW "341")
+        (IPA "342")
+        (HANGUL "343")
+        (GEORGIAN-ARMENIAN "344")
+        (DEVANAGRI "345")
+        (BENGALI "346")
+        (GURMUKHI "347")
+        (THAI-LAO "350")
+        (SYMBOLS3 "353")
+        (EXTENDED-ITC-DINGBATS "354")
+        (ITC-DINGBATS1 "355")
+        (SYMBOLS2 "356")
+        (SYMBOLS1 "357")
+        (LIGATURES "360")
+        (ACCENTED-LATIN1 "361")
+        (ACCENTED-LATIN2 "362")
+        (ACCENTED-GREEK1 "363")
+        (ACCENTED-GREEK2 "364")
+        (MORE-ARABIC "365")
+        (GRAPHIC-VARIANTS "375")
+        (DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1 
+               JAPANESE-SYMBOLS2)
+        (JAPANESE HIRAGANA KATAKANA JIS)))
+(DEFINEQ
+
+(READ-UNICODE-MAPPING-FILENAMES

+  [LAMBDA (FILESPEC)
                                         (* ; "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")


+                                                             (* ; "Edited 19-Jan-2025 12:21 by rmk")


+                                                             (* ; "Edited  3-Feb-2024 11:00 by rmk")


+                                                             (* ; "Edited 30-Jan-2024 08:45 by rmk")


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


+                                                          (* ; "Edited  5-Aug-2020 15:59 by kaplan")


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

+
+    (* ;; "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
 
+                                                       (* ;; 
+
          "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)")

+
+                                  (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])
+
+(READ-UNICODE-MAPPING

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


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


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


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


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


+                                                             (* ; "Edited 17-Jan-2025 16:41 by rmk")


+                                                             (* ; "Edited  3-Feb-2024 00:21 by rmk")


+                                                             (* ; "Edited  5-Jan-2024 12:26 by rmk")


+                                                            (* ; "Edited  3-Jul-2021 13:37 by rmk:")

+
+    (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format.  Comments prefixed by # and")

+
+    (* ;; "               Column 1:  XCCS input hex code in the format 0xXXXX")

+
+    (* ;; "               Column 2:  Corresponding Unicode code-sequence in the format")

+
+    (* ;; "                                            0xXXXX  ... 0xYYYY")

+
+    (* ;; "               Column 3:  (after #) Character name in some mapping files, utf-8 character")

+
+    (* ;; "                                     for XCCS mapping files")

+
+    (* ;; "")

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

+                                                                                FILESPEC)
+           join
 
+                (* ;; "External format  :THROUGH means read as bytes, so the Unicode UTF-8 comments cannot cause reading problems.")

+
+                [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT NIL '((FORMAT :THROUGH)
+                                                                      (EOLCONVENTION LF]
+                       '(PROGN (CLOSEF? OLDVALUE]
+                (bind
 LINE NAME CHARSET START
+                   first
 (CL:UNLESS (FILEPOS "Name:" STREAM NIL NIL NIL T)
+                             (ERROR "NOT A UNICODE MAPPING FILE" (FULLNAME STREAM)))
+                         (SETQ NAME (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL)))
+                         (SETQ CHARSET (CL:IF (FILEPOS "XCCS charset:" STREAM NIL NIL NIL T)
+                                           (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL))
+                                           ""))
+                         (CL:WHEN PRINT                      (* ; "Strip off XCCS in front of name")

+                             (PRINTOUT T T CHARSET " " [SUBSTRING NAME (CONSTANT (ADD1 (NCHARS "XCCS"
+                                                                                              ]
+                                    T)) while
 (SETQ LINE (CL:READ-LINE STREAM NIL NIL))
+                   when
 (SETQ START (STRPOSL SEPBITTABLE LINE 1 T))
+                   unless
 (EQ (CHARCODE %#)
+                              (NTHCHARCODE LINE START))
+                   collect
 [bind
 END CODES while
 [SETQ END (OR (STRPOSL SEPBITTABLE LINE START)
+                                                               (ADD1 (NCHARS LINE]
+                              collect
 [CHARCODE.DECODE (SUBSTRING LINE START (SUB1 END)
+                                                              (CONSTANT (CONCAT]
+                              repeatwhile
 (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T))
+                                               (NEQ (CHARCODE %#)
+                                                    (NTHCHARCODE LINE START)))
+                              finally
 (CL:WHEN (CDDR $$VAL)  (* ; "Combiners go into a CADR list")

+                                          (RPLACD $$VAL (CONS (CDR $$VAL))))]
+                   finally
 (CLOSEF? STREAM))))])
+)
+
+
+
+(* ; "Make translation tables for  UTF external formats")

+
+(DEFINEQ
+
+(MAKE-UNICODE-TRANSLATION-TABLES

+  [LAMBDA (MAPPING REINSTALL)
                                (* ; "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")


+                                                             (* ; "Edited 26-Jan-2025 19:36 by rmk")


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


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


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


+                                                             (* ; "Edited  3-Feb-2024 00:24 by rmk")


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


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

+
+    (* ;; "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).")

+
+    (* ;; "")

+
+    (* ;; "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
+        then
 (SETQ *MCCS-LOADED-CHARSETS* (SETQ *UNICODE-LOADED-CHARSETS* NIL))
+             (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE)
+             (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE)
+             (LET [(TABLE (HASHARRAY (LENGTH MAPPING)))
+                   (INVERSETABLE (HASHARRAY (LENGTH MAPPING]
+                  (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING TABLE INVERSETABLE)
+                  (SETQ *MCCSTOUNICODE* TABLE)
+                  (SETQ *UNICODETOMCCS* INVERSETABLE)
+                  (LIST *MCCSTOUNICODE* *UNICODETOMCCS*))
+      else
 (CL:UNLESS (BOUNDP '*NEXT-PRIVATE-MCCSCODE*)
+               (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE)
+               (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
+           (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING])
+
+(XCCSTOMCCS-MAPPING

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

+
+    (* ;; 
+
    "This translates the pairs that map XCCS to Unicode into pairs that translate MCCS to Unicode.")

+
+    (* ;; 
+
   "We grab the affected pairs before we make any changes so that we don't get into ordering issues.")

+
+    (LET* ([XTOMCODES (CHARCODE ((Currency Dollar)
+                                 (Dollar Currency)
+                                 (Uparrow Circumflex)
+                                 (Circumflex Uparrow)
+                                 (Leftarrow Lowline)
+                                 (Lowline Leftarrow]
+           (AFFECTED (for
 MP in
 XTOUMAPPING when
 (thereis
 XP in
 XTOMCODES
+                                                    suchthat
 (EQ (CAR MP)
+                                                                 (CAR XP))) collect
 MP)))
+          (for
 AP in
 AFFECTED do
 (RPLACA AP (CADR (ASSOC (CAR AP)
+                                                         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")


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


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


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


+                                                             (* ; "Edited 19-Jan-2025 12:20 by rmk")


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


+                                                             (* ; "Edited 15-Jan-2025 09:49 by rmk")


+                                                             (* ; "Edited 27-Mar-2024 14:48 by rmk")


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


+                                                             (* ; "Edited  3-Feb-2024 09:16 by rmk")

+
+    (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps between MCCS codes and UNICODE codes, depending on INVERTED.")

+
+    (* ;; "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")

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

+
+    (* ;; "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)) 
+
+                         (* ;; 
+
       "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 ...).  (CADR is the first (and almost always) the only one.")

+
+                         (pushnew
 [CDR (OR (ASSOC DOMAIN (CDR CHARSET))
+                                           (CAR (push
 (CDR CHARSET)
+                                                      (CONS DOMAIN]
+                                RANGE))
+
+         (* ;; "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
 
+                                                                 (* ;; 
+
                                                                "Sort the range alternatives, if any")

+
+                                                                 (change
 (CDR M)
+                                                                        (SORT DATUM))) 
+
+                             (* ;; "Sort by domain codes and push down a level")

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

+         (if
 FILE
+             then
 (SETQ FILE (PACKFILENAME 'BODY (if
 (NEQ FILE T)
+                                                     then
 FILE
+                                                   elseif
 INVERTED
+                                                     then
 'UNICODE-TO-MCCS-MAPPINGS
+                                                   else
 'MCCS-TO-UNICODE-MAPPINGS)
+                                    'DIRECTORY
+                                    (CAR (MKLIST UNICODEDIRECTORIES))
+                                    'EXTENSION
+                                    'TXT))
+                  (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
+
+                         (* ;; 
+
         "We can FILEPOS for %"[nnn %" then READ for each segment. Or just READFILE to get them all.")

+
+                         (for
 I in
 INDEX do
 (PRINTOUT STREAM "[" (CAR I)
+                                                   " "
+                                                   (CADR I)
+                                                   "]" T T))
+                         (PRINTOUT STREAM "STOP" T)
+                         (FULLNAME STREAM))
+           else
 INDEX])
+
+(XCCSJAPANESECHARSETS

+  [LAMBDA (OCTAL FILE)
                                       (* ; "Edited 11-Jun-2025 23:00 by rmk")

+
+    (* ;; "Returns the list of numbers for the Japanese character sets.")

+
+    (for
 F POS CS in
 (READ-UNICODE-MAPPING-FILENAMES
 "JIS")
+       when
 (SETQ POS (STRPOS "XCCS-" F 1 NIL NIL T))
+       collect
 [SETQ CS (SUBSTRING F POS (SUB1 (STRPOS '=JIS F POS]
+             (CL:IF OCTAL
+                 CS
+                 (MKATOM (CONCAT CS "Q")))
+       finally
 (SORT $$VAL)
+             (CL:WHEN FILE
+                 (RETURN (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'BODY (CL:IF (EQ FILE T)
+                                                                            "JAPANESECHARSETS"
+                                                                            FILE)
+                                                           'DIRECTORY
+                                                           (CAR (MKLIST UNICODEDIRECTORIES))
+                                                           'EXTENSION
+                                                           'TXT)
+                                                   :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
+                                (PRINT $$VAL STREAM)
+                                (FULLNAME STREAM))))])
+)
+
+(RPAQ? *MCCSTOUNICODE*
 )
+
+(RPAQ? *UNICODETOMCCS*
 )
+
+(RPAQ? *MCCS-LOADED-CHARSETS*
 )
+
+(RPAQ? *UNICODE-LOADED-CHARSETS*
 )
+
+(RPAQ? *LARGEUNICODES*
 )
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(MAKE-UNICODE-TRANSLATION-TABLES
 'ALL)
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (LOADCOMP)
+       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)))))
+STOP

library/UNIXUTILS

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Nov-2023 12:57:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;26
 16663  
+
(FILECREATED " 4-Nov-2025 10:11:10" {WMEDLEY}<library>UNIXUTILS.;34
 18037  
 
-      :CHANGES-TO (FNS ShellBrowser)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "11-Nov-2023 09:06:39" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;25
-)
+      :CHANGES-TO (FNS SLASHIT)
+
+      :PREVIOUS-DATE "22-Oct-2025 13:05:51" {WMEDLEY}<library>UNIXUTILS.;33)
 
 
 (PRETTYCOMPRINT UNIXUTILSCOMS)
@@ -146,7 +147,8 @@
                                                   "true"])
 
 (ShellOpen

-  [LAMBDA (FilenameOrURL)
+  [LAMBDA (FilenameOrURL)
                                    (* ; "Edited 10-Sep-2025 15:29 by rmk")


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

 
     (* ;; "Open the  file or URL using the generic %"opener%" for this machine via a shell call.")

 
@@ -176,62 +178,56 @@
                                                        " >>/tmp/ShellBrowser-warnings-$$.txt"))
                                   T)
                     else
 (CONCAT "Unable to find a browser to open: " FilenameOrURL)))
-      else

-      (LET*
-       ((OPENER (ShellOpener
))
-        (FULLNAME (FULLNAME FilenameOrURL)))
-       (if
 (NOT FULLNAME)
-           then
 (CONCAT "File not found: " FilenameOrURL)
-         elseif
 (STREQUAL OPENER "true")
-           then
 (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
-         else
 (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
-                     (UNPACKED (UNPACKFILENAME.STRING FULLNAME))
-                     (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
-                                     "~"
-                                     (LISTGET UNPACKED 'VERSION)
-                                     "~"))
-                     (EXTENSION (LISTGET UNPACKED 'EXTENSION))
-                     [UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED)))
-                                       (LISTPUT UNPACKED 'VERSION NIL)
-                                       (LISTPUT UNPACKED 'HOST NIL)
-                                       (SETQ FN (PACKFILENAME.STRING UNPACKED))
-                                       (if
 (STREQUAL (SUBSTRING FN -1)
-                                                  ".")
-                                           then
 (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
-                                       (SETQ FN (SLASHIT
 FN]
-                     (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
-                     (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
-                     (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
-                                             'NAME NEWNAME 'EXTENSION EXTENSION))
-                     (TARGETFILE.UNIX (SLASHIT
 (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY TMPDIR
-                                                      'NAME NEWNAME 'EXTENSION EXTENSION)))
-                     (UNIXFILE NIL))
-                    (DECLARE
 (SPECVARS UNIXFILE))
-                    (if
 (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
-                        then
 (COPYFILE FULLNAME TARGETFILE.LISP)
-                             (SETQ UNIXFILE TARGETFILE.UNIX)
-                      else
 (SETQ UNIXFILE UNVERSIONED))
-                    (CL:WITH-OPEN-STREAM
-                     (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999))
-                                         'BOTH))
-                     (ShellCommand
 (CONCAT OPENER " '" UNIXFILE "'" 
-                                          " >>/tmp/ShellOpener-warnings-$$.txt")
-                            SHELLSTREAM)
-                     (if
 (EQ (GETFILEPTR SHELLSTREAM)
-                             0)
-                         then
 T
-                       else
 (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM)
-                                                     " ")))
-                                  (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING
-                                                                            'OUTPUT))
-                                         (SETFILEPTR SHELLSTREAM 0)
-                                         (CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP
-                                                            #'(CL:LAMBDA (s)
-                                                                     (GO OUT]
-                                                (CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM)
-                                                                STRINGSTREAM))
-                                                OUT))
-                                  OUTSTRING])
+      else
 (LET* ((OPENER (ShellOpener
))
+                  (FULLNAME (FULLNAME FilenameOrURL)))
+                 (if
 (NOT FULLNAME)
+                     then
 (CONCAT "File not found: " FilenameOrURL)
+                   elseif
 (STREQUAL OPENER "true")
+                     then
 (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
+                   else
 (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
+                               (UNPACKED (UNPACKFILENAME.STRING FULLNAME))
+                               (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
+                                               "~"
+                                               (LISTGET UNPACKED 'VERSION)
+                                               "~"))
+                               (EXTENSION (LISTGET UNPACKED 'EXTENSION))
+                               [UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED)))
+                                                 (LISTPUT UNPACKED 'VERSION NIL)
+                                                 (LISTPUT UNPACKED 'HOST NIL)
+                                                 (SETQ FN (PACKFILENAME.STRING UNPACKED))
+                                                 (if
 (STREQUAL (SUBSTRING FN -1)
+                                                            ".")
+                                                     then
 (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
+                                                 (SETQ FN (SLASHIT
 FN]
+                               (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
+                               (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
+                               (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
+                                                       'NAME NEWNAME 'EXTENSION EXTENSION))
+                               (TARGETFILE.UNIX (SLASHIT
 (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY 
+                                                                TMPDIR 'NAME NEWNAME 'EXTENSION 
+                                                                EXTENSION)))
+                               (UNIXFILE NIL))
+                              (DECLARE
 (SPECVARS UNIXFILE))
+                              (if
 (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
+                                  then
 (COPYFILE FULLNAME TARGETFILE.LISP)
+                                       (SETQ UNIXFILE TARGETFILE.UNIX)
+                                else
 (SETQ UNIXFILE UNVERSIONED))
+                              (CL:WITH-OPEN-STREAM
+                               (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999))
+                                                   'BOTH))
+                               (ShellCommand
 (CONCAT OPENER " '" UNIXFILE "'" 
+                                                    " >>/tmp/ShellOpener-warnings-$$.txt")
+                                      SHELLSTREAM)
+                               (if
 (EQ (GETFILEPTR SHELLSTREAM)
+                                       0)
+                                   then
 T
+                                 else
 (LET ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM)
+                                                              " ")))
+                                           (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM
+                                                                               OUTSTRING
+                                                                               'OUTPUT))
+                                                  (COPYCHARS SHELLSTREAM STRINGSTREAM 0 -1))
+                                           OUTSTRING])
 
 (PROCESS-COMMAND

   [LAMBDA (CMD)
                                              (* ; "Edited 17-Jul-2022 08:17 by rmk")

@@ -244,7 +240,10 @@
                                                  0))) DO
 (BLOCK) FINALLY
 (RETURN CODE])
 
 (SLASHIT

-  [LAMBDA (X LCASEDIRS NOHOST)
                               (* ; "Edited 23-Sep-2023 15:27 by rmk")

+  [LAMBDA (X LCASEDIRS NOHOST)
                               (* ; "Edited  4-Nov-2025 10:10 by rmk")


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


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


+                                                             (* ; "Edited 23-Sep-2023 15:27 by rmk")

 
     (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools.  But packfilename sticks in brackets again, and sticks a dot on when removing the version.")

 
@@ -255,13 +254,14 @@
     (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
                                                0]
          [SETQ SLASHED (CONCATCODES (for
 I C from
 DIRPOS while
 (SETQ C (NTHCHARCODE X I))
-                                       collect
 (SELCHARQ C
-                                                    ((< >) 
-                                                         (SETQ LASTDIRPOS I)
-                                                         (CHARCODE /))
-                                                    (/ (SETQ LASTDIRPOS I)
-                                                       C)
-                                                    C]
+                                       join
 (SELCHARQ C
+                                                 ((< >) 
+                                                      (SETQ LASTDIRPOS I)
+                                                      (CONS (CHARCODE /)))
+                                                 (/ (SETQ LASTDIRPOS I)
+                                                    (CONS C))
+                                                 (SPACE (APPEND (CHARCODE (\ SPACE))))
+                                                 (CONS C]
          (CL:WHEN (AND LCASEDIRS LASTDIRPOS)
              (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
              (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
@@ -274,13 +274,15 @@
                     SLASHED))])
 
 (UNIX-FILE-NAME

-  [LAMBDA (FILE ACCESS COPY)
                                 (* ; "Edited  1-Oct-2023 20:52 by rmk")

+  [LAMBDA (FILE ACCESS COPY)
                                 (* ; "Edited 27-Sep-2025 16:24 by rmk")


+                                                             (* ; "Edited 19-Sep-2025 07:29 by rmk")


+                                                             (* ; "Edited 13-Sep-2025 18:37 by rmk")


+                                                             (* ; "Edited  1-Oct-2023 20:52 by rmk")

+
+    (* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question")

 
     (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand.  If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention.  If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")

-
-    (CL:WHEN (\GETSTREAM FILE ACCESS T)
-        (SETQ FILE (OR (FULLNAME FILE)
-                       FILE)))                               (* ; "Might catch NODIRCORE")

+                                                             (* ; "Might catch NODIRCORE")

     (CL:WHEN FILE
         (SETQ FILE (TRUEFILENAME FILE))
         (CL:UNLESS (STREAMP FILE)
@@ -290,35 +292,42 @@
                                               (NIL (SETQ ACCESS 'INPUT)
                                                    'OLD)
                                               (\ILLEGAL.ARG ACCESS])
-        [SELECTQ (FILENAMEFIELD FILE 'HOST)
-            (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"])
-            (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION]
-                      (SETQ FILE (SLASHIT
 (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE)))
-                      (CL:IF (AND VERSION (IGREATERP VERSION 1))
-                          (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION)
-                                           "."
-                                           "")
-                                 "~" VERSION "~")
-                          FILE)))
-            (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)
-                          FILE)
-                (RESETLST
-                    (CL:WHEN (\GETSTREAM FILE 'INPUT T)      (* ; "Hope is randaccess")

-                        [RESETSAVE (GETFILEPTR FILE)
-                               `(PROGN (SETFILEPTR ,FILE OLDVALUE])
-                    (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY)
-                                          "-"
-                                          (IDATE)
-                                          "-"
-                                          (RAND)
-                                          (CL:IF (FILENAMEFIELD FILE 'EXTENSION)
-                                              (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION))
-                                              "")))))])])
+        (LET (UNAME VERSION)
+             [SELECTQ (FILENAMEFIELD FILE 'HOST)
+                 ((UNIX DSK) 
+                      (SETQ UNAME FILE))
+                 (PROGN 
+                        (* ;; "Catch the streams as well as other devices (CORE, servers)")

+
+                        [SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY
+                                                                              (CONCAT (L-CASE COPY)
+                                                                                     "-")
+                                                                              "")
+                                                     (IDATE]
+                        (CL:WHEN (AND COPY FILE)
+                            (RESETLST
+                                (CL:WHEN (\GETSTREAM FILE 'INPUT T)
+                                                             (* ; "Hope it's randaccess")

+                                    [RESETSAVE (GETFILEPTR FILE)
+                                           `(PROGN (SETFILEPTR ,FILE OLDVALUE])
+
+                                (* ;; "Let DSK pick a new version number, rather than RAND")

+
+                                (COPYFILE FILE UNAME)))]
+             (SETQ VERSION (FILENAMEFIELD UNAME 'VERSION))   (* ; "Convert to Unix version. ")

+             (SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME))
+             (CL:WHEN (AND VERSION (IGREATERP VERSION 1))
+                 (SETQ UNAME (CONCAT UNAME ".~" VERSION "~")))
+             (SETQ UNAME (SLASHIT
 UNAME NIL T))
+             (CL:IF (EQ (CHARCODE %.)
+                        (NTHCHARCODE UNAME -1))
+                 (SUBSTRING UNAME 1 -2)
+                 UNAME)))])
 )
 
 (PUTPROPS UNIXUTILS
 FILETYPE
 CL:COMPILE-FILE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1146 1519 (ShellCommand 1146 . 1519)) (1521 1918 (ShellWhich 1521 . 1918)) (2008 16585 
-(ShellBrowser 2018 . 3790) (ShellBrowse 3792 . 4477) (ShellOpener 4479 . 6167) (ShellOpen 6169 . 11324
-) (PROCESS-COMMAND 11326 . 11939) (SLASHIT 11941 . 13983) (UNIX-FILE-NAME 13985 . 16583)))))
+  (FILEMAP (NIL (1110 1483 (ShellCommand 1110 . 1483)) (1485 1882 (ShellWhich 1485 . 1882)) (1972 17959 
+(ShellBrowser 1982 . 3754) (ShellBrowse 3756 . 4441) (ShellOpener 4443 . 6131) (ShellOpen 6133 . 11612
+) (PROCESS-COMMAND 11614 . 12227) (SLASHIT 12229 . 14684) (UNIX-FILE-NAME 14686 . 17957)))))
 STOP

library/tedit/TEDIT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Sep-2025 22:10:20" {WMEDLEY}<library>TEDIT>TEDIT.;838
 145349 
+
(FILECREATED "13-Nov-2025 21:00:34" {WMEDLEY}<library>TEDIT>TEDIT.;844
 144838 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.NTHCHARCODE)
+      :CHANGES-TO (FNS TEDIT.INSERT \TEDIT.INSERT)
 
-      :PREVIOUS-DATE " 6-Sep-2025 09:54:48" {WMEDLEY}<library>TEDIT>TEDIT.;837)
+      :PREVIOUS-DATE "28-Oct-2025 00:29:56" {WMEDLEY}<library>TEDIT>TEDIT.;843)
 
 
 (PRETTYCOMPRINT TEDITCOMS)
@@ -75,9 +75,9 @@
               (FNS TEDITSYSTEMDATE)
               (VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE]
         (COMS                                                (* ; 
-
                           "LISTFILES Interface, so the system can decide if a file is a TEdit file.")

-              (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
-                                              (EXTENSION (TEDIT])
+
                           "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")

+              (ADDVARS (PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
+                                              (EXTENSION (TEDIT TED])
 
 (FILESLOAD (SYSLOAD)
        POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL)
@@ -441,6 +441,8 @@
 (TEDIT-SEE

   [LAMBDA (FILE WINDOW FORMAT TITLE)
 
+    (* ;; "Edited 27-Oct-2025 21:25 by rmk")

+
     (* ;; 
 
  "Edited 13-Sep-2023 09:04 by rmk:  Old code replaced to take advantage of new standard interfaces.")

 
@@ -452,7 +454,8 @@
 
     (* ;; "Edited  1-Feb-88 19:00 by bvm:")

 
-    (TEXTSTREAM
 (TEDIT
 FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT])
+    (TEXTSTREAM
 (TEDIT
 FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE ,TITLE FORMAT
+                                               ,FORMAT])
 
 (TEDIT.COPY

   [LAMBDA (FROM
 TO
)
                                          (* ; "Edited  2-Dec-2024 09:02 by rmk")


@@ -506,7 +509,8 @@
          (\TEDIT.DELETE
 TSTREAM SEL])
 
 (TEDIT.INSERT

-  [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL)
           (* ; "Edited  4-Apr-2025 11:22 by rmk")


+  [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL)
           (* ; "Edited 13-Nov-2025 20:58 by rmk")


+                                                             (* ; "Edited  4-Apr-2025 11:22 by rmk")


                                                              (* ; "Edited  2-Aug-2024 22:17 by rmk")


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


                                                              (* ; "Edited 23-Jul-2024 16:35 by rmk")


@@ -531,7 +535,7 @@
 
                (* ;; "Nothing to do for an empty string")

 
-               (LET ((TEXTOBJ
 (fetch
 (TEXTSTREAM
 TEXTOBJ) of
 TSTREAM)))
+               (LET ((TEXTOBJ
 (FTEXTOBJ TSTREAM)))
                     (if
 (FIXP CH#ORSEL)
                         then
 (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT) 
                                                              (* ; "He gave us a ch# to insert before")

@@ -540,14 +544,8 @@
                         then
 (SETQ CH#ORSEL (TEXTSEL TEXTOBJ)))
                     (SELECTION! CH#ORSEL)
                     (if
 (FGETSEL CH#ORSEL SET)
-                        then
 (\TEDIT.INSERT
 TEXT CH#ORSEL TSTREAM DONTSCROLL)
-                             (CL:WHEN LOOKS
-
-                                 (* ;; "TEXTSEL now selects the insertion, apply the looks, but don't keep the looks-change as a separate event.  We want it to behave as if the looks had been applied to the TEXT before the insertion (e.g. converting first to SELPIECES).")

-
-                                 (LET ((HISTORY (FGETTOBJ TEXTOBJ TXTHISTORY)))
-                                      (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS)
-                                      (FSETTOBJ TEXTOBJ TXTHISTORY HISTORY)))
+                        then
 (CL:WHEN LOOKS (TEDIT.CARETLOOKS TSTREAM LOOKS))
+                             (\TEDIT.INSERT
 TEXT CH#ORSEL TSTREAM DONTSCROLL)
                       else
 (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T))))
         ])
 
@@ -1240,7 +1238,8 @@
                 (T TSTREAM)))])
 
 (\TEDIT.INSERT

-  [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN)
             (* ; "Edited  7-May-2025 00:11 by rmk")


+  [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN)
             (* ; "Edited 13-Nov-2025 20:57 by rmk")


+                                                             (* ; "Edited  7-May-2025 00:11 by rmk")


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


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


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


@@ -1311,14 +1310,10 @@
 
          (* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.")

 
-         (* ;; "If typein, the new selection is a point selection, if from a function e.g. TEDIT.INSERT, the insertion is selected/underlined. TEDIT.INSERT can then apply the looks, if specified.")

-
-               (if
 TYPEIN
-                   then
 (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED))
-                               0
-                               'RIGHT
-                               'NORMAL)
-                 else
 (\TEDIT.UPDATE.SEL SEL CARETCHNO NCHARSADDED 'RIGHT 'NORMAL))
+               (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED))
+                      0
+                      'RIGHT
+                      'NORMAL)
                (CL:UNLESS DONTSCROLL
 
                    (* ;; "All the panes must be updated.  SELPANE mayalso need to be scrolled to make the caret visible for the next input.")

@@ -2320,32 +2315,32 @@
 
 
 
-(* ; "LISTFILES Interface, so the system can decide if a file is a TEdit file.")

+(* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")

 
 
-(ADDTOVAR PRINTFILETYPES
 (TEDIT (TEST \TEDIT.GET.TRAILER)
-                                (EXTENSION (TEDIT))))
+(ADDTOVAR PRINTFILETYPES
 (TEDIT (TEST TEDIT.FORMATTEDFILEP)
+                                (EXTENSION (TEDIT TED))))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4823 7217 (MAKE-TEDIT-EXPORTS.ALL 4833 . 5379) (UPDATE-TEDIT 5381 . 6310) (EDIT-TEDIT 
-6312 . 7215)) (8647 36705 (TEDIT 8657 . 11271) (TEXTSTREAM 11273 . 13162) (TEXTSTREAMP 13164 . 13548) 
-(COERCETEXTSTREAM 13550 . 17761) (TEDIT.CONCAT 17763 . 21065) (TEDITSTRING 21067 . 21981) (TEDIT-SEE 
-21983 . 22542) (TEDIT.COPY 22544 . 24689) (TEDIT.DELETE 24691 . 26052) (TEDIT.INSERT 26054 . 29428) (
-TEDIT.TERPRI 29430 . 30544) (TEDIT.KILL 30546 . 31528) (TEDIT.QUIT 31530 . 32896) (TEDIT.MOVE 32898 . 
-33786) (TEDIT.STRINGWIDTH 33788 . 34459) (TEDIT.CHARWIDTH 34461 . 36703)) (36706 38647 (TEXTOBJ 36716
- . 37181) (COERCETEXTOBJ 37183 . 38645)) (40047 41697 (TDRIBBLE 40057 . 41695)) (41738 53634 (
-TEDIT.INSERT.OBJECT 41748 . 45455) (TEDIT.EDIT.OBJECT 45457 . 48397) (TEDIT.OBJECT.CHANGED 48399 . 
-51589) (TEDIT.MAP.OBJECTS 51591 . 53162) (\TEDIT.FIRST.OBJPIECE 53164 . 53397) (\TEDIT.NEXT.OBJPIECE 
-53399 . 53632)) (53657 61100 (\TEDIT.CONCAT.PAGEFRAMES 53667 . 58734) (\TEDIT.GET.PAGE.HEADINGS 58736
- . 59765) (\TEDIT.CONCAT.INSTALL.HEADINGS 59767 . 61098)) (61101 64708 (\TEDIT.MOVE.MSG 61111 . 63192)
- (\TEDIT.READONLY 63194 . 64706)) (64709 70600 (TEDIT.NCHARS 64719 . 65092) (TEDIT.RPLCHARCODE 65094
- . 68084) (TEDIT.NTHCHARCODE 68086 . 70129) (TEDIT.NTHCHAR 70131 . 70598)) (70646 127675 (\TEDIT1 
-70656 . 72733) (\TEDIT.INSERT 72735 . 79100) (\TEDIT.MOVE 79102 . 87008) (\TEDIT.COPY 87010 . 91541) (
-\TEDIT.REPLACE.SELPIECES 91543 . 96079) (\TEDIT.INSERT.SELPIECES 96081 . 99078) (\TEDIT.RESTARTFN 
-99080 . 101585) (\TEDIT.CHARDELETE 101587 . 104516) (\TEDIT.COPYPIECE 104518 . 109680) (
-\TEDIT.APPLY.OBJFN 109682 . 112768) (\TEDIT.DELETE 112770 . 117138) (\TEDIT.DIFFUSE.PARALOOKS 117140
- . 119411) (\TEDIT.WORDDELETE 119413 . 121028) (\TEDIT.WORDDELETE.FORWARD 121030 . 122819) (
-\TEDIT.FINISHEDIT? 122821 . 127673)) (127676 128335 (\TEDIT.THELP 127686 . 128333)) (128369 137500 (
-\TEDIT.PARAPIECES 128379 . 130353) (\TEDIT.PARACHNOS 130355 . 131247) (\TEDIT.PARA.FIRST 131249 . 
-134350) (\TEDIT.PARA.LAST 134352 . 137498)) (137501 144596 (\TEDIT.WORD.FIRST 137511 . 141515) (
-\TEDIT.WORD.LAST 141517 . 144594)) (144797 145074 (TEDITSYSTEMDATE 144807 . 145072)))))
+  (FILEMAP (NIL (4838 7232 (MAKE-TEDIT-EXPORTS.ALL 4848 . 5394) (UPDATE-TEDIT 5396 . 6325) (EDIT-TEDIT 
+6327 . 7230)) (8662 36440 (TEDIT 8672 . 11286) (TEXTSTREAM 11288 . 13177) (TEXTSTREAMP 13179 . 13563) 
+(COERCETEXTSTREAM 13565 . 17776) (TEDIT.CONCAT 17778 . 21080) (TEDITSTRING 21082 . 21996) (TEDIT-SEE 
+21998 . 22682) (TEDIT.COPY 22684 . 24829) (TEDIT.DELETE 24831 . 26192) (TEDIT.INSERT 26194 . 29163) (
+TEDIT.TERPRI 29165 . 30279) (TEDIT.KILL 30281 . 31263) (TEDIT.QUIT 31265 . 32631) (TEDIT.MOVE 32633 . 
+33521) (TEDIT.STRINGWIDTH 33523 . 34194) (TEDIT.CHARWIDTH 34196 . 36438)) (36441 38382 (TEXTOBJ 36451
+ . 36916) (COERCETEXTOBJ 36918 . 38380)) (39782 41432 (TDRIBBLE 39792 . 41430)) (41473 53369 (
+TEDIT.INSERT.OBJECT 41483 . 45190) (TEDIT.EDIT.OBJECT 45192 . 48132) (TEDIT.OBJECT.CHANGED 48134 . 
+51324) (TEDIT.MAP.OBJECTS 51326 . 52897) (\TEDIT.FIRST.OBJPIECE 52899 . 53132) (\TEDIT.NEXT.OBJPIECE 
+53134 . 53367)) (53392 60835 (\TEDIT.CONCAT.PAGEFRAMES 53402 . 58469) (\TEDIT.GET.PAGE.HEADINGS 58471
+ . 59500) (\TEDIT.CONCAT.INSTALL.HEADINGS 59502 . 60833)) (60836 64443 (\TEDIT.MOVE.MSG 60846 . 62927)
+ (\TEDIT.READONLY 62929 . 64441)) (64444 70335 (TEDIT.NCHARS 64454 . 64827) (TEDIT.RPLCHARCODE 64829
+ . 67819) (TEDIT.NTHCHARCODE 67821 . 69864) (TEDIT.NTHCHAR 69866 . 70333)) (70381 127158 (\TEDIT1 
+70391 . 72468) (\TEDIT.INSERT 72470 . 78583) (\TEDIT.MOVE 78585 . 86491) (\TEDIT.COPY 86493 . 91024) (
+\TEDIT.REPLACE.SELPIECES 91026 . 95562) (\TEDIT.INSERT.SELPIECES 95564 . 98561) (\TEDIT.RESTARTFN 
+98563 . 101068) (\TEDIT.CHARDELETE 101070 . 103999) (\TEDIT.COPYPIECE 104001 . 109163) (
+\TEDIT.APPLY.OBJFN 109165 . 112251) (\TEDIT.DELETE 112253 . 116621) (\TEDIT.DIFFUSE.PARALOOKS 116623
+ . 118894) (\TEDIT.WORDDELETE 118896 . 120511) (\TEDIT.WORDDELETE.FORWARD 120513 . 122302) (
+\TEDIT.FINISHEDIT? 122304 . 127156)) (127159 127818 (\TEDIT.THELP 127169 . 127816)) (127852 136983 (
+\TEDIT.PARAPIECES 127862 . 129836) (\TEDIT.PARACHNOS 129838 . 130730) (\TEDIT.PARA.FIRST 130732 . 
+133833) (\TEDIT.PARA.LAST 133835 . 136981)) (136984 144079 (\TEDIT.WORD.FIRST 136994 . 140998) (
+\TEDIT.WORD.LAST 141000 . 144077)) (144280 144557 (TEDITSYSTEMDATE 144290 . 144555)))))
 STOP

library/tedit/TEDIT-BUTTONS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-Apr-2025 14:09:18" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;228
 125393 
+
(FILECREATED "19-Oct-2025 10:44:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;229
 125526 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS MB.NWAY.ADDITEM MB.NWAY.CREATE MB.NWAY.SETSTATEFN MB.NWAY.SELECT)
+      :CHANGES-TO (FNS MB.ADD)
 
-      :PREVIOUS-DATE "14-Apr-2025 23:50:23" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;226)
+      :PREVIOUS-DATE "30-Apr-2025 14:09:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;228)
 
 
 (PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
@@ -67,14 +67,16 @@
 (DEFINEQ
 
 (MB.ADD

-  [LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES)
    (* ; "Edited  6-Apr-2025 14:35 by rmk")


+  [LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES MAINTSTREAM)

+                                                             (* ; "Edited 19-Oct-2025 10:22 by rmk")


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


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


                                                              (* ; "Edited 22-Oct-2024 09:16 by rmk")


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


                                                              (* ; "Edited 18-Oct-2024 13:49 by rmk")


                                                              (* ; "Edited  6-Oct-2024 15:25 by rmk")


                                                              (* ; "Edited 24-Aug-2024 21:08 by rmk")

-    (DECLARE
 (SPECVARS MENUTSTREAM))
+    (DECLARE
 (SPECVARS MENUTSTREAM MAINTSTREAM))
     (SETQ MENUTSTREAM (TEXTSTREAM MENUTSTREAM))
              (* ; "Edited 22-Aug-2024 11:10 by rmk")

 
     (* ;; "MENUDESC is a Tedit menu specification, a list of items describing one or more elements to be inserted in TSTREAM after WHERE. ")

@@ -1969,25 +1971,25 @@
 (MB.FIELD.INIT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3279 19224 (MB.ADD 3289 . 9810) (MB.DELETE 9812 . 10186) (MB.GET 10188 . 16958) (
-MB.GET.MBARG 16960 . 18629) (TEDIT.BACKTOMAIN 18631 . 19222)) (19268 39204 (MB.BUTTONEVENTINFN 19278
- . 20846) (MB.DISPLAYFN 20848 . 22907) (MB.SETIMAGE 22909 . 24077) (MB.SIZEFN 24079 . 25627) (
-MB.WHENOPERATEDONFN 25629 . 27578) (MB.COPYFN 27580 . 28038) (MB.GETFN 28040 . 29001) (MB.PUTFN 29003
- . 30103) (MB.SHOWSELFN 30105 . 31614) (MB.CREATE 31616 . 35639) (MB.CHANGENAME 35641 . 36123) (
-MB.INIT 36125 . 37586) (MB.TRACK.UNTIL 37588 . 38283) (MB.DON'T 38285 . 38581) (MB.SPEC.REMAINDER 
-38583 . 39202)) (39366 49371 (MB.3STATE.CREATE 39376 . 40240) (MB.3STATE.DISPLAYFN 40242 . 41228) (
-MB.3STATE.SHOWSELFN 41230 . 43541) (MB.3STATE.INIT 43543 . 44954) (MB.3STATE.SETSTATEFN 44956 . 45614)
- (MB.3STATE.BUTTONEVENTINFN 45616 . 49369)) (49526 80622 (MB.NWAY.CREATE 49536 . 55719) (
-MB.NWAY.DISPLAYFN 55721 . 56584) (MB.NWAY.WHENOPERATEDONFN 56586 . 58776) (MB.NWAY.SIZEFN 58778 . 
-62714) (MB.NWAY.SELECT 62716 . 66286) (MB.NWAY.BUTTONEVENTINFN 66288 . 69500) (MB.NWAY.NEWMENUBUTTON 
-69502 . 70214) (MB.NWAY.COPYFN 70216 . 71183) (MB.NWAY.INIT 71185 . 72676) (MB.NWAY.ARRANGEBUTTONS 
-72678 . 74649) (MB.NWAY.ADDITEM 74651 . 78800) (MB.NWAY.FINDSUBOBJ 78802 . 79316) (MB.NWAY.SETSTATEFN 
-79318 . 80620)) (80701 92700 (MB.TOGGLE.CREATE 80711 . 81706) (MB.TOGGLE.DISPLAYFN 81708 . 83191) (
-MB.TOGGLE.INIT 83193 . 84992) (MB.SET.TOGGLE 84994 . 86195) (MB.TOGGLE.SETSTATEFN 86197 . 87037) (
-MB.TOGGLE.BUTTONEVENTINFN 87039 . 91355) (MB.TOGGLE.WHENOPERATEDONFN 91357 . 92698)) (92781 125314 (
-MB.FIELD.CREATE 92791 . 98242) (MB.FIELD.DISPLAYFN 98244 . 99035) (MB.FIELD.IMAGEBOXFN 99037 . 100519)
- (MB.FIELD.PREFIXCREATE 100521 . 104457) (MB.FIELD.SUFFIXCREATE 104459 . 106119) (MB.FIELD.INIT 106121
- . 107888) (MB.FIELD.WHENOPERATEDONFN 107890 . 109161) (MB.FIELD.GETSTATEFN 109163 . 113097) (
-MB.FIELD.SETSTATEFN 113099 . 117903) (MB.FIELD.BUTTONEVENTINFN 117905 . 120210) (MB.FIELD.SIZEFN 
-120212 . 120452) (MB.FIELD.INSURETYPE 120454 . 125312)))))
+  (FILEMAP (NIL (3221 19357 (MB.ADD 3231 . 9943) (MB.DELETE 9945 . 10319) (MB.GET 10321 . 17091) (
+MB.GET.MBARG 17093 . 18762) (TEDIT.BACKTOMAIN 18764 . 19355)) (19401 39337 (MB.BUTTONEVENTINFN 19411
+ . 20979) (MB.DISPLAYFN 20981 . 23040) (MB.SETIMAGE 23042 . 24210) (MB.SIZEFN 24212 . 25760) (
+MB.WHENOPERATEDONFN 25762 . 27711) (MB.COPYFN 27713 . 28171) (MB.GETFN 28173 . 29134) (MB.PUTFN 29136
+ . 30236) (MB.SHOWSELFN 30238 . 31747) (MB.CREATE 31749 . 35772) (MB.CHANGENAME 35774 . 36256) (
+MB.INIT 36258 . 37719) (MB.TRACK.UNTIL 37721 . 38416) (MB.DON'T 38418 . 38714) (MB.SPEC.REMAINDER 
+38716 . 39335)) (39499 49504 (MB.3STATE.CREATE 39509 . 40373) (MB.3STATE.DISPLAYFN 40375 . 41361) (
+MB.3STATE.SHOWSELFN 41363 . 43674) (MB.3STATE.INIT 43676 . 45087) (MB.3STATE.SETSTATEFN 45089 . 45747)
+ (MB.3STATE.BUTTONEVENTINFN 45749 . 49502)) (49659 80755 (MB.NWAY.CREATE 49669 . 55852) (
+MB.NWAY.DISPLAYFN 55854 . 56717) (MB.NWAY.WHENOPERATEDONFN 56719 . 58909) (MB.NWAY.SIZEFN 58911 . 
+62847) (MB.NWAY.SELECT 62849 . 66419) (MB.NWAY.BUTTONEVENTINFN 66421 . 69633) (MB.NWAY.NEWMENUBUTTON 
+69635 . 70347) (MB.NWAY.COPYFN 70349 . 71316) (MB.NWAY.INIT 71318 . 72809) (MB.NWAY.ARRANGEBUTTONS 
+72811 . 74782) (MB.NWAY.ADDITEM 74784 . 78933) (MB.NWAY.FINDSUBOBJ 78935 . 79449) (MB.NWAY.SETSTATEFN 
+79451 . 80753)) (80834 92833 (MB.TOGGLE.CREATE 80844 . 81839) (MB.TOGGLE.DISPLAYFN 81841 . 83324) (
+MB.TOGGLE.INIT 83326 . 85125) (MB.SET.TOGGLE 85127 . 86328) (MB.TOGGLE.SETSTATEFN 86330 . 87170) (
+MB.TOGGLE.BUTTONEVENTINFN 87172 . 91488) (MB.TOGGLE.WHENOPERATEDONFN 91490 . 92831)) (92914 125447 (
+MB.FIELD.CREATE 92924 . 98375) (MB.FIELD.DISPLAYFN 98377 . 99168) (MB.FIELD.IMAGEBOXFN 99170 . 100652)
+ (MB.FIELD.PREFIXCREATE 100654 . 104590) (MB.FIELD.SUFFIXCREATE 104592 . 106252) (MB.FIELD.INIT 106254
+ . 108021) (MB.FIELD.WHENOPERATEDONFN 108023 . 109294) (MB.FIELD.GETSTATEFN 109296 . 113230) (
+MB.FIELD.SETSTATEFN 113232 . 118036) (MB.FIELD.BUTTONEVENTINFN 118038 . 120343) (MB.FIELD.SIZEFN 
+120345 . 120585) (MB.FIELD.INSURETYPE 120587 . 125445)))))
 STOP

library/tedit/TEDIT-FILE

@@ -1,14 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Sep-2025 21:32:46" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;655
 173148 
+
(FILECREATED "23-Oct-2025 08:49:06" {WMEDLEY}<library>tedit>TEDIT-FILE.;656
 173140 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE \TEDIT.PUT.SINGLE.CHARLOOKS 
-                       \TEDIT.GET.SINGLE.CHARLOOKS)
+      :CHANGES-TO (FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
 
-      :PREVIOUS-DATE " 9-Sep-2025 21:49:43" {WMEDLEY}<library>tedit>TEDIT-FILE.;653)
+      :PREVIOUS-DATE "25-Sep-2025 21:32:46" {WMEDLEY}<library>tedit>TEDIT-FILE.;655)
 
 
 (PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -1388,7 +1386,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.UNFORMATTED.FILE.UTF8

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


+  [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS)
 (* ; "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")


                                                              (* ; "Edited  2-Feb-2024 11:24 by rmk")


@@ -1428,7 +1427,7 @@
               (SETQ CHAR (\PEEKBIN STRM))                    (* ; 
 
                                                         "Keep CHAR for CR/LF checking, error if EOF")

                                                              (* ; "Error if  invalid header")

-              (SETQ NEXTCODESIZE (UTF8-SIZE-FROM-BYTE1 CHAR))
+              (SETQ NEXTCODESIZE (NUTF8-BYTE1-BYTES CHAR))
               (CL:UNLESS (EQ CODESIZE NEXTCODESIZE)          (* ; "Header byte hasn't been read")

 
                   (* ;; "Don't want LF processing if we split because of size change. If next is a CR/LF still in size 1, we pick it up below")

@@ -2694,28 +2693,28 @@
 
 (RPAQ? *TEDIT-FILE-READTABLE*
 (COPYREADTABLE \ORIGREADTABLE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5431 35690 (TEDIT.GET 5441 . 11851) (TEDIT.FORMATTEDFILEP 11853 . 13169) (
-TEDIT.FILEDATE 13171 . 14480) (TEDIT.INCLUDE 14482 . 22511) (TEDIT.RAW.INCLUDE 22513 . 23321) (
-TEDIT.PUT 23323 . 31679) (TEDIT.PUT.STREAM 31681 . 35688)) (35691 56965 (\TEDIT.GET.FOREIGN.FILE 35701
- . 39126) (\TEDIT.GET.UNFORMATTED.FILE 39128 . 43434) (\TEDIT.GET.FORMATTED.FILE 43436 . 47079) (
-\TEDIT.FORMATTEDSTREAMP 47081 . 50212) (\ARBIN 50214 . 50934) (\ATMIN 50936 . 51473) (\DWIN 51475 . 
-51854) (\STRINGIN 51856 . 52564) (\TEDIT.GET.TRAILER 52566 . 55434) (\TEDIT.CACHEFILE 55436 . 56963)) 
-(57131 73169 (\TEDIT.GET.PIECES3 57141 . 68104) (\TEDIT.GET.PROPS3 68106 . 71328) (
-\TEDIT.MAKE.STRINGPIECE 71330 . 73167)) (73170 86596 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73180 . 79413) 
-(\TEDIT.INTERPRET.MCCS.SHIFTS 79415 . 85660) (\TEDIT.CONVERT.XCCSTOMCCS 85662 . 86594)) (86618 92757 (
-\TEDIT.GET.UNFORMATTED.FILE.UTF8 86628 . 92755)) (92780 104122 (\TEDIT.GET.CHARLOOKS.LIST 92790 . 
-93521) (\TEDIT.GET.SINGLE.CHARLOOKS 93523 . 100595) (\TEDIT.GET.CHARLOOKS 100597 . 102153) (
-\TEDIT.GET.PARALOOKS.INDEX 102155 . 102699) (\TEDIT.GET.CHARLOOKS.INDEX 102701 . 104120)) (104123 
-111780 (\TEDIT.GET.PARALOOKS.LIST 104133 . 104755) (\TEDIT.GET.SINGLE.PARALOOKS 104757 . 111778)) (
-111781 115614 (\TEDIT.GET.OBJECT 111791 . 115612)) (115679 148942 (\TEDIT.PUT.PCTB 115689 . 125596) (
-\TEDIT.PUT.PCTB.PIECEDATA 125598 . 128796) (\TEDIT.PUT.TRAILER 128798 . 130126) (
-\TEDIT.PUT.PCTB.MERGEABLE 130128 . 133901) (\TEDIT.PUT.UTF8.SPLITPIECES 133903 . 138605) (
-\TEDIT.PUT.PCTB.NEXTNEW 138607 . 143103) (\TEDIT.INSERT.NEWPIECES 143105 . 146540) (\TEDIT.PUTRESET 
-146542 . 146784) (\ARBOUT 146786 . 147510) (\ATMOUT 147512 . 148117) (\DWOUT 148119 . 148398) (
-\STRINGOUT 148400 . 148940)) (148943 161677 (\TEDIT.PUT.CHARLOOKS.LIST 148953 . 150625) (
-\TEDIT.PUT.SINGLE.CHARLOOKS 150627 . 156907) (\TEDIT.PUT.CHARLOOKS 156909 . 158248) (
-\TEDIT.PUT.CHARLOOKS1 158250 . 159301) (\TEDIT.PUT.OBJECT 159303 . 161675)) (161678 169317 (
-\TEDIT.PUT.PARALOOKS.LIST 161688 . 162590) (\TEDIT.PUT.SINGLE.PARALOOKS 162592 . 168176) (
-\TEDIT.PUT.PARALOOKS 168178 . 169315)) (169412 172841 (TEDITFROMLISPSOURCE 169422 . 172090) (
-SHELLSCRIPTP 172092 . 172321) (TEDITFROMSHELLSCRIPT 172323 . 172839)))))
+  (FILEMAP (NIL (5317 35576 (TEDIT.GET 5327 . 11737) (TEDIT.FORMATTEDFILEP 11739 . 13055) (
+TEDIT.FILEDATE 13057 . 14366) (TEDIT.INCLUDE 14368 . 22397) (TEDIT.RAW.INCLUDE 22399 . 23207) (
+TEDIT.PUT 23209 . 31565) (TEDIT.PUT.STREAM 31567 . 35574)) (35577 56851 (\TEDIT.GET.FOREIGN.FILE 35587
+ . 39012) (\TEDIT.GET.UNFORMATTED.FILE 39014 . 43320) (\TEDIT.GET.FORMATTED.FILE 43322 . 46965) (
+\TEDIT.FORMATTEDSTREAMP 46967 . 50098) (\ARBIN 50100 . 50820) (\ATMIN 50822 . 51359) (\DWIN 51361 . 
+51740) (\STRINGIN 51742 . 52450) (\TEDIT.GET.TRAILER 52452 . 55320) (\TEDIT.CACHEFILE 55322 . 56849)) 
+(57017 73055 (\TEDIT.GET.PIECES3 57027 . 67990) (\TEDIT.GET.PROPS3 67992 . 71214) (
+\TEDIT.MAKE.STRINGPIECE 71216 . 73053)) (73056 86482 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73066 . 79299) 
+(\TEDIT.INTERPRET.MCCS.SHIFTS 79301 . 85546) (\TEDIT.CONVERT.XCCSTOMCCS 85548 . 86480)) (86504 92749 (
+\TEDIT.GET.UNFORMATTED.FILE.UTF8 86514 . 92747)) (92772 104114 (\TEDIT.GET.CHARLOOKS.LIST 92782 . 
+93513) (\TEDIT.GET.SINGLE.CHARLOOKS 93515 . 100587) (\TEDIT.GET.CHARLOOKS 100589 . 102145) (
+\TEDIT.GET.PARALOOKS.INDEX 102147 . 102691) (\TEDIT.GET.CHARLOOKS.INDEX 102693 . 104112)) (104115 
+111772 (\TEDIT.GET.PARALOOKS.LIST 104125 . 104747) (\TEDIT.GET.SINGLE.PARALOOKS 104749 . 111770)) (
+111773 115606 (\TEDIT.GET.OBJECT 111783 . 115604)) (115671 148934 (\TEDIT.PUT.PCTB 115681 . 125588) (
+\TEDIT.PUT.PCTB.PIECEDATA 125590 . 128788) (\TEDIT.PUT.TRAILER 128790 . 130118) (
+\TEDIT.PUT.PCTB.MERGEABLE 130120 . 133893) (\TEDIT.PUT.UTF8.SPLITPIECES 133895 . 138597) (
+\TEDIT.PUT.PCTB.NEXTNEW 138599 . 143095) (\TEDIT.INSERT.NEWPIECES 143097 . 146532) (\TEDIT.PUTRESET 
+146534 . 146776) (\ARBOUT 146778 . 147502) (\ATMOUT 147504 . 148109) (\DWOUT 148111 . 148390) (
+\STRINGOUT 148392 . 148932)) (148935 161669 (\TEDIT.PUT.CHARLOOKS.LIST 148945 . 150617) (
+\TEDIT.PUT.SINGLE.CHARLOOKS 150619 . 156899) (\TEDIT.PUT.CHARLOOKS 156901 . 158240) (
+\TEDIT.PUT.CHARLOOKS1 158242 . 159293) (\TEDIT.PUT.OBJECT 159295 . 161667)) (161670 169309 (
+\TEDIT.PUT.PARALOOKS.LIST 161680 . 162582) (\TEDIT.PUT.SINGLE.PARALOOKS 162584 . 168168) (
+\TEDIT.PUT.PARALOOKS 168170 . 169307)) (169404 172833 (TEDITFROMLISPSOURCE 169414 . 172082) (
+SHELLSCRIPTP 172084 . 172313) (TEDITFROMSHELLSCRIPT 172315 . 172831)))))
 STOP

library/tedit/TEDIT-MENU

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "10-Sep-2025 17:08:43" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;492
 178438 
+
(FILECREATED "22-Oct-2025 12:55:36" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;498
 183397 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-MENUCOMS)
+      :CHANGES-TO (FNS MARGINBAR.NEUTRALIZE \TEDIT.PARALOOKS.TO.MARBAR)
 
-      :PREVIOUS-DATE "28-Jul-2025 23:26:01" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;491)
+      :PREVIOUS-DATE "19-Oct-2025 15:14:00" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;496)
 
 
 (PRETTYCOMPRINT TEDIT-MENUCOMS)
@@ -59,7 +59,7 @@
 
                                                              (* ; "PARAMENU")

         (FNS \TEDIT.PARAMENU.CREATE \TEDIT.PARAMENU.START \TEDIT.APPLY.PARALOOKS 
-             \TEDIT.SHOW.PARALOOKS \TEDIT.PARAMENU.FILLIN)
+             \TEDIT.SHOW.PARALOOKS \TEDIT.PARAMENU.FILLIN \TEDIT.PARAMENU.RESHAPEFN)
         
         (* ;; "")

 
@@ -95,7 +95,7 @@
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(RECORD MARGINBAR
 (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE)
+(RECORD MARGINBAR
 (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE MARBARWIDTH)
                   [TYPE?
 (AND (IMAGEOBJP DATUM)
                               (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN)
                                   'MB.MARGINBAR.DISPLAYFN])
@@ -511,7 +511,9 @@
                                     (MB.MARGINBAR.SHOWTAB
 W TAB UNIT 'PAINT])
 
 (MARGINBAR.CREATE

-  [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE)
      (* ; "Edited 29-Sep-2024 12:53 by rmk")


+  [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE MAINTSTREAM/WIDTH)

+                                                             (* ; "Edited 19-Oct-2025 15:13 by rmk")


+                                                             (* ; "Edited 29-Sep-2024 12:53 by rmk")


                                                              (* ; "Edited  4-Aug-2024 22:36 by rmk")


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


                                                              (* ; "Edited 28-Jul-2024 09:18 by rmk")


@@ -519,10 +521,16 @@
                                                              (* ; "Edited 22-Jul-2024 11:54 by rmk")


                                                             (* ; "Edited 12-Jun-90 18:59 by mitani")

 
-    (* ;; "Create an instance of the margin-setting ruler for TEdit's use.")

+    (* ;; "Create an instance of the margin-setting ruler for TEdit's use. ")

 
     (PROG ((BOX (create
 IMAGEBOX
-                       XSIZE _ 1008
+                       XSIZE _ (IDIFFERENCE (OR (FIXP MAINTSTREAM/WIDTH)
+                                                (AND MAINTSTREAM/WIDTH (\TEDIT.PRIMARYPANE 
+                                                                              MAINTSTREAM/WIDTH)
+                                                     (PANEWIDTH (\TEDIT.PRIMARYPANE MAINTSTREAM/WIDTH
+                                                                       )))
+                                                SCREENWIDTH)
+                                      18)
                        YSIZE _ 62
                        YDESC _ 0
                        XKERN _ 4))
@@ -535,7 +543,8 @@
                                    MARR _ MARR
                                    MARTABS _ MARTABS
                                    MARUNIT _ MARUNIT
-                                   MARTABTYPE _ MARTABTYPE))
+                                   MARTABTYPE _ MARTABTYPE
+                                   MARBARWIDTH _ (fetch
 (IMAGEBOX XSIZE) of
 BOX)))
                   MARGINBARIMAGEFNS))                        (* ; 
 
               "Create an IMAGEOBJ, containing an instance of the record to hold margin and tab info")

           (SETQ BITMAP (BITMAPCREATE (fetch
 XSIZE of
 BOX)
@@ -850,13 +859,15 @@
     PC])
 
 (MARGINBAR.NEUTRALIZE

-  [LAMBDA (OBJ)
                                              (* ; "Edited 29-Jul-2024 12:14 by rmk")

+  [LAMBDA (OBJ)
                                              (* ; "Edited 22-Oct-2025 12:55 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 12:14 by rmk")

 
     (* ;; "Neutralizes the settings of the marginbar")

 
     (create
 MARGINBAR smashing
 (IMAGEOBJPROP OBJ 'OBJECTDATUM)
                             MARL1 _ -0.5 MARLN _ -0.5 MARR _ -39.5 MARTABS _ 'NEUTRAL MARUNIT _ 12 
-                            MARTABTYPE _ NIL])
+                            MARTABTYPE _ NIL MARBARWIDTH _ (fetch
 (MARGINBAR
 MARBARWIDTH)
+                                                              of
 (IMAGEOBJPROP OBJ 'OBJECTDATUM])
 
 (MARGINBAR.LOOKS

   [LAMBDA (OBJ DOTTEDLEADER)
                                 (* ; "Edited 20-Oct-2024 15:27 by rmk")


@@ -913,13 +924,14 @@
           LOOKS])
 
 (MB.MARGINBAR.SIZEFN

-  [LAMBDA (OBJ)
                                              (* ; "Edited  3-Dec-2024 20:03 by rmk")

+  [LAMBDA (OBJ)
                                              (* ; "Edited 19-Oct-2025 09:47 by rmk")


+                                                             (* ; "Edited  3-Dec-2024 20:03 by rmk")

                                                              (* jds " 5-Sep-84 14:10")

 
     (* ;; "YDESC is 2 so that selecting the bar and highlighting doesn't wipe out the bottom line. Although you shouldn't be able to select it")

 
     (LET ((BOX (create
 IMAGEBOX
-                      XSIZE _ 1008
+                      XSIZE _ (fetch
 (MARGINBAR
 MARBARWIDTH) of
 (IMAGEOBJPROP OBJ 'OBJECTDATUM))
                       YSIZE _ 62
                       YDESC _ 2
                       XKERN _ 4)))
@@ -1070,7 +1082,8 @@
                                    'MarginRuler])
 
 (\TEDIT.PARALOOKS.TO.MARBAR

-  [LAMBDA (PARALOOKS UNIT)
                                   (* ; "Edited 19-Feb-2025 13:25 by rmk")


+  [LAMBDA (PARALOOKS UNIT)
                                   (* ; "Edited 22-Oct-2025 12:29 by rmk")


+                                                             (* ; "Edited 19-Feb-2025 13:25 by rmk")


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


                                                              (* ; "Edited  4-Aug-2024 22:50 by rmk")

 
@@ -1088,7 +1101,8 @@
            MARUNIT _ UNIT
            MARTABS _ (for
 TAB in
 (FGETPLOOKS PARALOOKS FMTTABS)
                         collect
 (create
 TAB using
 TAB TABX _ (QUOTIENT (fetch
 (TAB TABX) of
 TAB)
-                                                                    UNIT])
+                                                                    UNIT)))
+           MARBARWIDTH _ (FGETPLOOKS PARALOOKS RIGHTMAR])
 )
 
 (RPAQQ \TEDIT.LEFTTAB
 #*(10 8)B@@@B@@@G@@@JH@@B@@@B@@@CN@@@@@@)
@@ -1247,7 +1261,8 @@
 (DEFINEQ
 
 (\TEDIT.MENU.CREATE

-  [LAMBDA (MENUDESC MENUPROPS)
                               (* ; "Edited 17-Dec-2024 08:53 by rmk")


+  [LAMBDA (MENUDESC MENUPROPS MAINTSTREAM)
                   (* ; "Edited 19-Oct-2025 10:36 by rmk")


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


                                                              (* ; "Edited 22-Aug-2024 11:09 by rmk")


                                                              (* ; "Edited 21-Aug-2024 09:54 by rmk")


                                                              (* ; "Edited 14-Aug-2024 09:40 by rmk")


@@ -1263,7 +1278,7 @@
     (* ;; "Create the TEXTSTREAM for a menu, given a menu description.  That stream is marked as a menu and passed to \TEDIT.MENU.START to get the menu up on screen")

 
     (LET [(MENUTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10]
-         (MB.ADD MENUDESC MENUTSTREAM)
+         (MB.ADD MENUDESC MENUTSTREAM NIL NIL MAINTSTREAM)
          (SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ))
                 SET NIL)
          (SETTOBJ (GETTSTR MENUTSTREAM TEXTOBJ)
@@ -1663,7 +1678,8 @@
 (DEFINEQ
 
 (\TEDIT.PARAMENU.CREATE

-  [LAMBDA NIL
                                                (* ; "Edited 13-Jul-2025 22:35 by rmk")


+  [LAMBDA (MAINTSTREAM)
                                      (* ; "Edited 19-Oct-2025 15:12 by rmk")


+                                                             (* ; "Edited 13-Jul-2025 22:35 by rmk")


                                                              (* ; "Edited  7-Jan-2025 15:48 by rmk")


                                                              (* ; "Edited  8-Nov-2024 08:35 by rmk")


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


@@ -1680,7 +1696,7 @@
                                                              (* ; "Edited 27-Jul-2024 10:18 by rmk")

                                                              (* jds " 2-Aug-84 15:32")

 
-    (* ;; "Creates the TEdit Expanded Paragraph Menu. (PROGN to suppress %"value of comment used? compile-time messages.)")

+    (* ;; "Creates the TEdit Expanded Paragraph Menu for MAINTSTREAM. (PROGN to suppress %"value of comment used? compile-time messages.)")

 
     (PROGN 
            (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.")

@@ -1689,88 +1705,97 @@
            (FUNCTION \TEDIT.SHOW.PARALOOKS)
            (FUNCTION \TEDIT.MENU.NEUTRALIZE)
            (FUNCTION \TEDIT.TABTYPE.SET)
-           (FUNCTION PRINTERTYPE))
-    (\TEDIT.MENU.CREATE
 `((ACTION (LABEL APPLY)
-                                 (IGNORE T)
-                                 (SELECTFN \TEDIT.APPLY.PARALOOKS))
-                          3
-                          (ACTION (LABEL SHOW)
-                                 (IGNORE T)
-                                 (SELECTFN \TEDIT.SHOW.PARALOOKS))
-                          3
-                          (ACTION (LABEL NEUTRAL)
-                                 (IGNORE T)
-                                 (SELECTFN \TEDIT.MENU.NEUTRALIZE))
-                          EOL
-                          (NWAY (IDENTIFIER QUAD)
-                                (BUTTONS (Left Right Centered Justified))
-                                (INITSTATE OFF))
-                          TAB
-                          (3STATE (IDENTIFIER TYPE)
-                                 (LABEL "Page Heading"))
-                          2
-                          (FIELD (IDENTIFIER SUBTYPE)
-                                 (PRELABEL "type")
-                                 (FIELDTYPE SYMBOL))
-                          EOL
-                          (FIELD (IDENTIFIER LINELEADING)
-                                 (PRELABEL "Line leading")
-                                 (POSTLABEL "pts")
-                                 (FIELDTYPE NUMBER)
-                                 (LABELFONT (HELVETICA 8)))
-                          (FIELD (PRELABEL "   Para leading")
-                                 (POSTLABEL "pts")
-                                 (IDENTIFIER PARALEADING)
-                                 (FIELDTYPE NUMBER)
-                                 (LABELFONT (HELVETICA 8)))
-                          (FIELD (IDENTIFIER SPECIALX)
-                                 (PRELABEL "    Special Locn: X")
-                                 (POSTLABEL "picas")
-                                 (FIELDTYPE PICAS)
-                                 (LABELFONT (HELVETICA 8)))
-                          (FIELD (IDENTIFIER SPECIALY)
-                                 (PRELABEL "  Y")
-                                 (POSTLABEL "picas")
-                                 (FIELDTYPE PICAS)
-                                 (LABELFONT (HELVETICA 8)))
-                          EOL
-                          (TEXT (STRING "New Page:  ")
-                                (FONT (HELVETICA 8)))
-                          (3STATE (IDENTIFIER NEWPAGEBEFORE)
-                                 (LABEL "Before"))
-                          2
-                          (3STATE (IDENTIFIER NEWPAGEAFTER)
-                                 (LABEL "After"))
-                          4
-                          (3STATE (IDENTIFIER HEADINGKEEP)
-                                 (LABEL "Keep heading"))
-                          (TEXT (STRING "      Display mode: ")
-                                (FONT (HELVETICA 8)))
-                          (3STATE (LABEL "Hardcopy"))        (* (FIELD (IDENTIFIER PRINTFILETYPE)
+           (FUNCTION PRINTERTYPE)
+           (FUNCTION \TEDIT.PARAMENU.RESHAPEFN))
+    (LET (MENUTSTREAM)
+         (SETQ MENUTSTREAM (\TEDIT.MENU.CREATE
 `((ACTION (LABEL APPLY)
+                                                        (IGNORE T)
+                                                        (SELECTFN \TEDIT.APPLY.PARALOOKS))
+                                                 3
+                                                 (ACTION (LABEL SHOW)
+                                                        (IGNORE T)
+                                                        (SELECTFN \TEDIT.SHOW.PARALOOKS))
+                                                 3
+                                                 (ACTION (LABEL NEUTRAL)
+                                                        (IGNORE T)
+                                                        (SELECTFN \TEDIT.MENU.NEUTRALIZE))
+                                                 EOL
+                                                 (NWAY (IDENTIFIER QUAD)
+                                                       (BUTTONS (Left Right Centered Justified))
+                                                       (INITSTATE OFF))
+                                                 TAB
+                                                 (3STATE (IDENTIFIER TYPE)
+                                                        (LABEL "Page Heading"))
+                                                 2
+                                                 (FIELD (IDENTIFIER SUBTYPE)
+                                                        (PRELABEL "type")
+                                                        (FIELDTYPE SYMBOL))
+                                                 EOL
+                                                 (FIELD (IDENTIFIER LINELEADING)
+                                                        (PRELABEL "Line leading")
+                                                        (POSTLABEL "pts")
+                                                        (FIELDTYPE NUMBER)
+                                                        (LABELFONT (HELVETICA 8)))
+                                                 (FIELD (PRELABEL "   Para leading")
+                                                        (POSTLABEL "pts")
+                                                        (IDENTIFIER PARALEADING)
+                                                        (FIELDTYPE NUMBER)
+                                                        (LABELFONT (HELVETICA 8)))
+                                                 (FIELD (IDENTIFIER SPECIALX)
+                                                        (PRELABEL "    Special Locn: X")
+                                                        (POSTLABEL "picas")
+                                                        (FIELDTYPE PICAS)
+                                                        (LABELFONT (HELVETICA 8)))
+                                                 (FIELD (IDENTIFIER SPECIALY)
+                                                        (PRELABEL "  Y")
+                                                        (POSTLABEL "picas")
+                                                        (FIELDTYPE PICAS)
+                                                        (LABELFONT (HELVETICA 8)))
+                                                 EOL
+                                                 (TEXT (STRING "New Page:  ")
+                                                       (FONT (HELVETICA 8)))
+                                                 (3STATE (IDENTIFIER NEWPAGEBEFORE)
+                                                        (LABEL "Before"))
+                                                 2
+                                                 (3STATE (IDENTIFIER NEWPAGEAFTER)
+                                                        (LABEL "After"))
+                                                 4
+                                                 (3STATE (IDENTIFIER HEADINGKEEP)
+                                                        (LABEL "Keep heading"))
+                                                 (TEXT (STRING "      Display mode: ")
+                                                       (FONT (HELVETICA 8)))
+                                                 (3STATE (LABEL "Hardcopy"))
+                                                             (* (FIELD (IDENTIFIER PRINTFILETYPE)
 
                                                             (FIELDTYPE SYMBOL) (INITSTATE
 
                                                             (\, (PRINTERTYPE)))))

-                          4 EOL (TEXT (STRING "Tab Type:  ")
-                                      (FONT (HELVETICA 8)))
-                          (NWAY (IDENTIFIER TABTYPE)
-                                (BUTTONS (Left Right Centered Decimal))
-                                (IGNORE T))
-                          3
-                          (TOGGLE (IDENTIFIER DOTTEDLEADER)
-                                 (LABEL "Dotted Leader")
-                                 (IGNORE T))
-                          (FIELD (IDENTIFIER DEFAULTTAB)
-                                 (PRELABEL "     Default Tab:")
-                                 (POSTLABEL "pts")
-                                 (FIELDTYPE NUMBER)
-                                 (LABELFONT (HELVETICA 8)))
-                          EOL
-                          ((PROGN (TEDIT.INSERT.OBJECT (MARGINBAR.CREATE
 -0.5 -0.5 -39.5 NIL 12)
-                                         MENUTSTREAM CH# '(PROTECTED OFF))
-                                  1))
-                          EOL])
+                                                 4 EOL (TEXT (STRING "Tab Type:  ")
+                                                             (FONT (HELVETICA 8)))
+                                                 (NWAY (IDENTIFIER TABTYPE)
+                                                       (BUTTONS (Left Right Centered Decimal))
+                                                       (IGNORE T))
+                                                 3
+                                                 (TOGGLE (IDENTIFIER DOTTEDLEADER)
+                                                        (LABEL "Dotted Leader")
+                                                        (IGNORE T))
+                                                 (FIELD (IDENTIFIER DEFAULTTAB)
+                                                        (PRELABEL "     Default Tab:")
+                                                        (POSTLABEL "pts")
+                                                        (FIELDTYPE NUMBER)
+                                                        (LABELFONT (HELVETICA 8)))
+                                                 EOL
+                                                 ((PROGN (TEDIT.INSERT.OBJECT (MARGINBAR.CREATE

+                                                                               -0.5 -0.5 -39.5 NIL 12
+                                                                               NIL MAINTSTREAM)
+                                                                MENUTSTREAM CH# '(PROTECTED OFF))
+                                                         1))
+                                                 EOL)
+                                  NIL MAINTSTREAM))
+         [PUTTEXTPROP MENUTSTREAM 'WINDOWPROPS `(RESHAPEFN (\TEDIT.PARAMENU.RESHAPEFN
]
+         MENUTSTREAM])
 
 (\TEDIT.PARAMENU.START

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 28-May-2025 23:45 by rmk")


+  [LAMBDA (MAINTSTREAM)
                                      (* ; "Edited 19-Oct-2025 10:29 by rmk")


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


                                                              (* ; "Edited 14-Mar-2025 15:42 by rmk")


                                                              (* ; "Edited  7-Jan-2025 15:36 by rmk")


                                                              (* ; "Edited 27-Jul-2024 00:06 by rmk")


@@ -1778,9 +1803,9 @@
                                                              (* ; "Edited 27-Feb-2024 07:53 by rmk")


                                                              (* ; "Edited 19-Sep-2023 08:51 by rmk")


                                                              (* ; "Edited 20-Aug-87 16:51 by jds")

-    (CL:UNLESS (\TEDIT.MENU.OPEN?
 "Paragraph-Looks Menu" TSTREAM)
-        (\TEDIT.MENU.START
 (\TEDIT.PARAMENU.CREATE
)
-               TSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T)
+    (CL:UNLESS (\TEDIT.MENU.OPEN?
 "Paragraph-Looks Menu" MAINTSTREAM)
+        (\TEDIT.MENU.START
 (\TEDIT.PARAMENU.CREATE
 MAINTSTREAM)
+               MAINTSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T)
                'PARALOOKS))])
 
 (\TEDIT.APPLY.PARALOOKS

@@ -1895,6 +1920,21 @@
           (CL:WHEN SETSTATEFN
               (SETQ PC (APPLY* SETSTATEFN PC VAL MENUSTREAM))
               (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ))])
+
+(\TEDIT.PARAMENU.RESHAPEFN

+  [LAMBDA (PANE BITS OLDREGION)
                              (* ; "Edited 19-Oct-2025 14:18 by rmk")

+
+    (* ;; "The marginbar's width may change when the parawindow is reshaped.  If PANE is wider than the previous width, extend the margin bar.")

+
+    (LET [(PC (MB.GET 'MARGINBAR PANE 'STARTPC]
+         (CL:WHEN [AND PC (IGREATERP (PANEWIDTH PANE)
+                                 (fetch
 (MARGINBAR
 MARBARWIDTH) of
 (IMAGEOBJPROP (POBJ PC)
+                                                                          'OBJECTDATUM]
+             [WITH
 MARGINBAR (IMAGEOBJPROP (POBJ PC)
+                                    'OBJECTDATUM)
+                   (FSETPC PC POBJ (MARGINBAR.CREATE
 MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE
+                                          (PANEWIDTH PANE])
+         (\TEDIT.RESHAPEFN PANE BITS OLDREGION])
 )
 
 
@@ -2867,32 +2907,32 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4902 16540 (TEDIT.ADD.MENUITEM 4912 . 7029) (TEDIT.DEFAULT.MENUFN 7031 . 13752) (
-TEDIT.REMOVE.MENUITEM 13754 . 14751) (\TEDIT.CREATEMENU 14753 . 15318) (\TEDIT.MENU.WHENHELDFN 15320
- . 16225) (\TEDIT.MENU.WHENSELECTEDFN 16227 . 16538)) (17354 63997 (DRAWMARGINSCALE 17364 . 20823) (
-MARGINBAR 20825 . 27950) (MARGINBAR.CREATE 27952 . 31371) (MB.MARGINBAR.BUTTONEVENTINFN 31373 . 39175)
- (MB.MARGINBAR.SELFN.TABS 39177 . 44417) (MB.MARGINBAR.SELFN.TABS.KIND 44419 . 45354) (
-MARGINBAR.GETSTATEFN 45356 . 49343) (MARGINBAR.SETSTATEFN 49345 . 49555) (MARGINBAR.NEUTRALIZE 49557
- . 49970) (MARGINBAR.LOOKS 49972 . 53078) (MB.MARGINBAR.SIZEFN 53080 . 53683) (MB.MARGINBAR.DISPLAYFN 
-53685 . 56746) (MDESCALE 56748 . 57288) (MSCALE 57290 . 57620) (MB.MARGINBAR.SHOWTAB 57622 . 59945) (
-MB.MARGINBAR.TABTRACK 59947 . 61332) (MARGINBAR.INIT 61334 . 62727) (\TEDIT.PARALOOKS.TO.MARBAR 62729
- . 63995)) (64822 72104 (TEDIT.MENUSTREAM 64832 . 65832) (TEDITMENUP 65834 . 66803) (\TEDIT.MENU.START
- 66805 . 71152) (\TEDIT.MENU.OPEN? 71154 . 71528) (\TEDIT.MENU.BUTTONEVENTFN 71530 . 72102)) (72423 
-80345 (\TEDIT.MENU.CREATE 72433 . 74244) (\TEDIT.MENU.PARSE 74246 . 77935) (\TEDIT.MENU.NEUTRALIZE 
-77937 . 80008) (\TEDITMENU.RECORD.UNFORMATTED 80010 . 80343)) (80411 100192 (
-\TEDIT.EXPANDEDMENU.CREATE 80421 . 85888) (\TEDIT.EXPANDEDMENU.START 85890 . 87514) (
-\TEDIT.EXPANDEDMENU.FN 87516 . 90771) (\TEDIT.EXPANDEDMENU.ACTIONFN 90773 . 100190)) (100254 116311 (
-\TEDIT.PARAMENU.CREATE 100264 . 106658) (\TEDIT.PARAMENU.START 106660 . 107785) (
-\TEDIT.APPLY.PARALOOKS 107787 . 108839) (\TEDIT.SHOW.PARALOOKS 108841 . 111558) (
-\TEDIT.PARAMENU.FILLIN 111560 . 116309)) (116516 143358 (\TEDIT.CHARMENU.CREATE 116526 . 119130) (
-\TEDIT.CHARMENU.START 119132 . 120422) (\TEDIT.CHARMENU.SPEC 120424 . 125107) (\TEDIT.CHARMENU.PARSE 
-125109 . 128277) (\TEDIT.CHARMENU.FILLIN 128279 . 132909) (\TEDIT.SHOW.CHARLOOKS 132911 . 136456) (
-\TEDIT.APPLY.CHARLOOKS 136458 . 137619) (\TEDIT.OFFSETTYPE.STATEFN 137621 . 139584) (
-\TEDIT.OTHER.STATECHANGEFN 139586 . 141231) (\TEDIT.OTHER.SELECTFN 141233 . 143356)) (143420 172478 (
-\TEDIT.PAGEMENU.CREATE 143430 . 151942) (\TEDIT.PAGEMENU.START 151944 . 152295) (\TEDIT.SHOW.PAGELOOKS
- 152297 . 154183) (\TEDIT.PAGEMENU.FILLIN 154185 . 155735) (\TEDIT.PAGEREGION.UNPARSE 155737 . 165136)
- (\TEDIT.APPLY.PAGELOOKS 165138 . 167065) (\TEDIT.CHANGE.PAGELOOKS 167067 . 171634) (
-\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 171636 . 172476)) (172479 178282 (\TEDIT.PAGEMENU.CREATE.HEADINGS 
-172489 . 175301) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 175303 . 176728) (
-\TEDIT.PAGEMENU.HEADINGS.STATEFN 176730 . 178280)))))
+  (FILEMAP (NIL (4972 16610 (TEDIT.ADD.MENUITEM 4982 . 7099) (TEDIT.DEFAULT.MENUFN 7101 . 13822) (
+TEDIT.REMOVE.MENUITEM 13824 . 14821) (\TEDIT.CREATEMENU 14823 . 15388) (\TEDIT.MENU.WHENHELDFN 15390
+ . 16295) (\TEDIT.MENU.WHENSELECTEDFN 16297 . 16608)) (17424 65459 (DRAWMARGINSCALE 17434 . 20893) (
+MARGINBAR 20895 . 28020) (MARGINBAR.CREATE 28022 . 32220) (MB.MARGINBAR.BUTTONEVENTINFN 32222 . 40024)
+ (MB.MARGINBAR.SELFN.TABS 40026 . 45266) (MB.MARGINBAR.SELFN.TABS.KIND 45268 . 46203) (
+MARGINBAR.GETSTATEFN 46205 . 50192) (MARGINBAR.SETSTATEFN 50194 . 50404) (MARGINBAR.NEUTRALIZE 50406
+ . 51081) (MARGINBAR.LOOKS 51083 . 54189) (MB.MARGINBAR.SIZEFN 54191 . 54977) (MB.MARGINBAR.DISPLAYFN 
+54979 . 58040) (MDESCALE 58042 . 58582) (MSCALE 58584 . 58914) (MB.MARGINBAR.SHOWTAB 58916 . 61239) (
+MB.MARGINBAR.TABTRACK 61241 . 62626) (MARGINBAR.INIT 62628 . 64021) (\TEDIT.PARALOOKS.TO.MARBAR 64023
+ . 65457)) (66284 73566 (TEDIT.MENUSTREAM 66294 . 67294) (TEDITMENUP 67296 . 68265) (\TEDIT.MENU.START
+ 68267 . 72614) (\TEDIT.MENU.OPEN? 72616 . 72990) (\TEDIT.MENU.BUTTONEVENTFN 72992 . 73564)) (73885 
+81936 (\TEDIT.MENU.CREATE 73895 . 75835) (\TEDIT.MENU.PARSE 75837 . 79526) (\TEDIT.MENU.NEUTRALIZE 
+79528 . 81599) (\TEDITMENU.RECORD.UNFORMATTED 81601 . 81934)) (82002 101783 (
+\TEDIT.EXPANDEDMENU.CREATE 82012 . 87479) (\TEDIT.EXPANDEDMENU.START 87481 . 89105) (
+\TEDIT.EXPANDEDMENU.FN 89107 . 92362) (\TEDIT.EXPANDEDMENU.ACTIONFN 92364 . 101781)) (101845 121270 (
+\TEDIT.PARAMENU.CREATE 101855 . 110586) (\TEDIT.PARAMENU.START 110588 . 111842) (
+\TEDIT.APPLY.PARALOOKS 111844 . 112896) (\TEDIT.SHOW.PARALOOKS 112898 . 115615) (
+\TEDIT.PARAMENU.FILLIN 115617 . 120366) (\TEDIT.PARAMENU.RESHAPEFN 120368 . 121268)) (121475 148317 (
+\TEDIT.CHARMENU.CREATE 121485 . 124089) (\TEDIT.CHARMENU.START 124091 . 125381) (\TEDIT.CHARMENU.SPEC 
+125383 . 130066) (\TEDIT.CHARMENU.PARSE 130068 . 133236) (\TEDIT.CHARMENU.FILLIN 133238 . 137868) (
+\TEDIT.SHOW.CHARLOOKS 137870 . 141415) (\TEDIT.APPLY.CHARLOOKS 141417 . 142578) (
+\TEDIT.OFFSETTYPE.STATEFN 142580 . 144543) (\TEDIT.OTHER.STATECHANGEFN 144545 . 146190) (
+\TEDIT.OTHER.SELECTFN 146192 . 148315)) (148379 177437 (\TEDIT.PAGEMENU.CREATE 148389 . 156901) (
+\TEDIT.PAGEMENU.START 156903 . 157254) (\TEDIT.SHOW.PAGELOOKS 157256 . 159142) (\TEDIT.PAGEMENU.FILLIN
+ 159144 . 160694) (\TEDIT.PAGEREGION.UNPARSE 160696 . 170095) (\TEDIT.APPLY.PAGELOOKS 170097 . 172024)
+ (\TEDIT.CHANGE.PAGELOOKS 172026 . 176593) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176595 . 177435)) (
+177438 183241 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177448 . 180260) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 
+180262 . 181687) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181689 . 183239)))))
 STOP

library/tedit/TEDIT-SCREEN

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Aug-2025 12:51:00" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;909
 186327 
+
(FILECREATED "19-Oct-2025 00:07:29" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;910
 186445 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-SCREENCOMS)
-                  (FNS \TEDIT.FORMATLINE)
+      :CHANGES-TO (FNS \TEDIT.FORMATLINE.HORIZONTAL)
 
-      :PREVIOUS-DATE "28-Jul-2025 23:23:33" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;908)
+      :PREVIOUS-DATE " 7-Aug-2025 12:51:00" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;909)
 
 
 (PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -1294,7 +1293,8 @@
          IMAGESTREAM])
 
 (\TEDIT.FORMATLINE.HORIZONTAL

-  [LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE)
 (* ; "Edited 29-May-2025 15:15 by rmk")


+  [LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE)
 (* ; "Edited 18-Oct-2025 20:05 by rmk")


+                                                             (* ; "Edited 29-May-2025 15:15 by rmk")


                                                              (* ; "Edited 19-Feb-2025 13:35 by rmk")


                                                              (* ; "Edited  8-Feb-2025 23:37 by rmk")


                                                              (* ; "Edited 15-Mar-2024 19:35 by rmk")


@@ -1318,6 +1318,8 @@
 
     (* ;; "")

 
+    (SETQ SPACELEFT (MAX SPACELEFT 0))
+
     (* ;; "Also for HARDCOPYDISPLAY the horizontal positions (margins and character widths) are in hardcopy units.  At the end we scale them back to screen points.  ")

 
     (LET* ((PARALOOKS (FGETLD LINE LPARALOOKS))
@@ -2861,21 +2863,21 @@
                  (\TEDIT.LINE.TALLP LINE PHEIGHT))))])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (26256 28472 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26266 . 28470)) (35926 119762 (
-\TEDIT.FORMATLINE 35936 . 71423) (\TEDIT.FORMATLINE.SETUP.PARA 71425 . 76591) (
-\TEDIT.FORMATLINE.HORIZONTAL 76593 . 81261) (\TEDIT.FORMATLINE.VERTICAL 81263 . 83714) (
-\TEDIT.FORMATLINE.JUSTIFY 83716 . 89737) (\TEDIT.FORMATLINE.TABS 89739 . 97767) (\TEDIT.SCALE.TABS 
-97769 . 98560) (\TEDIT.FORMATLINE.PURGE.SPACES 98562 . 99989) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN 
-99991 . 101068) (\TEDIT.FORMATLINE.EMPTY 101070 . 105890) (\TEDIT.FORMATLINE.UPDATELOOKS 105892 . 
-112073) (\TEDIT.FORMATLINE.LASTLEGAL 112075 . 115525) (\TEDIT.LINES.ABOVE 115527 . 119138) (
-\TEDIT.CHNO.TO.YTOP 119140 . 119760)) (120039 140619 (\TEDIT.DISPLAYLINE 120049 . 132559) (
-\TEDIT.DISPLAYLINE.TABS 132561 . 135365) (\TEDIT.LINECACHE 135367 . 136095) (\TEDIT.CREATE.LINECACHE 
-136097 . 136933) (\TEDIT.BLTCHAR 136935 . 139562) (\TEDIT.DIACRITIC.SHIFT 139564 . 140617)) (141234 
-186304 (\TEDIT.BACKFORMAT 141244 . 143798) (\TEDIT.PREVIOUS.LINEBREAK 143800 . 146603) (
-\TEDIT.UPDATE.LINES 146605 . 152320) (\TEDIT.PANE.CREATELINES 152322 . 154612) (
-\TEDIT.SUFFIXLINE.CREATE 154614 . 156229) (\TEDIT.LINES.BELOW 156231 . 160841) (\TEDIT.MEASURED.LINES 
-160843 . 162852) (\TEDIT.VALID.LASTCHNOS 162854 . 166630) (\TEDIT.VALID.NEXTCHNOS 166632 . 170106) (
-\TEDIT.LASTVALIDLINE 170108 . 174779) (\TEDIT.NEXTVALIDLINE 174781 . 177751) (
-\TEDIT.CLEARPANE.BELOW.LINE 177753 . 179859) (\TEDIT.INSERTLINE 179861 . 181247) (\TEDIT.LINE.BOTTOM 
-181249 . 184479) (\TEDIT.SHOW.AT.BOTTOMP 184481 . 185591) (\TEDIT.SHOW.AT.TOPP 185593 . 186302)))))
+  (FILEMAP (NIL (26225 28441 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26235 . 28439)) (35895 119880 (
+\TEDIT.FORMATLINE 35905 . 71392) (\TEDIT.FORMATLINE.SETUP.PARA 71394 . 76560) (
+\TEDIT.FORMATLINE.HORIZONTAL 76562 . 81379) (\TEDIT.FORMATLINE.VERTICAL 81381 . 83832) (
+\TEDIT.FORMATLINE.JUSTIFY 83834 . 89855) (\TEDIT.FORMATLINE.TABS 89857 . 97885) (\TEDIT.SCALE.TABS 
+97887 . 98678) (\TEDIT.FORMATLINE.PURGE.SPACES 98680 . 100107) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN 
+100109 . 101186) (\TEDIT.FORMATLINE.EMPTY 101188 . 106008) (\TEDIT.FORMATLINE.UPDATELOOKS 106010 . 
+112191) (\TEDIT.FORMATLINE.LASTLEGAL 112193 . 115643) (\TEDIT.LINES.ABOVE 115645 . 119256) (
+\TEDIT.CHNO.TO.YTOP 119258 . 119878)) (120157 140737 (\TEDIT.DISPLAYLINE 120167 . 132677) (
+\TEDIT.DISPLAYLINE.TABS 132679 . 135483) (\TEDIT.LINECACHE 135485 . 136213) (\TEDIT.CREATE.LINECACHE 
+136215 . 137051) (\TEDIT.BLTCHAR 137053 . 139680) (\TEDIT.DIACRITIC.SHIFT 139682 . 140735)) (141352 
+186422 (\TEDIT.BACKFORMAT 141362 . 143916) (\TEDIT.PREVIOUS.LINEBREAK 143918 . 146721) (
+\TEDIT.UPDATE.LINES 146723 . 152438) (\TEDIT.PANE.CREATELINES 152440 . 154730) (
+\TEDIT.SUFFIXLINE.CREATE 154732 . 156347) (\TEDIT.LINES.BELOW 156349 . 160959) (\TEDIT.MEASURED.LINES 
+160961 . 162970) (\TEDIT.VALID.LASTCHNOS 162972 . 166748) (\TEDIT.VALID.NEXTCHNOS 166750 . 170224) (
+\TEDIT.LASTVALIDLINE 170226 . 174897) (\TEDIT.NEXTVALIDLINE 174899 . 177869) (
+\TEDIT.CLEARPANE.BELOW.LINE 177871 . 179977) (\TEDIT.INSERTLINE 179979 . 181365) (\TEDIT.LINE.BOTTOM 
+181367 . 184597) (\TEDIT.SHOW.AT.BOTTOMP 184599 . 185709) (\TEDIT.SHOW.AT.TOPP 185711 . 186420)))))
 STOP

library/tedit/TEDIT-WINDOW

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 5-Oct-2025 10:56:19" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;867
 229880 
+
(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;881
 231034 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.SPLITW)
+      :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
 
-      :PREVIOUS-DATE "18-Sep-2025 23:09:24" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;864)
+      :PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;878)
 
 
 (PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -354,25 +354,20 @@
 (DEFINEQ
 
 (\TEDIT.WINDOW.CREATE

-  [LAMBDA (WINDOW TSTREAM PROPS)
                             (* ; "Edited 21-Jul-2025 11:55 by rmk")


+  [LAMBDA (WINDOW TSTREAM PROPS)
                             (* ; "Edited 15-Nov-2025 01:27 by rmk")


+                                                             (* ; "Edited 23-Oct-2025 18:22 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 11:55 by rmk")


                                                              (* ; "Edited  9-May-2025 12:11 by rmk")


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


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


                                                              (* ; "Edited 18-Feb-2025 09:49 by rmk")


                                                              (* ; "Edited  1-Jul-2024 22:55 by rmk")


-                                                             (* ; "Edited 29-Jun-2024 23:16 by rmk")


                                                              (* ; "Edited  5-May-2024 21:54 by rmk")


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


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


                                                              (* ; "Edited 18-Dec-2023 23:01 by rmk")


                                                              (* ; "Edited 25-Nov-2023 10:37 by rmk")


                                                              (* ; "Edited 23-Oct-2023 22:11 by rmk")


-                                                             (* ; "Edited 21-Oct-2023 12:20 by rmk")


-                                                             (* ; "Edited 18-Oct-2023 09:56 by rmk")


-                                                             (* ; "Edited  1-Jan-2022 23:54 by rmk")


-                                                             (* ; "Edited 30-Dec-2021 23:00 by rmk")


-                                                             (* ; "Edited 29-Dec-2021 16:35 by rmk")


-                                                             (* ; "Edited 24-Dec-2021 19:21 by rmk")

+                                                             (* ; "Edited  1-Jan-2022 23:54 by rmk")

                                                              (* jds "23-May-85 15:19")

                                                              (* ; "Edited 27-Oct-2021 12:25 by rmk:")

 
@@ -383,24 +378,26 @@
 
     (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
           (PHEIGHT 0)
-          TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ)
+          REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT)
+         (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE))
          (CL:WHEN (WINDOWP WINDOW)
              (CL:WHEN (GETTSTR (fetch
 (TEXTWINDOW WTEXTSTREAM) of
 WINDOW)
                              TEXTOBJ)
 
-                 (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape.%" ")

+                 (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape. Make sure it has a title%" ")

 
                  (TEDIT.KILL WINDOW)
                  (\TEDIT.CLOSESPLITS
 (fetch
 (TEXTWINDOW WTEXTSTREAM) of
 WINDOW)
                         T))
-             [SETQ TITLE (OR (LISTGET PROPS 'TITLE)
-                             (WINDOWPROP WINDOW 'TITLE])
+
+             (* ;; "Every tedit window has a title bar, maybe one that it had already?")

+
+             (WINDOWPROP WINDOW 'TITLE (OR (LISTGET PROPS 'TITLE)
+                                           (WINDOWPROP WINDOW 'TITLE)
+                                           (\TEDIT.DEFAULT.TITLE
 FILE PROPS))))
          (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE)
                               (AND (LITATOM WINDOW)
                                    WINDOW)))
-         (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE))
-         (CL:UNLESS TITLE
-             (SETQ TITLE (\TEDIT.DEFAULT.TITLE
 FILE PROPS)))
          (SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW))
 
          (* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.")

@@ -420,7 +417,6 @@
              (SETQ REGION (if
 (REGIONP WINDOW)
                               then
 (PROG1 (COPY WINDOW)
                                           (SETQ WINDOW NIL))
-                            elseif
 (GRAB-TYPED-REGION REGIONTYPE)
                             else
 (SETQ REGION (\TEDIT.WINDOW.GETREGION
 TSTREAM REGIONTYPE PHEIGHT)) 
                                                              (* ; 
 
                                                        "We don't want the default to keep shrinking")

@@ -428,7 +424,8 @@
                                  REGION))
              (add
 (fetch
 (REGION HEIGHT) of
 REGION)
                   (IMINUS PHEIGHT))
-             (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS))
+             (SETQ WINDOW (CREATEW REGION (\TEDIT.DEFAULT.TITLE
 FILE PROPS)
+                                 NIL NIL PROPS))
 
              (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default.  We stash it back onto the window so it will be remembered for next time.")

 
@@ -458,60 +455,95 @@
 
          (FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP
 WINDOW TSTREAM PROPS))
                                                              (* ; "This should be PANE")

-         (WINDOWPROP WINDOW 'TITLE TITLE)
          WINDOW])
 
 (\TEDIT.WINDOW.GETREGION

-  [LAMBDA (TSTREAM REGIONTYPE PHEIGHT)
                       (* ; "Edited 14-Apr-2025 00:05 by rmk")


+  [LAMBDA (TSTREAM REGIONTYPE PHEIGHT)
                       (* ; "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")


                                                              (* ; "Edited 24-Mar-2025 11:29 by rmk")


                                                              (* ; "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")

+
+                                         \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)
-         (CLRPROMPT)                                         (* ; "System promptwindow")

-         (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
-                " window region")
-         (CL:WHEN (TXTFILE TSTREAM)
-             (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
-         (TERPRI PROMPTWINDOW)
-         (if
 (IGREATERP (TEXTLEN TEXTOBJ)
-                    0)
-             then
 
-                  (* ;; "Explict user properties covers content")

 
-                  [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
-                                  (for
 PARALOOKS in
 (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
-                                     largest
 (GETPLOOKS PARALOOKS RIGHTMAR)
-                                     finally
 (CL:UNLESS (AND $$EXTREME (IGREATERP $$EXTREME 0))
-                                                 (SETQ $$EXTREME (TIMES 6 PTSPERINCH)))
-                                           (RETURN $$EXTREME] 
+         (* ;; "Explict properties cover content")

 
-                  (* ;; "Allow for extra stuff.  36 to allow for some spacing.")

+         [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))
 
-                  [add
 WIDTH (IPLUS \TEDIT.LINEREGION.WIDTH (ADD1 (TIMES 2 WBorder)
-                                                                  1)
-                                    (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
-                                        0
-                                        (CL:IF (EQ 0 \TEDIT.OP.WIDTH)
-                                            \TEDIT.LINEREGION.WIDTH
-                                            (IPLUS \TEDIT.OP.WIDTH 36)))]
-                  [SETQ HEIGHT (if
 (GETTEXTPROP TEXTOBJ 'OPENHEIGHT)
-                                 elseif
 (ZEROP (TEXTLEN TEXTOBJ))
-                                   then
 50
-                                 else
 (for
 I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
-                                           (CHNO _ 1) from
 1 to
 20 while
 (ILEQ CHNO TEXTLEN)
-                                         sum
 (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO))
-                                             (SETQ CHNO (FGETLD L LCHARLIM))
-                                             (FGETLD L LHEIGHT)
-                                         finally
 (RETURN (IPLUS $$VAL PHEIGHT (ADD1 (TIMES 2 WBorder)
-                                                                                    )
-                                                                (FONTPROP WindowTitleDisplayStream
-                                                                       'HEIGHT]
-                  (GETBOXREGION WIDTH HEIGHT)
-           else
 (GETREGION (IMAX 200 (ADD1 (TIMES 2 WBorder)))
-                       (IMAX 100 (ADD1 (TIMES 2 WBorder])
+         (* ;; "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
 
+                   (* ;; 
+
            "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))
+
+                           (* ;; 
+
                           "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))))
+
+         (* ;; "Minimum sizes")

+
+         (SETQ WIDTH (IMAX 200 (OR WIDTH 0)))
+         (SETQ HEIGHT (IMAX 100 (OR HEIGHT 0)))
+
+         (* ;; "Allow for the extra stuff")

+
+         (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])
 
 (\TEDIT.WINDOW.SETUP

   [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1)
              (* ; "Edited  6-May-2025 11:44 by rmk")


@@ -576,7 +608,8 @@
           (\TEDIT.SET.WINDOW.EXTENT
 TEXTOBJ PANE])
 
 (\TEDIT.MINIMAL.WINDOW.SETUP

-  [LAMBDA (PANEWINDOW TSTREAM PROPS)
                         (* ; "Edited 20-Apr-2025 15:19 by rmk")


+  [LAMBDA (PANEWINDOW TSTREAM PROPS)
                         (* ; "Edited 19-Oct-2025 14:55 by rmk")


+                                                             (* ; "Edited 20-Apr-2025 15:19 by rmk")


                                                              (* ; "Edited 30-Nov-2024 13:32 by rmk")


                                                              (* ; "Edited  4-Nov-2024 19:46 by rmk")


                                                              (* ; "Edited 26-Oct-2024 11:10 by rmk")


@@ -677,6 +710,11 @@
 
          (WINDOWADDPROP PANEWINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW)
                 T)
+
+         (* ;; "Possible the only WINDOWPROPS client is the MARGINBAR in the paragraph menu")

+
+         (for
 PTAIL on
 (GETTEXTPROP TSTREAM 'WINDOWPROPS) do
 (WINDOWPROP PANEWINDOW (CAR PTAIL)
+                                                                    (CADR PTAIL)))
          PANEWINDOW])
 
 (\TEDIT.CLEARPANE

@@ -3624,36 +3662,36 @@
 (RPAQ? TEDIT.TITLED.ICON.TEMPLATE
 (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ 
                                          TEDIT.ICON.TITLE.REGION))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17093 17989 (TEDIT.DEFER.UPDATES 17103 . 17987)) (17990 43935 (\TEDIT.WINDOW.CREATE 
-18000 . 25330) (\TEDIT.WINDOW.GETREGION 25332 . 28822) (\TEDIT.WINDOW.SETUP 28824 . 33154) (
-\TEDIT.MINIMAL.WINDOW.SETUP 33156 . 40567) (\TEDIT.CLEARPANE 40569 . 41286) (\TEDIT.FILL.PANES 41288
- . 43933)) (43936 67637 (\TEDIT.CURSORMOVEDFN 43946 . 49556) (\TEDIT.CURSOROUTFN 49558 . 50246) (
-\TEDIT.ACTIVE.WINDOWP 50248 . 51318) (\TEDIT.EXPANDFN 51320 . 51883) (\TEDIT.MAINW 51885 . 53165) (
-\TEDIT.MAINSTREAM 53167 . 53501) (\TEDIT.PRIMARYPANE 53503 . 54273) (\TEDIT.PANELIST 54275 . 54771) (
-\TEDIT.NEWREGIONFN 54773 . 57289) (\TEDIT.SET.WINDOW.EXTENT 57291 . 62273) (\TEDIT.SHRINK.ICONCREATE 
-62275 . 65008) (\TEDIT.SHRINKFN 65010 . 65419) (\TEDIT.PANEREGION 65421 . 67635)) (67669 100715 (
-\TEDIT.BUTTONEVENTFN 67679 . 80652) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80654 . 87917) (
-\TEDIT.BUTTONEVENTFN.GETOPERATION 87919 . 89761) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89763 . 93433) (
-\TEDIT.BUTTONEVENTFN.INACTIVE 93435 . 95865) (\TEDIT.BUTTONEVENTFN.INTITLE 95867 . 97702) (
-\TEDIT.COPYINSERTFN 97704 . 98836) (\TEDIT.FOREIGN.COPY 98838 . 100713)) (100716 118279 (
-\TEDIT.PANE.SPLIT 100726 . 104674) (\TEDIT.SPLITW 104676 . 112735) (\TEDIT.UNSPLITW 112737 . 116936) (
-\TEDIT.LINKPANES 116938 . 117701) (\TEDIT.UNLINKPANE 117703 . 118277)) (119713 120604 (TEDITWINDOWP 
-119723 . 120602)) (120641 123744 (TEDIT.GETINPUT 120651 . 123094) (\TEDIT.MAKEFILENAME 123096 . 123742
-)) (123793 131443 (TEDIT.PROMPTWINDOW 123803 . 124117) (TEDIT.PROMPTPRINT 124119 . 126746) (
-TEDIT.PROMPTCLEAR 126748 . 128490) (TEDIT.PROMPTFLASH 128492 . 129750) (\TEDIT.PROMPT.PAGEFULLFN 
-129752 . 131441)) (131681 142259 (\TEDIT.FILENAME 131691 . 132463) (\TEDIT.DEFAULT.TITLE 132465 . 
-134844) (\TEDIT.WINDOW.TITLE 134846 . 137015) (\TEDIT.LIKELY.FILENAME 137017 . 139741) (
-\TEDIT.UPDATE.TITLE 139743 . 142257)) (142302 154786 (TEDIT.DEACTIVATE.WINDOW 142312 . 147885) (
-\TEDIT.RESHAPEFN 147887 . 149972) (\TEDIT.REPAINTFN 149974 . 150198) (\TEDIT.CLOSESPLITS 150200 . 
-152645) (\TEDIT.CLOSEPANE 152647 . 154784)) (154787 197586 (\TEDIT.SCROLLFN 154797 . 157028) (
-\TEDIT.SCROLLCH.TOP 157030 . 159141) (\TEDIT.SCROLLCH.BOTTOM 159143 . 163473) (\TEDIT.SCROLLUP 163475
- . 169201) (\TEDIT.TOPLINE.YTOP 169203 . 170872) (\TEDIT.SCROLLDOWN 170874 . 177913) (
-\TEDIT.SCROLL.CARET 177915 . 180753) (\TEDIT.VISIBLECARETP 180755 . 183049) (\TEDIT.VISIBLECHARP 
-183051 . 184142) (\TEDIT.BITMAPLINES 184144 . 188064) (\TEDIT.SETPANE.TOPLINE 188066 . 188678) (
-\TEDIT.SHIFTLINES 188680 . 197584)) (197587 208456 (\TEDIT.ONSCREEN? 197597 . 202148) (
-\TEDIT.ONSCREEN.REGION 202150 . 205801) (\TEDIT.AFTERMOVEFN 205803 . 206700) (OFFSCREENP 206702 . 
-208454)) (208498 211312 (\TEDIT.PROCIDLEFN 208508 . 210168) (\TEDIT.PROCENTRYFN 210170 . 210615) (
-\TEDIT.PROCEXITFN 210617 . 211310)) (211391 224616 (\TEDIT.DOWNCARET 211401 . 212194) (
-\TEDIT.FLASHCARET 212196 . 214307) (\TEDIT.UPCARET 214309 . 215413) (TEDIT.NORMALIZECARET 215415 . 
-218633) (\TEDIT.SETCARET 218635 . 223986) (\TEDIT.CARET 223988 . 224614)))))
+  (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE 
+18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) (
+\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442
+ . 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) (
+\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) (
+\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) (
+\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE 
+63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 (
+\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) (
+\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) (
+\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) (
+\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 (
+\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) (
+\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP 
+120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896
+)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) (
+TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN 
+130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 . 
+135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) (
+\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) (
+\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 . 
+153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) (
+\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629
+ . 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) (
+\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP 
+184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) (
+\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) (
+\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 . 
+209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) (
+\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) (
+\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 . 
+219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768)))))
 STOP

library/virtualkeyboards/DANDELIONKEYBOARDS

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Jul-2023 08:52:09" {WMEDLEY}<library>virtualkeyboards>DANDELIONKEYBOARDS.;3
 33795  
+
(FILECREATED "15-Oct-2025 16:50:39" {WMEDLEY}<library>virtualkeyboards>DANDELIONKEYBOARDS.;4
 33748  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS DANDELIONKEYBOARDSCOMS)
-
-      :PREVIOUS-DATE " 4-Jul-2023 23:18:05" {WMEDLEY}<library>virtualkeyboards>DANDELIONKEYBOARDS.;2
+      :PREVIOUS-DATE " 6-Jul-2023 08:52:09" {WMEDLEY}<library>virtualkeyboards>DANDELIONKEYBOARDS.;3
 )
 
 
@@ -324,7 +322,7 @@
                          (135 (9850 9818 LOCKSHIFT))
                          (137 (9841 9809 LOCKSHIFT))
                          (138 (106 74 LOCKSHIFT))
-                         (139 (9826 66 LOCKSHIFT))
+                         (139 (9826 9794 LOCKSHIFT))
                          (140 (9833 9801 LOCKSHIFT))
                          (141 1SHIFTDOWN . 1SHIFTUP)
                          (142 (46 62 NOLOCKSHIFT))

lispusers/BACKGROUND-YIELD

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Jul-2023 09:49:24" {DSK}<home>larry>il>medley>lispusers>BACKGROUND-YIELD.;2
 1770   
+
(FILECREATED " 9-Nov-2025 11:52:07" {DSK}<Users>larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;2
 1882   
 
       :EDIT-BY "lmm"
 
       :CHANGES-TO (FNS BACKGROUND-YIELD)
 
-      :PREVIOUS-DATE "14-Nov-2021 22:05:58" {DSK}<home>larry>il>medley>lispusers>BACKGROUND-YIELD.;1
+      :PREVIOUS-DATE "28-Jul-2023 09:49:24" {DSK}<Users>larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;1
 )
 
 
@@ -26,13 +26,14 @@
 (DEFINEQ
 
 (BACKGROUND-YIELD

-  [LAMBDA NIL
                                                (* ; "Edited 28-Jul-2023 09:11 by lmm")


+  [LAMBDA NIL
                                                (* ; "Edited  9-Nov-2025 11:50 by lmm")


+                                                             (* ; "Edited 28-Jul-2023 09:11 by lmm")


                                                            (* ; "Edited 20-Sep-2021 11:37 by larry")

     (LET ((\BACKGROUND T))
-         (DECLARE
 (SPECVARS \BACKGROUND))
+         (DECLARE
 (SPECVARS \BACKGROUND)
+                (GLOBALVARS BACKGROUND-YIELD))
          (IF
 (FIXP BACKGROUND-YIELD)
-             THEN
 (SUBRCALL YIELD BACKGROUND-YIELD)
-                  (SUBRCALL CAUSE-INTERRUPT])
+             THEN
 (SUBRCALL YIELD BACKGROUND-YIELD])
 
 (INIT-YIELD

   [LAMBDA (ONP)
                                        (* ; "Edited 19-Sep-2021 13:32 by larry")

@@ -51,5 +52,5 @@
 
 (RPAQQ BACKGROUND-YIELD
 833333)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (806 1655 (BACKGROUND-YIELD 816 . 1271) (INIT-YIELD 1273 . 1653)))))
+  (FILEMAP (NIL (808 1767 (BACKGROUND-YIELD 818 . 1383) (INIT-YIELD 1385 . 1765)))))
 STOP

lispusers/COMPAREDIRECTORIES

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Aug-2025 13:38:35" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;268
 133743 
+
(FILECREATED " 8-Nov-2025 13:07:39" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;285
 138536 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS CDENTRIES.SELECT CDPRINT.LINE)
+      :CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY)
 
-      :PREVIOUS-DATE "26-Mar-2025 09:41:31" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;267)
+      :PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;280)
 
 
 (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
@@ -160,6 +160,8 @@
 (COMPAREDIRECTORIES.INFOS

   [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE INCLUDEAUTHOR)
 
+    (* ;; "Edited 21-Oct-2025 14:26 by rmk")

+
     (* ;; "Edited 29-Sep-2023 17:25 by rmk")

 
     (* ;; "Edited 22-May-2022 14:17 by rmk")

@@ -168,43 +170,45 @@
 
     (* ;; "Each entry is a list  of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ")

 
-    (FOR
 FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR)))
-       IN
 (CDFILES
 DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)
-       COLLECT
 
+    (CL:WHEN (DIRECTORYNAMEP DIR)
+        [FOR
 FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR)))
+           IN
 (CDFILES
 DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)
+           COLLECT
 
 
-             (* ;; "GDATE/IDATE in case Y2K")

+                 (* ;; "GDATE/IDATE in case Y2K")

 
-             (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT))      (* ; 
+                 (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT))  (* ; 
 
                "So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.")

                                                              (* ; 
 
                                            "Is it a Lisp file? Get it's internal filecreated date. ")

-             (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE)
-                    (COMPAREDIRECTORIES.INFOS.TYPE
 STREAM))
-             (PROG1 (LIST (MATCHNAME
 FULLNAME STARTPOS)
-                          (CREATE
 CDINFO
-                                 FULLNAME _ (FULLNAME STREAM)
-                                 DATE _ (GDATE (IDATE (IF
 (OR USEDIRECTORYDATE (NULL LDATE))
-                                                          THEN
 (GETFILEINFO STREAM 'CREATIONDATE)
-                                                        ELSE
 (SETFILEINFO STREAM 'CREATIONDATE LDATE)
-                                                             LDATE)))
-                                 LENGTH _ (GETFILEINFO STREAM 'LENGTH)
-                                 AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR))
-                                 TYPE _ TYPE
-                                 EOL _ (EOLTYPE
 STREAM)))
-                    (CLOSEF? STREAM))
-       FINALLY
 
+                 (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE)
+                        (COMPAREDIRECTORIES.INFOS.TYPE
 STREAM))
+                 (PROG1 (LIST (MATCHNAME
 FULLNAME STARTPOS)
+                              (CREATE
 CDINFO
+                                     FULLNAME _ (FULLNAME STREAM)
+                                     DATE _ (GDATE (IDATE (IF
 (OR USEDIRECTORYDATE (NULL LDATE))
+                                                              THEN
 (GETFILEINFO STREAM 'CREATIONDATE)
+                                                            ELSE
 (SETFILEINFO STREAM 'CREATIONDATE 
+                                                                        LDATE)
+                                                                 LDATE)))
+                                     LENGTH _ (GETFILEINFO STREAM 'LENGTH)
+                                     AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR))
+                                     TYPE _ TYPE
+                                     EOL _ (EOLTYPE
 STREAM)))
+                        (CLOSEF? STREAM))
+           FINALLY
 
 
-             (* ;; "Sort to get all entries with the same matchname adjacent.  Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case.  We have deliberately given them a case-insensitive matchname, so we  can expose this issue in the display.")

+                 (* ;; "Sort to get all entries with the same matchname adjacent.  Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case.  We have deliberately given them a case-insensitive matchname, so we  can expose this issue in the display.")

 
-             (* ;; "If we see (MN X)(MN Y), smash the Y in after the X")

+                 (* ;; "If we see (MN X)(MN Y), smash the Y in after the X")

 
-             (RETURN (FOR
 ITAIL I VAL MN ON
 (SORT $$VAL T)
-                        DO
 (SETQ I (CAR ITAIL))
-                           (SETQ MN (CAR I))
-                           [WHILE
 (EQ MN (CAADR ITAIL)) DO
 (POP
 ITAIL)
-                                                           (PUSH
 (CDR I)
-                                                                 (CADR (CAR ITAIL]
-                           (PUSH
 VAL I) FINALLY
 (RETURN (DREVERSE VAL])
+                 (RETURN (FOR
 ITAIL I VAL MN ON
 (SORT $$VAL T)
+                            DO
 (SETQ I (CAR ITAIL))
+                               (SETQ MN (CAR I))
+                               [WHILE
 (EQ MN (CAADR ITAIL)) DO
 (POP
 ITAIL)
+                                                               (PUSH
 (CDR I)
+                                                                     (CADR (CAR ITAIL]
+                               (PUSH
 VAL I) FINALLY
 (RETURN (DREVERSE VAL])])
 
 (COMPAREDIRECTORIES.CANDIDATES

   [LAMBDA (INFOS1 INFOS2)
@@ -335,7 +339,9 @@
                                             CDE])
 
 (COMPAREDIRECTORIES.INFOS.TYPE

-  [LAMBDA (FILE)
                                             (* ; "Edited 28-Sep-2023 23:09 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 22-Oct-2025 08:29 by rmk")


+                                                             (* ; "Edited 20-Sep-2025 12:59 by rmk")


+                                                             (* ; "Edited 28-Sep-2023 23:09 by rmk")


                                                              (* ; "Edited 22-May-2022 14:27 by rmk")


                                                              (* ; "Edited 25-Apr-2022 09:02 by rmk")


                                                              (* ; "Edited  4-Jan-2022 13:10 by rmk")


@@ -404,7 +410,8 @@
 (DEFINEQ
 
 (CDFILES

-  [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)
(* ; "Edited 17-Jun-2023 23:04 by rmk")


+  [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)
(* ; "Edited 20-Oct-2025 23:25 by rmk")


+                                                             (* ; "Edited 17-Jun-2023 23:04 by rmk")


                                                              (* ; "Edited  3-Oct-2022 12:03 by rmk")


                                                              (* ; "Edited 25-Apr-2022 08:42 by rmk")


                                                              (* ; "Edited  5-Mar-2022 15:05 by rmk")


@@ -426,8 +433,7 @@
 
     (* ;; "EXCLUDEDFILES is a filepattern with * meaning everything, COM means *.LCOM and *.DFASL")

 
-    [SETQ EXCLUDEDFILES `(*>.DS_Store
-                          ,@(MKLIST EXCLUDEDFILES]
+    [SETQ EXCLUDEDFILES `(*>.DS¬Store ,@(MKLIST EXCLUDEDFILES]
     (CL:UNLESS (EQMEMB '.* INCLUDEDFILES)                    (* ; 
 
                                                   "Excluded dot files unless specifically asked for")

         [SETQ EXCLUDEDFILES `(.* ,@(MKLIST EXCLUDEDFILES])
@@ -1701,6 +1707,8 @@
 (CDBROWSER

   [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS)
 
+    (* ;; "Edited 28-Oct-2025 14:49 by rmk")

+
     (* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.")

 
     (* ;; "Creates a table browser for the differences in CDVALUE.")

@@ -1746,7 +1754,7 @@
              [SETQ BROWSER (TB.MAKE.BROWSER (FOR
 PAIR IN
 STRINGS COLLECT
 (CD.TABLEITEM
 PAIR))
                                   WINDOW
                                   `(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA
-                                          ,(APPEND BROWSERPROPS (LIST 'CDVALUE CDVALUE]
+                                          (,@BROWSERPROPS (CDVALUE ,@CDVALUE]
              (ATTACHMENU (CREATE
 MENU
                                 TITLE _ " CD commands "
                                 MENUFONT _ DEFAULTFONT
@@ -1887,7 +1895,8 @@
            'DON'T])
 
 (CD.COMMANDSELECTEDFN

-  [LAMBDA (MENUITEM MENU KEY)
                                (* ; "Edited  6-Mar-2022 19:52 by rmk")


+  [LAMBDA (MENUITEM MENU KEY)
                                (* ; "Edited 28-Oct-2025 14:34 by rmk")


+                                                             (* ; "Edited  6-Mar-2022 19:52 by rmk")


                                                              (* ; "Edited 24-Feb-2022 19:52 by rmk")


                                                              (* ; "Edited  5-Feb-2022 17:23 by rmk")


                                                              (* ; "Edited 27-Jan-2022 17:46 by rmk")


@@ -1938,7 +1947,8 @@
                                             (LABEL1 (OR (CAR LABELS)
                                                         FILE1))
                                             (LABEL2 (OR (CADR LABELS)
-                                                        FILE2)))
+                                                        FILE2))
+                                            TEMP)
                                            (DECLARE
 (SPECVARS . T))
 
                                            (* ;; 
@@ -1952,6 +1962,16 @@
                                                                     OF
 (FETCH
 (CDENTRY
 INFO2)
                                                                           OF
 CDENTRY)))
                                                   (SETQ FILE2 NIL))
+                                           (CL:WHEN (SETQ TEMP (SGETMULTI (fetch
 (TABLEBROWSER 
+                                                                                        TBUSERDATA)
+                                                                             of
 CDBROWSER)
+                                                                      'ORIGINALFILES FILE1))
+                                                  (SETQ FILE1 TEMP))
+                                           (CL:WHEN (SETQ TEMP (SGETMULTI (fetch
 (TABLEBROWSER 
+                                                                                        TBUSERDATA)
+                                                                             of
 CDBROWSER)
+                                                                      'ORIGINALFILES FILE2))
+                                                  (SETQ FILE2 TEMP))
 
                                  (* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.")

 
@@ -1963,6 +1983,10 @@
 (CD-MENUFN

   [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
 
+    (* ;; "Edited  8-Nov-2025 13:06 by rmk")

+
+    (* ;; "Edited 28-Oct-2025 17:35 by rmk")

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

 
     (* ;; "Edited 18-Feb-2025 23:36 by rmk")

@@ -1990,7 +2014,8 @@
               (Compare (IF
 (AND FILE1 FILE2)
                            THEN
 (CD-COMPARE-FILES
 FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
                                                                                   WINDOW
-                                                                                  'REGION))
+                                                                                  'REGION)
+                                       CDBROWSER)
                          ELSE
 (FLASHWINDOW T)
                               (PRIN3 "Only one file" T)))
               (See% left (IF
 FILE1
@@ -2054,18 +2079,20 @@
                                         NIL))))
               (Copy% -> (CDBROWSER-COPY
 CDBROWSER TBITEM 'LEFT))
               (Copy% <- (CDBROWSER-COPY
 CDBROWSER TBITEM 'RIGHT))
-              (Delete% <- (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT T))
+              (Delete% <- (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM KEY 'LEFT T))
               (|Delete ALL <-| 
-                   (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT NIL))
-              (Delete% -> (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT T))
+                   (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM KEY 'LEFT NIL))
+              (Delete% -> (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM KEY 'RIGHT T))
               (|Delete ALL ->| 
-                   (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT NIL))
+                   (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM KEY 'RIGHT NIL))
               (SHOULDNT)))
          (CLOSEWITH CHILDREN WINDOW)
          (MOVEWITH CHILDREN WINDOW])
 
 (CD-COMPARE-FILES

-  [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION)
      (* ; "Edited 22-May-2022 14:41 by rmk")

+  [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION CDBROWSER)

+                                                             (* ; "Edited 28-Oct-2025 10:42 by rmk")


+                                                             (* ; "Edited 22-May-2022 14:41 by rmk")

     (PROG NIL
           (SETQ FILE1 (OR (STREAMP FILE1)
                           (INFILEP FILE1)))
@@ -2088,7 +2115,7 @@
                                                         `(,PARENTREGION 0.125)
                                                         (IPLUS (FETCH
 (REGION BOTTOM) OF
 PARENTREGION
                                                                       )
-                                                               20)
+                                                               70)
                                                         NIL))))
                       (COMPILED (FLASHWINDOW T)
                                 (PRIN3 "Cannot compare compiled files" T))
@@ -2117,17 +2144,22 @@
                                                              NIL])
 
 (CDBROWSER-COPY

-  [LAMBDA (CDBROWSER
 TBITEM SOURCE)
                          (* ; "Edited 24-May-2022 15:49 by rmk")


+  [LAMBDA (CDBROWSER
 TBITEM SOURCE UNIXDEST)
                 (* ; "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")


                                                              (* ; "Edited  5-Feb-2022 17:27 by rmk")


                                                              (* ; "Edited  2-Feb-2022 22:18 by rmk")

 
     (* ;; "Copies the file identified as SOURCE (LEFT or RIGHT) in CDENTRY to the other file of the end.  If the destination file is missing, it is assumed to be a new/unversioned file of the same name as the source but with the directory prefix switched.  CDVALUE needed to know what directory prefixes are involved.")

 
+    (* ;; 
+
    "if UNIXDEST, coerces the true destination file to host UNIX--suppresses Medley version numbers")

+
     (* ;; "Returns NIL if the copy fails.")

 
     (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
-        (PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER)
+        (PROG* ((CDVALUE (GETMULTI (TB.USERDATA CDBROWSER)
                                 'CDVALUE))
                 (SOURCEDIR (FETCH
 (CDVALUE CDDIR1) OF
 CDVALUE))
                 (DESTDIR (FETCH
 (CDVALUE CDDIR2) OF
 CDVALUE))
@@ -2167,7 +2199,19 @@
                (CLEARW T)
                (CL:UNLESS DESTFILE
                    (SETQ DESTFILE (CD-SWAPDIRS
 SOURCEFILE SOURCEDIR DESTDIR)))
-               (SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL 'BODY DESTFILE)))
+               [SETQ RESULT (if
 UNIXDEST
+                                then
 (SPUTMULTI (fetch
 (TABLEBROWSER TBUSERDATA) of
 CDBROWSER)
+                                            'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE))
+                                     [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY
+                                                            (COPYFILE SOURCEFILE (PACKFILENAME
+                                                                                  'HOST
+                                                                                  'UNIX
+                                                                                  'VERSION NIL
+                                                                                  'BODY
+                                                                                  (TRUEFILENAME
+                                                                                   DESTFILE]
+                              else
 (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL
+                                                               'BODY DESTFILE]
                (PRIN3 (IF
 RESULT
                           THEN
 (TB.DELETE.ITEM CDBROWSER TBITEM)
                                (CONCAT "Copied to " RESULT)
@@ -2177,7 +2221,8 @@
                (RETURN RESULT)))])
 
 (CDBROWSER-DELETE-FILE

-  [LAMBDA (CDBROWSER
 TBITEM SIDE ONLYONE SAVE)
               (* ; "Edited 25-Apr-2022 09:06 by rmk")


+  [LAMBDA (CDBROWSER
 TBITEM KEY SIDE ONLYONE SAVE DONTMARK)
  (* ; "Edited 28-Oct-2025 13:30 by rmk")


+                                                             (* ; "Edited 25-Apr-2022 09:06 by rmk")


                                                              (* ; "Edited  5-Feb-2022 17:46 by rmk")


                                                              (* ; "Edited 18-Jan-2022 23:02 by rmk")


                                                              (* ; "Edited 19-Dec-2021 23:33 by rmk")

@@ -2190,38 +2235,58 @@
 
     (* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed.  The deleted directory is defined by sticking deleted> on the front of FILE's directory.")

 
+    (DECLARE
 (USEDFREE LABEL1 LABEL2 PWINDOW))
     (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
-        [LET ((CDENTRY
 (CADR (FETCH
 TIDATA OF
 TBITEM)))
-              FILE OTHERFILE)
-             (SETQ FILE (FETCH
 (CDINFO FULLNAME) OF
 (FETCH
 (CDENTRY
 INFO1) OF
 CDENTRY)))
-             (SETQ OTHERFILE (FETCH
 (CDINFO FULLNAME) OF
 (FETCH
 (CDENTRY
 INFO2) OF
 CDENTRY)))
-             (CL:WHEN (EQ SIDE 'RIGHT)
-                    (SWAP
 FILE OTHERFILE))
-             (CL:WHEN FILE
-                 (FOR
 F INSIDE
 (IF
 (FILENAMEFIELD.STRING FILE 'VERSION)
-                                   THEN
 [IF
 ONLYONE
-                                            THEN
 FILE
-                                          ELSE
 (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*"
-                                                                        'BODY FILE]
-                                 ELSE
 FILE)
-                    COLLECT
 
+        [LET
+         ((CDENTRY
 (CADR (fetch
 TIDATA of
 TBITEM)))
+          FILE OTHERFILE DELFILES)
+         (SETQ FILE (fetch
 (CDINFO FULLNAME) of
 (fetch
 (CDENTRY
 INFO1) of
 CDENTRY)))
+         (SETQ OTHERFILE (fetch
 (CDINFO FULLNAME) of
 (fetch
 (CDENTRY
 INFO2) of
 CDENTRY)))
+         (CL:WHEN (EQ SIDE 'RIGHT)
+             (SWAP
 FILE OTHERFILE)
+             (SWAP
 LABEL1 LABEL2))
+         (SETQ DELFILES (if
 (FILENAMEFIELD.STRING FILE 'VERSION)
+                            then
 [if
 ONLYONE
+                                     then
 (MKLIST FILE)
+                                   else
 (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*"
+                                                                 'BODY FILE]
+                          else
 FILE))
+         (CL:WHEN DELFILES
+             (GIVE.TTY.PROCESS PWINDOW)
+             (CLEARW T)
+             (FLASHWINDOW T)
+             (CL:WHEN [OR (EQ KEY 'MIDDLE)
+                          (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " (CL:IF (CDR DELFILES)
+                                                                       "ALL versions of "
+                                                                       "")
+                                                        LABEL1 " ? "]
+                 (for
 F in
 DELFILES
+                    collect
 
 
                           (* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist.  This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).")

 
-                          (IF
 SAVE
-                              THEN
 (CL:UNLESS (RENAMEFILE F (PACKFILENAME.STRING
-                                                             'DIRECTORY
-                                                             (CONCAT "deleted>" (FILENAMEFIELD.STRING
-                                                                                 F
-                                                                                 'DIRECTORY))
-                                                             'BODY F))
-                                          (ERROR "Could not delete " F))
-                            ELSE
 (DELFILE FILE))
-                          F FINALLY
 
+                          (* ;; "Save copies locally in this browser, for potential Undelete.  Undelete would have to match all of the versions")

+
+                          (CL:UNLESS (if
 SAVE
+                                         then
 (PUTMULTI (fetch
 (TABLEBROWSER TBUSERDATA) of
 CDBROWSER
+                                                               )
+                                                     'ORIGINALFILES
+                                                     (RENAMEFILE F (PACKFILENAME.STRING
+                                                                    'DIRECTORY
+                                                                    (CONCAT "deleted>"
+                                                                           (FILENAMEFIELD.STRING
+                                                                            F
+                                                                            'DIRECTORY))
+                                                                    'BODY F)))
+                                       else
 (PUTMULTI (fetch
 (TABLEBROWSER TBUSERDATA) of
 CDBROWSER)
+                                                   'ORIGINALFILES FILE (COPYFILE FILE '{NODIRCORE}))
+                                            (DELFILE FILE))
+                                 (ERROR "Could not delete " F))
+                          F finally
 
 
                                   (* ;; "Perhaps only mark it as deleted if both files are gone?")

 
-                                  (TB.DELETE.ITEM CDBROWSER TBITEM)))])])
+                                  (CL:UNLESS DONTMARK (TB.DELETE.ITEM CDBROWSER TBITEM)))))])])
 
 (CD-SWAPDIRS

   [LAMBDA (FILE FROMDIR TODIR KEEPVERSION)
                   (* ; "Edited  2-Feb-2022 19:10 by rmk")

@@ -2238,38 +2303,43 @@
 
 (RPAQ? CD-LINELENGTH
 NIL)
 
-(RPAQQ CDTABLEBROWSER.MENUITEMS
 ((Compare CD-MENUFN)
-                                 (Copy% -> CD-MENUFN)
-                                 (Copy% <- CD-MENUFN)
-                                 (See% left CD-MENUFN)
-                                 (See% right CD-MENUFN)
-                                 (See% both CD-MENUFN)
-                                 (See CD-MENUFN)))
+(RPAQQ CDTABLEBROWSER.MENUITEMS

+       ((Compare CD-MENUFN)
+        (Copy% -> CD-MENUFN)
+        (Copy% <- CD-MENUFN)
+        (See% left CD-MENUFN)
+        (See% right CD-MENUFN)
+        (See% both CD-MENUFN)
+        (See CD-MENUFN)
+        (Delete% <- CD-MENUFN)
+        (|Delete ALL <-| CD-MENUFN)
+        (Delete% -> CD-MENUFN)
+        (|Delete ALL ->| CD-MENUFN)))
 
 (FILESLOAD (SYSLOAD)
        COMPARESOURCES COMPARETEXT)
 
 (MOVD? 'NILL 'TEDIT.FILEDATE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2673 23163 (COMPAREDIRECTORIES 2683 . 8018) (COMPAREDIRECTORIES.INFOS 8020 . 10978) (
-COMPAREDIRECTORIES.CANDIDATES 10980 . 14365) (CDENTRIES.SELECT 14367 . 19269) (
-COMPAREDIRECTORIES.INFOS.TYPE 19271 . 20397) (MATCHNAME 20399 . 21079) (CD.INSURECDVALUE 21081 . 22695
-) (CD.UPDATEWIDTHS 22697 . 23161)) (23164 33786 (CDFILES 23174 . 29188) (CDFILES.MATCH 29190 . 30815) 
-(CDFILES.PATS 30817 . 33784)) (33787 51805 (CDPRINT 33797 . 36314) (CDPRINT.HEADER 36316 . 37213) (
-CDPRINT.LINE 37215 . 40644) (CDPRINT.MAXWIDTHS 40646 . 44761) (CDPRINT.COLHEADERS 44763 . 46048) (
-CDPRINT.COLUMNS 46050 . 51170) (CDTEDIT 51172 . 51803)) (51806 60927 (CDMAP 51816 . 53248) (CDENTRY 
-53250 . 53559) (CDSUBSET 53561 . 55000) (CDMERGE 55002 . 58986) (CDMERGE.COMMON 58988 . 60303) (
-CD.SORT 60305 . 60925)) (60928 68466 (BINCOMP 60938 . 65227) (EOLTYPE 65229 . 67791) (EOLTYPE.SHOW 
-67793 . 68464)) (68994 81521 (FIND-UNCOMPILED-FILES 69004 . 72647) (FIND-UNSOURCED-FILES 72649 . 75033
-) (FIND-SOURCE-FILES 75035 . 76773) (FIND-COMPILED-FILES 76775 . 78652) (FIND-UNLOADED-FILES 78654 . 
-79507) (FIND-LOADED-FILES 79509 . 79937) (FIND-MULTICOMPILED-FILES 79939 . 81519)) (81522 89953 (
-CREATED-AS 81532 . 86329) (SOURCE-FOR-COMPILED-P 86331 . 89258) (COMPILE-SOURCE-DATE-DIFF 89260 . 
-89951)) (89954 100717 (FIX-DIRECTORY-DATES 89964 . 93414) (FIX-EQUIV-DATES 93416 . 94941) (
-COPY-COMPARED-FILES 94943 . 96764) (COPY-MISSING-FILES 96766 . 98923) (COMPILED-ON-SAME-SOURCE 98925
- . 100715)) (100911 108749 (CDBROWSER 100921 . 104848) (CDBROWSER.STRINGS 104850 . 108747)) (108911 
-110647 (CD.TABLEITEM 108921 . 109141) (CD.TABLEITEM.PRINTFN 109143 . 109342) (CD.TABLEITEM.COPYFN 
-109344 . 110402) (CDTABLEBROWSER.HEADING.REPAINTFN 110404 . 110645)) (110648 133218 (
-CDTABLEBROWSER.WHENSELECTEDFN 110658 . 111126) (CD.COMMANDSELECTEDFN 111128 . 116229) (CD-MENUFN 
-116231 . 122457) (CD-COMPARE-FILES 122459 . 125811) (CDBROWSER-COPY 125813 . 129482) (
-CDBROWSER-DELETE-FILE 129484 . 132697) (CD-SWAPDIRS 132699 . 133216)))))
+  (FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) (
+COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) (
+COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179
+) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382) 
+(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) (
+CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) (
+CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY 
+53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) (
+CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW 
+68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600
+) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 . 
+80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 (
+CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 . 
+90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) (
+COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492
+ . 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518 
+111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN 
+109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 (
+CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN 
+117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) (
+CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018)))))
 STOP

lispusers/EDITFONT

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Oct-2025 14:56:00" {WMEDLEY}<lispusers>EDITFONT.;40
 26223  
+
(FILECREATED "12-Oct-2025 17:39:29" {WMEDLEY}<lispusers>EDITFONT.;41
 26261  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (RECORDS CHARITEM)
-                  (FNS EDITFONT)
+                  (FNS EF.SAVE)
 
-      :PREVIOUS-DATE " 6-Oct-2025 15:58:41" {WMEDLEY}<lispusers>EDITFONT.;39)
+      :PREVIOUS-DATE " 7-Oct-2025 14:56:00" {WMEDLEY}<lispusers>EDITFONT.;40)
 
 
 (PRETTYCOMPRINT EDITFONTCOMS)
@@ -242,7 +242,8 @@
              (T (LISPERROR "ILLEGAL ARG" BITMAP])
 
 (EF.SAVE

-  [LAMBDA (WINDOW)
                                           (* ; "Edited  2-Sep-2025 23:03 by rmk")


+  [LAMBDA (WINDOW)
                                           (* ; "Edited 12-Oct-2025 17:33 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 23:03 by rmk")


                                                              (* ; "Edited 29-Aug-2025 11:35 by rmk")


                                                              (* ; "Edited  4-Aug-2025 09:22 by rmk")


                                                              (* ; "Edited  2-Aug-2025 08:47 by rmk")

@@ -310,8 +311,7 @@
 
          (* ;; "Can this editing change the descent or ascent?")

 
-         (\SETCHARSETINFO (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR) of
 FONT)
-                CHARSET CSINFO])
+         (\SETCHARSETINFO FONT CHARSET CSINFO])
 
 (COPYFONT

   [LAMBDA (FONT)
                                             (* ; "Edited  3-Aug-2025 17:37 by rmk")

@@ -494,10 +494,10 @@
 
 (EF.INIT
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1147 16865 (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 . 16157) (
-COPYFONT 16159 . 16434) (READSTRIKEFONTFILE 16436 . 16863)) (16866 26035 (BLANKCHARSETCREATE 16876 . 
-22961) (EDITFONT 22963 . 26033)))))
+  (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)))))
 STOP

lispusers/EXAMINEDEFS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Apr-2025 23:54:50" {WMEDLEY}<lispusers>EXAMINEDEFS.;57
 16827  
+
(FILECREATED "28-Oct-2025 14:24:17" {WMEDLEY}<lispusers>EXAMINEDEFS.;60
 17313  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDITDEF)
+      :CHANGES-TO (FNS EXAMINEFILES)
 
-      :PREVIOUS-DATE "31-Mar-2025 13:53:38" {WMEDLEY}<lispusers>EXAMINEDEFS.;56)
+      :PREVIOUS-DATE "25-Oct-2025 10:24:30" {WMEDLEY}<lispusers>EXAMINEDEFS.;59)
 
 
 (PRETTYCOMPRINT EXAMINEDEFSCOMS)
@@ -20,7 +20,8 @@
 (DEFINEQ
 
 (EXAMINEDEFS

-  [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION)
   (* ; "Edited 31-Mar-2025 13:53 by rmk")


+  [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION)
   (* ; "Edited 25-Oct-2025 10:24 by rmk")


+                                                             (* ; "Edited 31-Mar-2025 13:53 by rmk")


                                                              (* ; "Edited 18-Feb-2025 22:56 by rmk")


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


                                                              (* ; "Edited 13-Oct-2023 11:11 by rmk")


@@ -148,6 +149,8 @@
                                                                           DEFAULTFONT)))
                                                  (TEXTHEIGHT 600))
                                                 (DECLARE
 (SPECVARS COMPARETEXT.ALLCHUNKS))
+                                                (SETQ TITLE1 (CONCAT NAME " from " TITLE1))
+                                                (SETQ TITLE2 (CONCAT NAME " from " TITLE2))
                                                              (* ; 
 
                                                     "Reuse an existing CT graph window for this DEF")

                                                 (OR [FIND
 W IN
 (OPENWINDOWS)
@@ -170,7 +173,8 @@
                     (EDITE DEF2])
 
 (EXAMINEFILES

-  [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION)
                 (* ; "Edited 19-Jul-2023 13:48 by rmk")


+  [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION)
                 (* ; "Edited 28-Oct-2025 14:23 by rmk")


+                                                             (* ; "Edited 19-Jul-2023 13:48 by rmk")


                                                              (* ; "Edited  1-Feb-2022 23:15 by rmk")


                                                              (* ; "Edited 25-Jan-2022 10:08 by rmk")


                                                              (* ; "Edited  2-Jan-2022 23:15 by rmk")


@@ -180,7 +184,8 @@
 
     (CL:UNLESS REGION
         (SETQ REGION (GETREGION)))
-    (LIST (AND (INFILEP FILE1)
+    (LIST (AND (OR (STREAMP FILE1)
+                   (INFILEP FILE1))
                (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
                                        REGION
                                        'RIGHT
@@ -188,7 +193,8 @@
                                        `(,REGION 0.5)
                                        (FETCH
 (REGION TOP) OF
 REGION))
                       NIL TITLE1))
-          (AND (INFILEP FILE2)
+          (AND (OR (STREAMP FILE2)
+                   (INFILEP FILE2))
                (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
                                        REGION
                                        'LEFT
@@ -281,6 +287,6 @@
 (FILESLOAD (SYSLOAD)
        COMPARETEXT VERSIONDEFS)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (662 16596 (EXAMINEDEFS 672 . 10994) (EXAMINEFILES 10996 . 12478) (TEDITDEF 12480 . 
-14802) (EXVV 14804 . 16594)))))
+  (FILEMAP (NIL (666 17082 (EXAMINEDEFS 676 . 11291) (EXAMINEFILES 11293 . 12964) (TEDITDEF 12966 . 
+15288) (EXVV 15290 . 17080)))))
 STOP

lispusers/GITFNS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Sep-2025 21:43:21" {WMEDLEY}<lispusers>GITFNS.;551
 134847 
+
(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}<lispusers>GITFNS.;569
 131593 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES)
+      :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES)
 
-      :PREVIOUS-DATE "22-Sep-2025 12:52:41" {WMEDLEY}<lispusers>GITFNS.;550)
+      :PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}<lispusers>GITFNS.;568)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -59,7 +59,7 @@
         (* ;; "File correspondents")

 
         (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
-        (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
+        (FNS TOGIT FROMGIT)
         (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
         (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
         
@@ -135,22 +135,22 @@
 (DEFINEQ
 
 (GIT-CLONEP

-  [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS)
                  (* ; "Edited  1-Oct-2023 18:09 by rmk")


+  [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS)
                  (* ; "Edited 25-Oct-2025 15:13 by rmk")


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


+                                                             (* ; "Edited  1-Oct-2023 18:09 by rmk")


                                                              (* ; "Edited 12-May-2022 11:44 by rmk")


                                                              (* ; "Edited  8-May-2022 16:24 by rmk")

 
-    (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up.")

+    (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up. Returns the full true directory name")

 
-    (IF
 [AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR
-                                                             'HOST
-                                                             'DSK]
-                           (IF
 (DIRECTORYNAMEP (CONCAT D "/.git/"))
-                               THEN
 D
-                             ELSEIF
 (AND CHECKANCESTORS (FIND-ANCESTOR-DIRECTORY

-                                                         D
-                                                         (FUNCTION (LAMBDA (A)
-                                                                     (DIRECTORYNAMEP (CONCAT A 
-                                                                                            ".git/"]
+    (IF
 (AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME HOST/DIR]
+                           (CL:WHEN [OR (DIRECTORYNAMEP (CONCAT D "/.git/"))
+                                        (SETQ D (AND CHECKANCESTORS
+                                                     (FIND-ANCESTOR-DIRECTORY
 D
+                                                            (FUNCTION (LAMBDA (A)
+                                                                        (DIRECTORYNAMEP (CONCAT
+                                                                                         A ".git/"]
+                                  D)))
       ELSEIF
 NOERROR
         THEN
 NIL
       ELSE
 (ERROR "NOT A GIT CLONE" HOST/DIR])
@@ -169,6 +169,10 @@
 
 (GIT-MAKE-PROJECT

   [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)

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


+                                                             (* ; "Edited 22-Oct-2025 12:45 by rmk")


+                                                             (* ; "Edited 20-Oct-2025 18:10 by rmk")


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


                                                              (* ; "Edited  1-Oct-2023 19:33 by rmk")


                                                              (* ; "Edited 30-Mar-2023 09:06 by rmk")


                                                              (* ; "Edited  5-Feb-2023 12:43 by rmk")


@@ -222,19 +226,14 @@
                                      (ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME))
                                      (PRINTOUT T "Note: Can't find a clone directory for " 
                                             PROJECTNAME T)))
-                      elseif
 (GIT-CLONEP
 [SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY
-                                                         (UNPACKFILENAME.STRING (TRUEFILENAME 
-                                                                                       CLONEPATH)
-                                                                'DIRECTORY
-                                                                'RETURN]
-                                    T T)
+                      elseif
 (GIT-CLONEP
 CLONEPATH T T)
                       else
 (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for " 
                                          PROJECTNAME]
     (CL:WHEN CLONEPATH
         (LET (GITIGNORE PROJECT WP)
              (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY 
                                                       CLONEPATH)))
-                 (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE)
+                 (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))
@@ -270,9 +269,10 @@
                                    then
 (UNSLASHIT WP)
                                  elseif
 WORKINGPATH
                                    then
 (ERROR (CONCAT "Can't find the working directory "
-                                                      (AND (EQ WORKINGPATH T)
-                                                           "")
-                                                      " for " PROJECTNAME]
+                                                      (CL:IF WORKINGPATH
+                                                          (CONCAT WORKINGPATH " ")
+                                                          "")
+                                                      "for " PROJECTNAME]
              (SETQ PROJECT (create
 GIT-PROJECT
                                   PROJECTNAME _ PROJECTNAME
                                   GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
@@ -720,46 +720,6 @@
                            (CONCAT GF " cannot be copied"))
                     T)
              DEST])
-
-(GIT-DELETE-FILE

-  [LAMBDA (FILE PROJECT)
                                     (* ; "Edited  8-May-2022 09:27 by rmk")


-                                                             (* ; "Edited 18-Jan-2022 23:07 by rmk")


-                                                             (* ; "Edited 19-Dec-2021 16:11 by rmk")


-                                                             (* ; "Edited 16-Dec-2021 13:00 by rmk")

-
-    (* ;; "This deletes a file in the local checkout git directory {UNIX}...  FILE has to already be a full file name, for safety.")

-
-    (* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ")

-
-    (* ;; "We could make this undoable by copying it to deleted/, but git also can restore.")

-
-    (GIT-CLONEP
 FILE NIL T)
-    (DELFILE FILE])
-
-(MYMEDLEY-DELETE-FILES

-  [LAMBDA (FILE PROJECT)
                                     (* ; "Edited 13-May-2022 10:40 by rmk")


-                                                             (* ; "Edited  8-May-2022 23:31 by rmk")

-
-    (* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file.  If we left older versions, we would really trash ourselves.")

-
-    (* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.")

-
-    (SETQ FILE (CONTRACT.PH FILE (FETCH
 WHOST OF
 PROJECT)))
-    (CL:WHEN (EQ (FILENAMEFIELD (FETCH
 WHOST OF
 PROJECT)
-                        'HOST)
-                 (FILENAMEFIELD FILE 'HOST))
-        (FOR
 F IN
 (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE)))
-           COLLECT
 
-
-                 (* ;; 
-
                 "Delete the earlier ones first, if it goes bad, you don't want them to persist")

-
-                 (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>"
-                                                                          (FILENAMEFIELD F
-                                                                                 'DIRECTORY))
-                                                 'BODY F))
-                        (ERROR "Could not delete " F))
-                 F))])
 )
 (DEFINEQ
 
@@ -828,10 +788,15 @@
 (DEFINEQ
 
 (GFILE4MFILE

-  [LAMBDA (MFILE PROJECT)
                                    (* ; "Edited  7-May-2022 23:19 by rmk")


+  [LAMBDA (MFILE PROJECT)
                                    (* ; "Edited 25-Oct-2025 09:18 by rmk")


+                                                             (* ; "Edited  7-May-2022 23:19 by rmk")


                                                              (* ; "Edited  4-Feb-2022 18:04 by rmk")

-    (SLASHIT (PACKFILENAME 'HOST (FETCH
 GITHOST OF
 PROJECT)
-                    'VERSION NIL 'BODY MFILE)
+
+    (* ;; "Switch to UNIX:  no versions")

+
+    (SLASHIT (PACKFILENAME 'HOST 'UNIX 'BODY (TRUEFILENAME (PACKFILENAME 'HOST (FETCH
 GITHOST
+                                                                                  OF
 PROJECT)
+                                                                  'VERSION NIL 'BODY MFILE)))
            T])
 
 (MFILE4GFILE

@@ -1080,6 +1045,8 @@
 (GIT-BRANCH-DIFF

   [LAMBDA (BRANCH1 BRANCH2 PROJECT)
 
+    (* ;; "Edited 21-Oct-2025 18:31 by rmk")

+
     (* ;; "Edited 10-Jun-2024 16:43 by mth")

 
     (* ;; "Edited  2-May-2024 11:28 by mth")

@@ -1145,7 +1112,7 @@
                               (GO RETRY))
                            (ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2)))
                 else
 (for
 L in
 ELINES do
 (PRINTOUT T L T))))
-          (RETURN (SORT (for
 (L FN) in
 RLINES
+          (RETURN (SORT (for
 L FN in
 RLINES
                            collect
 (SELCHARQ (CHCON1 L)
                                         (A (CL:IF (EQ (CHARCODE TAB)
                                                       (NTHCHARCODE L 2))
@@ -1156,13 +1123,14 @@
                                                (LIST 'DELETED (SETQ FN (SUBSTRING L 3)))
                                                (ERROR "DELETED NOT RECOGNIZED" L)))
                                         (M (CL:IF (SETQ POS (STRPOS "	" L))
-                                               [LIST 'CHANGED (SETQ FN (SUBSTRING L (ADD1 POS]
+                                               [LIST 'MODIFIED (SETQ FN (SUBSTRING L (ADD1 POS]
                                                (ERROR "CHANGED NOT RECOGNIZED" L)))
-                                        (C (if
 (AND (EQ (CHARCODE TAB)
+                                        (C                   (* ; 
+
                                                      "We coerce a copy to an ADD of the target file")

+                                           (if
 (AND (EQ (CHARCODE TAB)
                                                         (NTHCHARCODE L 5))
                                                     (SETQ POS (STRPOS "	" L 7)))
-                                               then
 (LIST 'COPIED (SETQ FN (SUBSTRING L 6
-                                                                                  (SUB1 POS)))
+                                               then
 (LIST 'ADDED (SETQ FN (SUBSTRING L (ADD1 POS)))
                                                           (OR (FIXP (SUBATOM L 2 4))
                                                               (HELP "C without a number" L)))
                                              else
 (HELP "COPY NOT RECOGNIZED" L)))
@@ -1431,43 +1399,31 @@
                WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
 
 (GIT-BRANCH-WHENSELECTEDFN

-  [LAMBDA (ITEM MENU BUTTON)
                                 (* ; "Edited 21-Mar-2025 19:07 by rmk")


+  [LAMBDA (ITEM MENU BUTTON)
                                 (* ; "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")


                                                              (* ; "Edited  1-May-2024 18:17 by rmk")

                                                              (* ; "CAR is git key, 4th is project")

 
-    (* ;; "This executes the comparison in the current TTY window, either by stuffing the command there or by evaluating there.  There probably should be a check to make sure that the TTY is in fact an executive--if not, maybe this should be a no-op.  Better than getting the comparison form in the middle of anther SEDIT or TEDIT.")

-
     (* ;; "This could also execute in the mouse process, where the menu is clicked.  But in that case a terminal window pops up with the header lines of the compare, and that seems a nuisance.")

 
     (LET [(PR (CAR (LAST ITEM]
-         (if
 [AND NIL (PROGN (GETMOUSESTATE)
-                             (EQ 'MIDDLE (DECODEBUTTONS]
-             then
 (LET [(POS (ADD1 (STRPOS "#" (CAR ITEM]
-                       (ShellBrowse (fetch
 PRURL of
 PR)))
-           elseif
 (PROGN T)
-             then
 
-                  (* ;; "PROGN because DWIM is screwed up")

-
-                  (* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")

-
-                  (if
 (EQ BUTTON 'MIDDLE)
-                      then
 (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/"
-                                             (fetch
 (PULLREQUEST PRNUMBER) of
 PR)))
-                    else
 (BKSYSBUF '%()
-                         [COPYINSERT `(GIT-PR-COMPARE
 ,(CADR ITEM)
-                                             ',(fetch
 PRPROJECT of
 PR]
-                         (BKSYSBUF '%)))
+         (if
 (EQ BUTTON 'MIDDLE)
+             then
 (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/" (fetch
 (PULLREQUEST
+                                                                                         PRNUMBER)
+                                                                                    of
 PR)))
            else
 
-                (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")

+                (* ;; "This prints notices in its own TTY window")

 
-                (PROCESS.EVAL (TTY.PROCESS)
-                       `(RESETLST
-                            [RESETSAVE (DSPFONT DEFAULTFONT T)
-                                   '(PROGN (DSPFONT OLDVALUE T])])
+                (ADD.PROCESS `[GIT-PR-COMPARE
 ,(CADR ITEM)
+                                     ',(fetch
 PRPROJECT of
 PR]
+                       'NAME
+                       'prc])
 
 (GIT-PULL-REQUESTS

-  [LAMBDA (INCLUDEDRAFTS PROJECT)
                            (* ; "Edited  9-May-2025 11:39 by rmk")


+  [LAMBDA (INCLUDEDRAFTS PROJECT)
                            (* ; "Edited 20-Oct-2025 10:22 by rmk")


+                                                             (* ; "Edited  9-May-2025 11:39 by rmk")


                                                              (* ; "Edited 20-May-2024 22:12 by rmk")


                                                              (* ; "Edited 13-May-2024 18:59 by rmk")


                                                              (* ; "Edited 11-May-2024 10:51 by rmk")


@@ -1495,9 +1451,11 @@
                                     PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
                                     PRSTATUS _ (CL:IF DRAFT
                                                    'D
-                                                   (CL:IF (STREQUAL "REVIEW¬REQUIRED"
-                                                                 (JSON-GET JSOBJ 'reviewDecision))
-                                                       " "
+                                                   (SELECTQ (MKATOM (JSON-GET JSOBJ 'reviewDecision))
+                                                       (CHANGES¬REQUESTED 
+                                                            'C)
+                                                       (REVIEW¬REQUIRED 
+                                                            " ")
                                                        'A))
                                     PRPROJECT _ PROJECT
                                     PRURL _ (JSON-GET JSOBJ 'url)
@@ -1733,6 +1691,8 @@
   [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT)
     (DECLARE
 (USEDFREE FROMGITN))
 
+    (* ;; "Edited 21-Oct-2025 18:30 by rmk")

+
     (* ;; "Edited 23-Sep-2025 21:42 by rmk")

 
     (* ;; "Edited 22-Sep-2025 12:48 by rmk")

@@ -1748,101 +1708,107 @@
     (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
     (SETQ BRANCH1 (GIT-BRANCH-EXISTS?
 BRANCH1 NIL PROJECT))
     (SETQ BRANCH2 (GIT-BRANCH-EXISTS?
 BRANCH2 NIL PROJECT))
-    (LET (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF
 BRANCH1 BRANCH2 PROJECT)))
-         (CL:WHEN DIFFS
-             (SETQ FROMGIT (PACK* "{FROMGIT" (add
 FROMGITN 1)
-                                  "}"))
+    (LET
+     (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF
 BRANCH1 BRANCH2 PROJECT)))
+     (CL:WHEN DIFFS
+         (SETQ FROMGIT (PACK* "{FROMGIT" (add
 FROMGITN 1)
+                              "}"))
 
-             (* ;; "If both origin/, strip it out of subdirectories")

+         (* ;; "If both origin/, strip it out of subdirectories")

 
-             (SETQ PRNAME (MTOUSTRING (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T)
-                                                  (STRPOS "origin/" BRANCH2 NIL T))
-                                          (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ ")))
-                                          BRANCH2)))
-             (PSEUDOHOST FROMGIT (CONCAT "{DSK}<tmp>" (fetch
 PROJECTNAME of
 PROJECT)
-                                        "-PR--" PRNAME "--" (DATE)
-                                        ">"))
-             (CL:UNLESS DIR1
-                 (SETQ DIR1 (CONCAT FROMGIT "<master>")))
-             (CL:UNLESS DIR2
-                 (SETQ DIR2 (CONCAT FROMGIT "<pr>")))
-             (for
 D in
 DIFFS
-                do

-                (SELECTQ (CAR D)
-                    (ADDED                                   (* ; 
+         (SETQ PRNAME (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T)
+                                  (STRPOS "origin/" BRANCH2 NIL T))
+                          (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ ")))
+                          BRANCH2))
+         (PSEUDOHOST FROMGIT (CONCAT "{DSK}<tmp>" (fetch
 PROJECTNAME of
 PROJECT)
+                                    "-PR--" PRNAME "--" (DATE)
+                                    ">"))
+         (CL:UNLESS DIR1
+             (SETQ DIR1 (CONCAT FROMGIT "<master>")))
+         (CL:UNLESS DIR2
+             (SETQ DIR2 (CONCAT FROMGIT "<pr>")))
+         (for
 D in
 DIFFS
+            do
 (SELECTQ (CAR D)
+                   (ADDED                                    (* ; 
 
     "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?")

-                           (SETQ D (CADR D))
-                           (OR (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
-                                      T PROJECT)
-                               (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
-                                      T PROJECT)))
-                    (DELETED 
-                             (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2.  But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted.  Try for both, but don't cause an error.")

+                          (SETQ D (CADR D))
+                          (OR (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
+                                     T PROJECT)
+                              (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
+                                     T PROJECT)))
+                   (DELETED 
+                            (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2.  But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted.  Try for both, but don't cause an error.")

 
-                             (SETQ D (CADR D))
-                             (OR (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
-                                        T PROJECT)
-                                 (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
-                                        T PROJECT)))
-                    (CHANGED                                 (* ; "Should exist in both branches")

+                            (SETQ D (CADR D))
+                            (OR (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
+                                       T PROJECT)
+                                (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
+                                       T PROJECT)))
+                   (MODIFIED                                 (* ; "Should exist in both branches")

                              (SETQ D (CADR D))
                              (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
                                     T PROJECT)
                              (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
                                     T PROJECT))
-                    ((RENAMED COPIED) 
+                   ((RENAMED COPIED) 
 
                                  (* ;; "These entries are from-to filename pairs.  If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in BRANCH2 and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up.  ")

 
-                         
-                         (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes:  put both files in the fromgit directory.  Perhaps the mapping should still figure out how to relate them.")

+                        
+                        (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes:  put both files in the fromgit directory.  Perhaps the mapping should still figure out how to relate them.")

 
-                         (* ;; "For copied files, presumably 2 files are exactly the same.  But we hope we can show them on the same line, by virtue of the mapping.")

+                        (* ;; "For copied files, presumably 2 files are exactly the same.  But we hope we can show them on the same line, by virtue of the mapping.")

 
-                         [LET ((GFILE (CDR D))
-                               F1 F2)
+                        (* ;; 
+
             "GIT %"copy%" to a target file is coerced to ADDED of that target; the source is ignore")

 
-                          (* ;; "GFILE is a triple (F2 F1 N )")

+                        (LET ((GFILE (CDR D))
+                              F1 F2)
 
-                          (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")

+                             (* ;; "GFILE is a triple (F2 F1 N )")

 
-                              (SETQ F1 (GIT-GET-FILE
 BRANCH1 (CADR GFILE)
-                                              (CONCAT DIR1 (CADR GFILE))
-                                              T PROJECT))
-                              (SETQ F2 (GIT-GET-FILE
 BRANCH2 (CADR GFILE)
-                                              (CONCAT DIR2 (CADR GFILE))
-                                              T PROJECT))
+                             (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")

 
-                          (* ;; "Let the directories figure it out")

+                             (SETQ F1 (GIT-GET-FILE
 BRANCH1 (CADR GFILE)
+                                             (CONCAT DIR1 (CADR GFILE))
+                                             T PROJECT))
+                             (SETQ F2 (GIT-GET-FILE
 BRANCH2 (CADR GFILE)
+                                             (CONCAT DIR2 (CADR GFILE))
+                                             T PROJECT))
 
-                              (AND NIL (if
 (EQ (CADDR GFILE)
-                                               100)
-                                           then
 
+                             (* ;; "Let the directories figure it out")

+
+                             (AND NIL (if
 (EQ (CADDR GFILE)
+                                              100)
+                                          then
 
 
                                  (* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to.  Maybe the first one should always be one that exists, the second may just be a useful name.  But we have to know whether to match against INFO1 or INFO2")

 
-                                                (HELP GFILE 100)
-                                                (push
 MAPPINGS
-                                                      (LIST (LIST)
-                                                            (FULLNAME F1)
-                                                            (SLASHIT (U-CASE (CONCAT DIR2
-                                                                                    (CAR GFILE)))
-                                                                   T)
-                                                            (NTHCHAR (CAR D)
-                                                                   1)
-                                                            100))
-                                         else
 
-                                              (* ;; 
+                                               (HELP GFILE 100)
+                                               (push
 MAPPINGS
+                                                     (LIST (LIST)
+                                                           (FULLNAME F1)
+                                                           (SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE))
+                                                                           )
+                                                                  T)
+                                                           (NTHCHAR (CAR D)
+                                                                  1)
+                                                           100))
+                                        else
 
+                                             (* ;; 
 
                                    "If not a perfect match, then the directory should figure it out")

 
-                                              (GIT-GET-FILE
 BRANCH2 (CAR GFILE)
-                                                     (CONCAT DIR2 (CAR GFILE))
-                                                     T PROJECT])
-                    (HELP "UNKNOWN GIT-DIFF TAG" D)))
-             (LIST DIR1 DIR2 MAPPINGS))])
+                                             (GIT-GET-FILE
 BRANCH2 (CAR GFILE)
+                                                    (CONCAT DIR2 (CAR GFILE))
+                                                    T PROJECT)))
+                             F2))
+                   (HELP "UNKNOWN GIT-DIFF TAG" D)))
+         (LIST DIR1 DIR2 MAPPINGS))])
 
 (GIT-BRANCHES-COMPARE-DIRECTORIES

-  [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT)
                    (* ; "Edited 12-Jun-2024 22:52 by mth")


+  [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT)
                    (* ; "Edited 28-Oct-2025 14:01 by rmk")


+                                                             (* ; "Edited  2-Oct-2025 23:12 by rmk")


+                                                             (* ; "Edited 12-Jun-2024 22:52 by mth")


                                                              (* ; "Edited 10-Jun-2024 18:42 by mth")


                                                              (* ; "Edited  1-May-2024 14:58 by rmk")


                                                              (* ; "Edited 26-Sep-2023 22:40 by rmk")


@@ -1860,8 +1826,10 @@
                 (SHORT2 (GIT-SHORT-BRANCH-NAME
 BRANCH2)))
          (PRINTOUT T "Comparing all " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                              T)
-                " subdirectories of " SHORT1 " and " SHORT2 T)
-         (PRINTOUT T "Fetching differences" T)
+                " subdirectories of" T)
+         (PRINTOUT T 5 .FONT BOLDFONT SHORT1 .FONT DEFAULTFONT " and " .FONT BOLDFONT SHORT2 .FONT 
+                DEFAULTFONT T)
+         (PRINTOUT T "Fetching differences")
          (SETQ DIRS (GIT-GET-DIFFERENT-FILES
 BRANCH1 BRANCH2 NIL NIL PROJECT))
          (SETQ MAPPINGS (CADDR DIRS))
          (if
 DIRS
@@ -1874,10 +1842,10 @@
                                        '(> < ~= -* *-)
                                        '(*.* *>*.* .* *>.*)
                                        (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS)
-                                       NIL NIL NIL NIL (LIST (PACKFILENAME 'HOST NIL 'BODY
-                                                                    (CAR DIRS))
-                                                             (PACKFILENAME 'HOST NIL 'BODY
-                                                                    (CADR DIRS] 
+                                       NIL NIL NIL NIL (LIST (FILENAMEFIELD (CAR DIRS)
+                                                                    'DIRECTORY)
+                                                             (FILENAMEFIELD (CADR DIRS)
+                                                                    'DIRECTORY] 
 
                   (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.")

 
@@ -1931,8 +1899,10 @@
                                                      (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE))
                                                      " files")
                                   (LIST SHORT1 SHORT2)
-                                  `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
-                                          ,PROJECT)
+                                  `((LABELFN . GIT-CD-LABELFN)
+                                    (BRANCH1 ,@BRANCH1)
+                                    (BRANCH2 ,@BRANCH2)
+                                    (PROJECT ,@PROJECT))
                                   GIT-CDBROWSER-SEPARATE-DIRECTIONS
                                   `(Compare See))
                            (SETQ NENTRIES (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE)))
@@ -1942,100 +1912,108 @@
                     else
 '(0 differences))
            else
 '(0 differences])
 
-(GIT-WORKING-COMPARE-DIRECTORIES
+(GIT-WORKING-COMPARE-DIRECTORIES

   [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
 
-    (* ;; "Edited 29-Apr-2025 15:14 by rmk")
+    (* ;; "Edited 28-Oct-2025 14:00 by rmk")

 
-    (* ;; "Edited 12-Jun-2024 22:52 by mth")
+    (* ;; "Edited 25-Oct-2025 23:32 by rmk")

 
-    (* ;; "Edited 26-Sep-2023 22:41 by rmk")
+    (* ;; "Edited 29-Apr-2025 15:14 by rmk")

 
-    (* ;; "Edited 17-Jun-2023 22:54 by rmk")
+    (* ;; "Edited 12-Jun-2024 22:52 by mth")

 
-    (* ;; "Edited 10-Jun-2023 21:32 by rmk")
+    (* ;; "Edited 26-Sep-2023 22:41 by rmk")

 
-    (* ;; "Edited 20-Jul-2022 21:18 by rmk")
+    (* ;; "Edited 17-Jun-2023 22:54 by rmk")

 
-    (* ;; "Edited 25-Jun-2022 21:37 by rmk")
+    (* ;; "Edited 10-Jun-2023 21:32 by rmk")

 
-    (* ;; "Edited 17-May-2022 17:39 by rmk")
+    (* ;; "Edited 20-Jul-2022 21:18 by rmk")

 
-    (* ;; "Edited 10-May-2022 10:41 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.")
+
  "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")

 
-    (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
-    (CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT))         (* ; "Doesn't matter if we are looking only at local files in the current branch.  We aren't fetching or checking out.")
-    (CL:UNLESS (
AND (fetch GITHOST of PROJECT)
-                    (fetch WHOST of PROJECT))
-        (
ERROR (fetch PROJECTNAME of PROJECT)
+    (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
+    (CL:WHEN UPDATE (GIT-REMOTE-UPDATE
 NIL PROJECT))         (* ; "Doesn't matter if we are looking only at local files in the current branch.  We aren't fetching or checking out.")

+    (CL:UNLESS (AND (fetch
 GITHOST of
 PROJECT)
+                    (fetch
 WHOST of
 PROJECT))
+        (ERROR (fetch
 PROJECTNAME of
 PROJECT)
                " does not have both git and working directories"))
-    (CL:WHEN (
AND (
LISTP SUBDIRS)
-                  (
NULL (
CDR SUBDIRS)))
-        (
SETQ SUBDIRS (
CAR SUBDIRS)))
+    (CL:WHEN (AND (LISTP SUBDIRS)
+                  (NULL (CDR SUBDIRS)))
+        (SETQ SUBDIRS (CAR SUBDIRS)))
     (CL:UNLESS SUBDIRS
-        (
SETQ SUBDIRS (
OR (fetch DEFAULTSUBDIRS of PROJECT)
+        (SETQ SUBDIRS (OR (fetch
 DEFAULTSUBDIRS of
 PROJECT)
                           'ALL)))
-    (
SETQ SUBDIRS (
L-CASE SUBDIRS))
-    (
LET ((SUBDIRSTRING (if (
EQ SUBDIRS 'all)
-                            then (
SETQ SUBDIRS (ALLSUBDIRS PROJECT))
+    (SETQ SUBDIRS (L-CASE SUBDIRS))
+    (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)))
+         (for
 SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch
 PROJECTNAME of
 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)
-                                     (GITSUBDIR SUBDIR T PROJECT)
-                                     (
OR SELECT '(
> < ~= -* *-))
+              (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)
+                                     (GITSUBDIR
 SUBDIR T PROJECT)
+                                     (OR SELECT '(> < ~= -* *-))
                                      '(*.* *>*.* .* *>.*)
-                                     (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
-                                        collect (
SETQ DPOS (
STRPOS SUBDIR (
FILENAMEFIELD E
+                                     (for
 E DPOS in
 (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS)
+                                        collect
 (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
                                                                                  'DIRECTORY)
                                                                   1 NIL T T FILEDIRCASEARRAY))
                                               (CL:IF DPOS
-                                                  (
SUBSTRING E (
ADD1 DPOS))
+                                                  (SUBSTRING E (ADD1 DPOS))
                                                   E))
                                      NIL NIL NIL FIXDIRECTORYDATES))
-                  [for CDE in (fetch CDENTRIES of CDVAL)
-                     do (CL:WHEN (fetch INFO1 of CDE)
-                            (change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE))
-                                   (
UNSLASHIT DATUM T)))
-                        (CL:WHEN (fetch INFO2 of CDE)
-                            (change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE))
-                                   (
SLASHIT DATUM T)))]
+                  [for
 CDE in
 (fetch
 CDENTRIES of
 CDVAL)
+                     do
 (CL:WHEN (fetch
 INFO1 of
 CDE)
+                            (change
 (fetch
 (CDINFO FULLNAME) of
 (fetch
 INFO1 of
 CDE))
+                                   (UNSLASHIT DATUM T)))
+                        (CL:WHEN (fetch
 INFO2 of
 CDE)
+                            (change
 (fetch
 (CDINFO FULLNAME) of
 (fetch
 INFO2 of
 CDE))
+                                   (SLASHIT DATUM T)))]
                   CDVAL
-            finally 
+            finally
 
 
-                  (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")
+                  (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")

 
-                  (CL:WHEN (
AND (
CDR $$VAL)
+                  (CL:WHEN (AND (CDR $$VAL)
                                 GIT-MERGE-COMPARES)
-                      (
SETQ $$VAL (
CDMERGE $$VAL))
-                      [
SETQ SUBDIRS (
CONCATLIST (for SUBDIR in SUBDIRS collect (
CONCAT SUBDIR "  "])
-                  [for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS
-                     do (
SETQ TITLE (
CONCAT WPROJ "  vs.   " BRANCH2 "      " SUBDIR "         "
-                                           (
LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
+                      (SETQ $$VAL (CDMERGE $$VAL))
+                      [SETQ SUBDIRS (CONCATLIST (for
 SUBDIR in
 SUBDIRS collect
 (CONCAT SUBDIR "  "])
+                  [for
 CDVAL TITLE in
 $$VAL as
 SUBDIR inside
 SUBDIRS
+                     do
 (SETQ TITLE (CONCAT WPROJ "  vs.   " BRANCH2 "      " SUBDIR "         "
+                                           (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVAL))
                                            " files"))
-                        [
CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
-                               `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN 
-                                       GIT-CD-LABELFN PROJECT ,PROJECT)
+                        [CDBROWSER CDVAL TITLE `(,WPROJ ,@BRANCH2)
+                               `((BRANCH1 ,@WPROJ)
+                                 (BRANCH2 ,@BRANCH2)
+                                 (SUBDIR ,@SUBDIR)
+                                 (LABELFN . GIT-CD-LABELFN)
+                                 (PROJECT ,@PROJECT))
                                GIT-CDBROWSER-SEPARATE-DIRECTIONS
                                `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
-                                       ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
-                                             '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
-                        (
CONS (
CONCAT SUBDIR "/")
-                              (for CDENTRY in (fetch CDENTRIES of CDVAL)
-                                 collect (fetch MATCHNAME of CDENTRY)))
-                        (add NENTRIES (
LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL]
-                  (
SETQ LAST-WMEDLEY-CDVALUES $$VAL)
-                  (
TERPRI T)
-                  (
RETURN (
LIST NENTRIES (CL:IF (
EQ NENTRIES 1)
+                                       ,@(CL:UNLESS (GIT-MAINBRANCH?
 BRANCH2 PROJECT T)
+                                             '("" (Copy% -> GIT-CD-MENUFN NIL T)
+                                                  (Delete% -> GIT-CD-MENUFN)))]
+                        (CONS (CONCAT SUBDIR "/")
+                              (for
 CDENTRY in
 (fetch
 CDENTRIES of
 CDVAL)
+                                 collect
 (fetch
 MATCHNAME of
 CDENTRY)))
+                        (add
 NENTRIES (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVAL]
+                  (SETQ LAST-WMEDLEY-CDVALUES $$VAL)
+                  (TERPRI T)
+                  (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
                                              'difference
                                              'differences)])
 
@@ -2203,42 +2181,19 @@
                (OR LABEL2 FILE2])
 
 (GIT-CD-MENUFN

-  [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
                    (* ; "Edited 21-Sep-2022 21:34 by rmk")


+  [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
                    (* ; "Edited 28-Oct-2025 11:50 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")


                                                              (* ; "Edited  8-May-2022 09:26 by rmk")


                                                              (* ; "Edited 10-Dec-2021 08:52 by rmk")

 
     (* ;; "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))
+    (DECLARE
 (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW))
     (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 " ? "]
-                        (GIT-DELETE-FILE
 FILE2 (LISTGET USERDATA 'PROJECT))
-                        (TB.DELETE.ITEM CDBROWSER TBITEM)))
-        (|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)
-                                                                 " ? "]
-                          (MYMEDLEY-DELETE-FILES
 FILE1 (LISTGET USERDATA 'PROJECT))
-                          (TB.DELETE.ITEM CDBROWSER TBITEM))
-               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)
-                                                             " ? ")))
-                          (GIT-DELETE-FILE
 FILE2 (LISTGET USERDATA 'PROJECT))
-                          (MYMEDLEY-DELETE-FILES
 FILE1 (LISTGET USERDATA 'PROJECT))
-                          (TB.DELETE.ITEM CDBROWSER TBITEM)))
+        (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
         (SHOULDNT])
 
 (GIT-WORKING-COMPARE-FILES

@@ -2439,33 +2394,32 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4193 20772 (GIT-CLONEP 4203 . 5531) (GIT-INIT 5533 . 6163) (GIT-MAKE-PROJECT 6165 . 
-13830) (GIT-GET-PROJECT 13832 . 15757) (GIT-PUT-PROJECT-FIELD 15759 . 17400) (GIT-PROJECT-PATH 17402
- . 18446) (FIND-ANCESTOR-DIRECTORY 18448 . 18797) (GIT-FIND-CLONE 18799 . 19880) (GIT-MAINBRANCH 19882
- . 20277) (GIT-MAINBRANCH? 20279 . 20770)) (26235 31164 (PRC-COMMAND 26245 . 31162)) (31220 34008 (
-ALLSUBDIRS 31230 . 32516) (MEDLEYSUBDIRS 32518 . 33211) (GITSUBDIRS 33213 . 34006)) (34009 38799 (
-TOGIT 34019 . 35425) (FROMGIT 35427 . 36408) (GIT-DELETE-FILE 36410 . 37256) (MYMEDLEY-DELETE-FILES 
-37258 . 38797)) (38800 41803 (MYMEDLEYSUBDIR 38810 . 39266) (GITSUBDIR 39268 . 39711) (STRIPDIR 39713
- . 40084) (STRIPHOST 40086 . 40326) (STRIPNAME 40328 . 41081) (STRIPWHERE 41083 . 41801)) (41804 43706
- (GFILE4MFILE 41814 . 42177) (MFILE4GFILE 42179 . 42748) (GIT-REPO-FILENAME 42750 . 43704)) (43755 
-54010 (GIT-COMMIT 43765 . 44591) (GIT-PUSH 44593 . 45353) (GIT-PULL 45355 . 46107) (GIT-APPROVAL 46109
- . 46458) (GIT-GET-FILE 46460 . 48375) (GIT-FILE-EXISTS? 48377 . 48651) (GIT-REMOTE-UPDATE 48653 . 
-49488) (GIT-REMOTE-ADD 49490 . 49797) (GIT-FILE-DATE 49799 . 50846) (GIT-FILE-HISTORY 50848 . 52782) (
-GIT-PRINT-FILE-HISTORY 52784 . 53834) (GIT-FETCH 53836 . 54008)) (54040 65378 (GIT-BRANCH-DIFF 54050
- . 60797) (GIT-COMMIT-DIFFS 60799 . 61690) (GIT-BRANCH-RELATIONS 61692 . 65376)) (65423 84918 (
-GIT-BRANCH-NUM 65433 . 66006) (GIT-CHECKOUT 66008 . 67294) (GIT-WHICH-BRANCH 67296 . 67703) (
-GIT-MAKE-BRANCH 67705 . 70284) (GIT-BRANCHES 70286 . 72881) (GIT-BRANCH-EXISTS? 72883 . 73754) (
-GIT-PICK-BRANCH 73756 . 74246) (GIT-BRANCH-MENU 74248 . 75129) (GIT-BRANCH-WHENSELECTEDFN 75131 . 
-77670) (GIT-PULL-REQUESTS 77672 . 81299) (GIT-SHORT-BRANCH-NAME 81301 . 81592) (GIT-LONG-NAME 81594 . 
-81911) (GIT-PRC-BRANCHES 81913 . 84916)) (84948 88396 (GIT-MY-CURRENT-BRANCH 84958 . 85328) (
-GIT-MY-BRANCHP 85330 . 85948) (GIT-MY-NEXT-BRANCH 85950 . 86444) (GIT-MY-BRANCHES 86446 . 88394)) (
-88442 92517 (GIT-ADD-WORKTREE 88452 . 90059) (GIT-REMOVE-WORKTREE 90061 . 90991) (GIT-LIST-WORKTREES 
-90993 . 91797) (WORKTREEDIR 91799 . 92515)) (92565 126387 (GIT-GET-DIFFERENT-FILES 92575 . 99428) (
-GIT-BRANCHES-COMPARE-DIRECTORIES 99430 . 106661) (GIT-WORKING-COMPARE-DIRECTORIES 106663 . 112370) (
-GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120842) (GIT-CD-LABELFN 120844 . 
-121926) (GIT-CD-MENUFN 121928 . 124368) (GIT-WORKING-COMPARE-FILES 124370 . 124990) (
-GIT-BRANCHES-COMPARE-FILES 124992 . 126156) (GIT-PR-COMPARE 126158 . 126385)) (126457 134780 (CDGITDIR
- 126467 . 127154) (GIT-COMMAND 127156 . 128714) (GITORIGIN 128716 . 129413) (GIT-INITIALS 129415 . 
-129719) (GIT-COMMAND-TO-FILE 129721 . 133206) (GIT-RESULT-TO-LINES 133208 . 134113) (STRIPLOCAL 134115
- . 134778)))))
+  (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)))))
 STOP

lispusers/KINETIC

@@ -1,16 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Sep-2022 08:19:41" {DSK}<home>larry>medley>lispusers>KINETIC.;2
 1928   
+
(FILECREATED " 1-Nov-2025 20:26:43" {DSK}<home>frank>il>medley>lispusers>KINETIC.;5
 2264   
+
+      :EDIT-BY "FGH"
 
       :CHANGES-TO (FNS KINETIC)
 
-      :PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}<home>larry>medley>lispusers>KINETIC.;1)
+      :PREVIOUS-DATE "23-Sep-2022 08:19:41" {DSK}<home>frank>il>medley>lispusers>KINETIC.;1)
 
 
-(* ; "
-Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
-")
-
 (PRETTYCOMPRINT KINETICCOMS)
 
 (RPAQQ KINETICCOMS
 ((FNS KINETIC)
@@ -20,26 +18,31 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
 (DEFINEQ
 
 (KINETIC

-  [LAMBDA (WINDOW)
                                           (* ; "Edited 22-Sep-2022 22:07 by lmm")

+  [LAMBDA (WINDOW)
                                           (* ; "Edited  1-Nov-2025 20:23 by FGH")


+                                                             (* ; "Edited 22-Sep-2022 22:07 by lmm")

                                                              (* lmm " 3-Dec-85 14:16")

-                                                             (* test example (KINETICDEMO)
-
                                                             (SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))

     [OR (WINDOWP WINDOW)
         (SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
+    [OR (WINDOWPROP WINDOW 'CLOSEFN)
+        (WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
+                                                (WINDOWPROP W 'CLOSE T]
+    [WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
+                                            (WINDOWPROP W 'CLOSE T]
     (PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
            (HT (WINDOWPROP WINDOW 'HEIGHT))
            X Y)
-          (do
 (SETQ X (RAND 0 WD))
-              (SETQ Y (RAND 0 HT))
-              (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
-                     (RAND 0 (IDIFFERENCE HT Y))
-                     X Y 'TEXTURE (SELECTQ (RAND 0 5)
-                                      (0 'PAINT)
-                                      'INVERT)
-                     (SELECTQ (AND CHECKSHADE (RAND 0 12))
-                         (0 CHECKSHADE)
-                         BLACKSHADE))
-              (BLOCK 100])
+          (while
 (NEQ (WINDOWPROP WINDOW 'CLOSE)
+                      T) do
 (SETQ X (RAND 0 WD))
+                            (SETQ Y (RAND 0 HT))
+                            (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
+                                   (RAND 0 (IDIFFERENCE HT Y))
+                                   X Y 'TEXTURE (SELECTQ (RAND 0 5)
+                                                    (0 'PAINT)
+                                                    'INVERT)
+                                   (SELECTQ (AND CHECKSHADE (RAND 0 12))
+                                       (0 CHECKSHADE)
+                                       BLACKSHADE))
+                            (BLOCK 100) finally
 (WINDOWPROP WINDOW 'CLOSE NIL])
 )
 
 (RPAQQ CHECKSHADE
 63903)
@@ -47,7 +50,6 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
 (RPAQQ KINETICWINDOW
 NIL)
 
 (ADDTOVAR IDLE.FUNCTIONS
 (Kinetic 'KINETIC))
-(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (573 1723 (KINETIC 583 . 1721)))))
+  (FILEMAP (NIL (534 2130 (KINETIC 544 . 2128)))))
 STOP

lispusers/READ-BDF

@@ -1,17 +1,19 @@
 (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" 
-"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT \AVGCHARWIDTH \FGETWIDTH \FONTFACE \FONTFILENAME 
-\FSETOFFSET \FSETWIDTH \FONTSYMBOL \GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE 
-BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP 
-FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) 
-READTABLE "XCL" BASE 10)
+"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" 
+"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" 
+"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" 
+"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10)
 
-
(IL:FILECREATED "30-Apr-2025 13:20:10" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;61|
 47500  
+
(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;13|
 49101  
 
       :EDIT-BY "mth"
 
-      :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME)
+      :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH 
+                         WRITE-BDF-TO-DISPLAYFONT-FILES)
+                  (FILE-ENVIRONMENTS "READ-BDF")
+                  (IL:VARS IL:READ-BDFCOMS)
 
-      :PREVIOUS-DATE "25-Apr-2025 10:10:08" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;60|
+      :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;9|
 )
 
 
@@ -23,8 +25,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
            (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME 
                   GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING 
                   READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES)
-           (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP)
-                                                            IL:FONT))
+           (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD)
+                                                            IL:SYSEDIT)
+                  (IL:FILES (IL:LOADCOMP)
+                         IL:FONT))
            (FILE-ENVIRONMENTS "READ-BDF")
            (IL:PROP (IL:DATABASE)
                   IL:READ-BDF)))
@@ -40,10 +44,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
    (SLUG NIL :TYPE GLYPH))
 
 (DEFSTRUCT GLYPH

-   "This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO"
+   "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO"
    (NAME NIL :TYPE STRING)
    ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP
-   (XCODE 0 :TYPE INTEGER)
+   (MCODE 0 :TYPE INTEGER)
    (WIDTH 0 :TYPE INTEGER)
    (ASCENT 0 :TYPE INTEGER)
    (DESCENT 0 :TYPE INTEGER))
@@ -55,6 +59,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 (DEFCONSTANT NOMAPPINGCHARSET
 (1+ MAXCHARSET))
 
 (DEFUN BDF-TO-CHARSETINFO
 (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE)

+                                                      (IL:* IL:\; "Edited  6-Nov-2025 17:30 by mth")


                                                       (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")


                                                       (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth")


                                                       (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth")

@@ -98,7 +103,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                     ((INTEGERP SLUG-OR-WIDTH)
                      (SETQ SLUGWIDTH SLUG-OR-WIDTH))
                     (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH)))
-                 (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL))
+                 (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL))
                                                                             (GL (CDR XGL))
                                                                             (GWIDTH (GLYPH-WIDTH
                                                                                      GL))
@@ -112,13 +117,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 
                                                                           
 
                                                              "Is the above statement actually true?")

 
-                                                                           (SETF (GLYPH-XCODE GL)
-                                                                                 XCODE)
+                                                                           (SETF (GLYPH-MCODE GL)
+                                                                                 MCODE)
                                                                            (SETQ FIRSTCHAR
-                                                                                 (MIN FIRSTCHAR XCODE
+                                                                                 (MIN FIRSTCHAR MCODE
                                                                                       ))
                                                                            (SETQ LASTCHAR
-                                                                                 (MAX LASTCHAR XCODE)
+                                                                                 (MAX LASTCHAR MCODE)
                                                                                  )
                                                                            (INCF TOTAL-WIDTH GWIDTH)
                                                                            (SETQ ASCENT
@@ -133,13 +138,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                  (IL:* IL:|;;| 
 
               "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)")

 
-                 (IL:|for|
 I IL:|from|
 0 IL:|to|
 (+ MAXTHINCHAR 2) IL:|do|
 (\\FSETOFFSET OFFSETS I 
+                 (IL:|for|
 I IL:|from|
 0 IL:|to|
 (+ MAXTHINCHAR 2) IL:|do|
 (IL:\\FSETOFFSET OFFSETS I
                                                                                   TOTAL-WIDTH))
                  (SETQ WIDTHS (IL:|fetch|
 (CHARSETINFO IL:WIDTHS) IL:|of|
 CSINFO))
 
                  (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH")

 
-                 (IL:|for|
 I IL:|from|
 0 IL:|to|
 (+ MAXTHINCHAR 2) IL:|do|
 (\\FSETWIDTH WIDTHS I 
+                 (IL:|for|
 I IL:|from|
 0 IL:|to|
 (+ MAXTHINCHAR 2) IL:|do|
 (IL:\\FSETWIDTH WIDTHS I 
                                                                                   SLUGWIDTH))
                  (IL:|replace|
 (CHARSETINFO IL:IMAGEWIDTHS) IL:|of|
 CSINFO IL:|with|
 WIDTHS)
 
@@ -151,19 +156,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                  (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH)
                                    HEIGHT 1))
                  (IL:|replace|
 (CHARSETINFO IL:CHARSETBITMAP) IL:|of|
 CSINFO IL:|with|
 BMAP)
-                 (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GLBM
+                 (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM
                                                                                        (GLYPH-BITMAP
                                                                                         GL))
                        (SETQ GLW (GLYPH-WIDTH GL))
-                       (SETQ XCODE (GLYPH-XCODE GL))
+                       (SETQ MCODE (GLYPH-MCODE GL))
                        (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL)))
                               (+ DESCENT (GLYPH-BBYOFF0 GL))
                               (BITMAPWIDTH GLBM)
                               (BITMAPHEIGHT GLBM)
                               'INPUT
                               'IL:REPLACE)
-                       (\\FSETOFFSET OFFSETS XCODE DLEFT)
-                       (\\FSETOFFSET WIDTHS XCODE GLW)
+                       (IL:\\FSETOFFSET OFFSETS MCODE DLEFT)
+                       (IL:\\FSETOFFSET WIDTHS MCODE GLW)
                        (INCF DLEFT GLW))
 
                  (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)")

@@ -185,6 +190,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 
 (DEFUN BDF-TO-FONTDESCRIPTOR
 (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL 
                                     MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)

+                                                      (IL:* IL:\; "Edited  5-Nov-2025 16:09 by mth")


                                                       (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")


                                                       (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth")

    (WHEN (AND (BDF-FONT-P BDFONT)
@@ -200,18 +206,22 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                  (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))
                                  MAP-UNKNOWN-TO-PRIVATE)))
               (WHEN (LISTP FAMILY)
-                  (RETURN (BDF-TO-FONTDESCRIPTOR
 BDFONT (FIRST FAMILY)
-                                 (OR (SECOND FAMILY)
+
+                  (IL:* IL:|;;| "Assume this is a FONTSPEC")

+
+                  (RETURN (BDF-TO-FONTDESCRIPTOR
 BDFONT (IL:|fetch|
 (IL:FONTSPEC IL:FSFAMILY)
+                                                           IL:|of|
 FAMILY)
+                                 (OR (IL:|fetch|
 (IL:FONTSPEC IL:FSSIZE) IL:|of|
 FAMILY)
                                      SIZE)
-                                 (OR (THIRD FAMILY)
+                                 (OR (IL:|fetch|
 (IL:FONTSPEC IL:FSFACE) IL:|of|
 FAMILY)
                                      FACE "MRR")
-                                 (OR (FOURTH FAMILY)
+                                 (OR (IL:|fetch|
 (IL:FONTSPEC IL:FSROTATION) IL:|of|
 FAMILY)
                                      ROTATION 0)
-                                 (OR (FIFTH FAMILY)
+                                 (OR (IL:|fetch|
 (IL:FONTSPEC IL:FSDEVICE) IL:|of|
 FAMILY)
                                      DEVICE
                                      'DISPLAY)
                                  MAP-UNKNOWN-TO-PRIVATE)))
-              (SETQ FAMILY (\\FONTSYMBOL FAMILY))
+              (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY))
               (UNLESS (AND (INTEGERP SIZE)
                            (PLUSP SIZE))
                      (ERROR "Invalid SIZE: ~S~%" SIZE))
@@ -236,7 +246,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                             (INTERN (STRING-UPCASE DEVICE)
                                    "IL"))
                            (T (IL:\\ILLEGAL.ARG DEVICE))))
-              (SETQ FACE (\\FONTFACE FACE NIL DEV))
+              (SETQ FACE (IL:\\FONTFACE FACE NIL DEV))
               (SETQ GBCSL (GLYPHS-BY-CHARSET
 BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING))
               (UNLESS SLUGWIDTH
 
@@ -268,15 +278,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                                       GBCS CSET (OR SLUG (1+ 
                                                                                             SLUGWIDTH
                                                                                              ))))
-                                                        (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET)
+                                                        (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET
+                                                               )
                                                         (LIST CSET)))))
                            (LIST FONTDESC CHARSETS))))
                     (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL)
                                                        FAMILY)
                                                 (GBCS-TO-FONTDESC (SECOND GBCSL)
-                                                       (\\FONTSYMBOL (CONCATENATE 'STRING
-                                                                            (SYMBOL-NAME FAMILY)
-                                                                            "-UNMAPPED")))
+                                                       (IL:\\FONTSYMBOL (CONCATENATE 'STRING
+                                                                               (SYMBOL-NAME FAMILY)
+                                                                               "-UNMAPPED")))
                                                 (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL)
                                                              :TEST
                                                              #'EQL)))))))))
@@ -311,8 +322,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                          '((#\R . REGULAR)
                                                            (#\N . REGULAR)
                                                            (#\B . BOLD)
-                                                           (#\S . CONDENSED)
-                                                           (#\C . CONDENSED)))))
+                                                           (#\S . COMPRESSED)
+                                                           (#\C . COMPRESSED)))))
                               'REGULAR))                     (IL:* IL:\; 
 
                                                 "S is for \"SemiCondensed\", Assuming \"Condensed\"")

 
@@ -336,17 +347,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                     (FIRST (BF-SIZE BDFONT))))))
 
 (DEFUN GLYPHS-BY-CHARSET
 (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)

+                                                      (IL:* IL:\; "Edited  6-Nov-2025 18:11 by mth")


+                                                      (IL:* IL:\; "Edited  5-Nov-2025 16:18 by mth")


                                                       (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth")


                                                       (IL:* IL:\; "Edited  9-Jan-2025 11:23 by mth")

    (LET* ((NCSETS (+ MAXCHARSET 2))
           (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))
-          (UTOXFN (COND
+          (UTOMFN (COND
                      (RAW-UNICODE-MAPPING #'IDENTITY)
-                     (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE)
-                     (T #'UTOXCODE?)))
+                     (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE)
+                     (T #'UTOMCODE?)))
           (SLUG (BF-SLUG FONT))
           (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG)))
-          NOMAPPINGCSETS ENC XCODE XCS)
+          NOMAPPINGCSETS ENC MCODE MCS)
          (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
              (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT
                                                                              (CONS NIL)))))
@@ -358,7 +371,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                      :UNLESS
                      (EQ GL SLUG)
                      :DO
-                     (SETQ XCS NIL)
+                     (SETQ MCS NIL)
                      (SETQ ENC (GLYPH-ENCODING GL))
                      (WHEN (LISTP ENC)
 
@@ -372,9 +385,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 
    "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it")

 
                          )
-                     (SETQ XCODE (AND (INTEGERP ENC)
+                     (SETQ MCODE (AND (INTEGERP ENC)
                                       (PLUSP ENC)
-                                      (FUNCALL UTOXFN ENC)))
+                                      (FUNCALL UTOMFN ENC)))
                      (IF RAW-UNICODE-MAPPING
                          (COND
                             ((> ENC 65535)
@@ -394,7 +407,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                     (CONS ENC GL)))
                             (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS)))
                          (COND
-                            ((NULL XCODE)
+                            ((AND (ZEROP (GLYPH-BBW GL))
+                                  (ZEROP (FIRST (GLYPH-DWIDTH GL))))
+
+                             (IL:* IL:|;;| 
+
       "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET")

+
+                             (TCONC (AREF CSETS NOMAPPINGCHARSET)
+                                    (CONS ENC GL)))
+                            ((NULL MCODE)
 
                              (IL:* IL:|;;| "These assoc with the Unicode encoding")

 
@@ -408,37 +429,37 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                  (TCONC (AREF CSETS NOMAPPINGCHARSET)
                                         (CONS ENC GL)))
                                 (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS))))
-                            ((AND (INTEGERP XCODE)
-                                  (<= 0 XCODE 65535))
+                            ((AND (INTEGERP MCODE)
+                                  (<= 0 MCODE 65535))
 
                              (IL:* IL:|;;| 
 
                             "These assoc with the 8 bit character code within the charset")

 
-                             (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS)
+                             (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS)
 
                              (IL:* IL:|;;| "Default SLUG width is width of A.")

 
                              (WHEN (AND (NOT SLUGWIDTH)
                                         (= ENC (CHAR-CODE #\A)))
 
-                                 (IL:* IL:|;;| "A is the same code in XCCS and UNICODE ")

+                                 (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ")

 
                                  (IL:* IL:|;;| 
-
                                 "Comparing with ENC, not XCODE, to look only in charset 0")

+
                                 "Comparing with ENC, not MCODE, to look only in charset 0")

 
                                  (SETQ SLUGWIDTH (GLYPH-WIDTH GL))))
-                            ((LISTP XCODE)
+                            ((LISTP MCODE)
 
                              (IL:* IL:|;;| 
 
                          "These assoc with the 8 bit character code within the charset (like above)")

 
-                             (LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS
-                                                                                    (LRSH XC 8))
-                                                                             XCS)
+                             (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS
+                                                                                    (LRSH MC 8))
+                                                                             MCS)
                                    :DO
-                                   (PUSH CS XCS)
-                                   (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS)))
-                            (T (ERROR "Invalid XCODE: ~A~%"))))))
+                                   (PUSH CS MCS)
+                                   (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS)))
+                            (T (ERROR "Invalid MCODE: ~A~%"))))))
 
          (IL:* IL:|;;| "Extract the lists from the TCONC pointers")

 
@@ -488,7 +509,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                               X))
                                                         Y))))
 
-(DEFUN READ-BDF
 (PATH &OPTIONAL VERBOSE)
              (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth")


+(DEFUN READ-BDF
 (PATH &OPTIONAL VERBOSE)
              (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth")


+                                                      (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth")


                                                       (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth")


                                                       (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth")

    (LET
@@ -603,15 +625,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                              (SETF (BF-SLUG FONT)
                                                    GL))))))
                       (ENDFONT (SETQ FONT-COMPLETE T))))))))
-     (WHEN VERBOSE
-         (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION)
-                                    SIZE)
-                (GET-FAMILY-FACE-SIZE-FROM-NAME
 FONT)
+     (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION)
+                                SIZE)
+            (GET-FAMILY-FACE-SIZE-FROM-NAME
 FONT)
+            (WHEN VERBOSE
                 (FORMAT *STANDARD-OUTPUT* 
                        "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%"
                        (BF-NAME FONT)
-                       FAMILY SIZE WEIGHT SLANT EXPANSION)))
-     FONT)))
+                       FAMILY SIZE WEIGHT SLANT EXPANSION))
+            (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE)))))
 
 (DEFUN READ-DELIMITED-LIST-FROM-STRING
 (INPUT-STRING &OPTIONAL (DELIMIT #\]))

                                                       (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")

@@ -699,7 +721,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                 (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
                                                 (SETQ BYTEPOS (* 16 (1- NWORDS)))
                                                 (LOOP :REPEAT NWORDS :DO
-                                                      (\\PUTBASE BM.BASE WORDINDEX
+                                                      (IL:\\PUTBASE BM.BASE WORDINDEX
                                                              (LDB (BYTE 16 BYTEPOS)
                                                                   BITS))
                                                       (INCF WORDINDEX)
@@ -744,12 +766,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                              (CHAR-SETS T)
                                              MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED 
                                              RAW-UNICODE-MAPPING)

+                                                      (IL:* IL:\; "Edited  5-Nov-2025 23:06 by mth")


                                                       (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth")


                                                       (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth")


                                                       (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")


                                                       (IL:* IL:\; "Edited  3-Feb-2025 23:18 by mth")

    (UNLESS (TYPEP BDFONT 'BDF-FONT)
-          (ERROR "Not a BDF-FONT: ~S~%" BDFONT))
+          (ERROR "Not a BDF-FONT: ~S ~%" BDFONT))
    (COND
       ((EQ CHAR-SETS T)                                      (IL:* IL:\; "This means ALL charsets")

        )
@@ -769,7 +792,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
           (GET-FAMILY-FACE-SIZE-FROM-NAME
 BDFONT)
           (SETQ FAMILY (OR FAMILY FN-FAMILY))
           (WHEN RAW-UNICODE-MAPPING
-              (SETQ FAMILY (\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY)))))
+              (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY)))))
           (SETQ FACE (OR FACE FN-FACE))
           (SETQ SIZE (OR SIZE FN-SIZE))
           (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)
@@ -780,16 +803,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                      (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS)))
                  (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS
                                                     (PACKFILENAME.STRING
 :BODY DEST-DIR :NAME
-                                                           (\\FONTFILENAME FAMILY SIZE FACE 
+                                                           (IL:\\FONTFILENAME FAMILY SIZE FACE 
                                                                   "DISPLAYFONT" CS))))
                  (IF WRITE-UNMAPPED
                      (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE
                                                           UNMAPPED-FONTDESC CS
                                                           (PACKFILENAME.STRING

                                                            :BODY DEST-DIR :NAME
-                                                           (\\FONTFILENAME (FONTPROP 
-                                                                                  UNMAPPED-FONTDESC
-                                                                                  'IL:FAMILY)
+                                                           (IL:\\FONTFILENAME (FONTPROP 
+                                                                                    UNMAPPED-FONTDESC
+                                                                                     'IL:FAMILY)
                                                                   SIZE FACE "DISPLAYFONT" CS))))
                      (SETQ UNICODE-CSETS NIL))
 
@@ -801,6 +824,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                  (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS))))
 (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY 
 
+(IL:FILESLOAD (IL:SYSLOAD)
+       IL:SYSEDIT)
+
+
 (IL:FILESLOAD (IL:LOADCOMP)
        IL:FONT)
 )
@@ -808,25 +835,23 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 (DEFINE-FILE-ENVIRONMENT "READ-BDF"
 :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP")
                                                     (:EXPORT "READ-BDF" 
                                                            "WRITE-BDF-TO-DISPLAYFONT-FILES")
-                                                    (:IMPORT \\AVGCHARWIDTH \\FGETWIDTH \\FONTFACE 
-                                                           \\FONTFILENAME \\FSETOFFSET \\FSETWIDTH 
-                                                           \\FONTSYMBOL \\GETSTREAM 
-                                                           \\INSTALLCHARSETINFO \\PUTBASE BITBLT 
-                                                           BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH 
-                                                           BLACKSHADE BLTSHADE BOLD CONDENSED 
-                                                           CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP 
-                                                           FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM 
-                                                           REGULAR TCONC UTOXCODE UTOXCODE? 
-                                                           WRITESTRIKEFONTFILE))
+                                                    (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" 
+                                                           "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE"
+                                                           "BLTSHADE" "BOLD" "COMPRESSED" 
+                                                           "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" 
+                                                           "FONTP" "FONTPROP" "INPUT" "ITALIC" 
+                                                           "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC"
+                                                           "UTOMCODE" "UTOMCODE?" 
+                                                           "WRITESTRIKEFONTFILE"))
    :READTABLE "XCL"
    :COMPILER :COMPILE-FILE)
 
 (IL:PUTPROPS IL:READ-BDF
 IL:DATABASE
 IL:NO)
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (2316 10275 (BDF-TO-CHARSETINFO 2316 . 10275)) (10277 16147 (BDF-TO-FONTDESCRIPTOR 
-10277 . 16147)) (16149 19687 (GET-FAMILY-FACE-SIZE-FROM-NAME 16149 . 19687)) (19689 26500 (
-GLYPHS-BY-CHARSET 19689 . 26500)) (26502 27927 (PACKFILENAME.STRING 26502 . 27927)) (27929 34733 (
-READ-BDF 27929 . 34733)) (34735 35058 (READ-DELIMITED-LIST-FROM-STRING 34735 . 35058)) (35060 41548 (
-READ-GLYPH 35060 . 41548)) (41550 42291 (SPLIT-FONT-NAME 41550 . 42291)) (42293 46075 (
-WRITE-BDF-TO-DISPLAYFONT-FILES 42293 . 46075)))))
+  (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR 
+10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 (
+GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 (
+READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 (
+READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 (
+WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827)))))
 IL:STOP

lispusers/REGIONMANAGER

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Apr-2025 12:57:07" {WMEDLEY}<lispusers>REGIONMANAGER.;137
 42626  
+
(FILECREATED "23-Oct-2025 20:12:38" {WMEDLEY}<lispusers>REGIONMANAGER.;139
 43219  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS RM-CLOSEW)
+      :CHANGES-TO (FNS GRAB-TYPED-REGION)
 
-      :PREVIOUS-DATE "25-Nov-2024 17:59:00" {WMEDLEY}<lispusers>REGIONMANAGER.;135)
+      :PREVIOUS-DATE "20-Apr-2025 12:57:07" {WMEDLEY}<lispusers>REGIONMANAGER.;137)
 
 
 (PRETTYCOMPRINT REGIONMANAGERCOMS)
@@ -88,20 +88,28 @@
             else
 (push
 TYPED-REGIONS (CONS TYPE REGIONS])
 
 (GRAB-TYPED-REGION

-  [LAMBDA (REGION-TYPE
 MINWIDTH MINHEIGHT)
                   (* ; "Edited 10-Oct-2023 13:41 by rmk")


+  [LAMBDA (REGION-TYPE
 MINWIDTH MINHEIGHT MARGIN)
            (* ; "Edited 23-Oct-2025 20:12 by rmk")


+                                                             (* ; "Edited 10-Oct-2023 13:41 by rmk")


                                                              (* ; "Edited 14-Sep-2023 07:30 by rmk")

 
-    (* ;; "Returns a REGIONTYPE region that satisfies MINWIDTH and MINHEIGHT, if specified")

+    (* ;; "Returns a REGIONTYPE region that is larger than MINWIDTH and MINHEIGHT, if specified, and smaller than those numbers times MARGIN, if specified.  MARGIN=1.1 allows a size 10%% bigger than MINWIDTH.")

 
-    (for
 R in
 (CDR (ASSOC REGION-TYPE TYPED-REGIONS)) unless
 (fetch
 REGION-INUSE of
 R)
-       when
 [AND (OR (NULL MINWIDTH)
-                     (ILEQ MINWIDTH (fetch
 WIDTH of
 R)))
-                 (OR (NULL MINHEIGHT)
-                     (ILEQ MINHEIGHT (fetch
 HEIGHT of
 R] do
 
+    (CL:UNLESS MINWIDTH (SETQ MINWIDTH 0))
+    (CL:UNLESS MINHEIGHT (SETQ MINHEIGHT 0))
+    (for
 R MAXWIDTH MAXHEIGHT in
 (CDR (ASSOC REGION-TYPE TYPED-REGIONS))
+       first
 (if
 (AND MARGIN (GREATERP MARGIN 1))
+                 then
 (SETQ MAXWIDTH (FIXR (FTIMES MARGIN MINWIDTH)))
+                      (SETQ MAXHEIGHT (FIXR (FTIMES MARGIN MINHEIGHT)))
+               else
 (SETQ MAXWIDTH MAX.FIXP)
+                    (SETQ MAXHEIGHT MAX.FIXP)) unless
 (fetch
 REGION-INUSE of
 R)
+       when
 (AND (<= MINWIDTH (fetch
 WIDTH of
 R)
+                     MAXWIDTH)
+                 (<= MINHEIGHT (fetch
 HEIGHT of
 R)
+                     MAXHEIGHT)) do
 
 
                                  (* ;; "We don't mark it as inuse here, leave that gets done by INSTALL-TYPED-REGION when ownership is given to a window. The only downside is that the region could be reallocated before that happens, and 2 window would come up in the same place.")

 
-                                                            (RETURN R])
+                                    (RETURN R])
 
 (REGISTER-TYPED-REGION

   [LAMBDA (REGION REGION-TYPE WINDOW)
                        (* ; "Edited 10-Oct-2023 13:30 by rmk")


@@ -752,11 +760,11 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1611 6729 (SET-TYPED-REGIONS 1621 . 3796) (GRAB-TYPED-REGION 3798 . 4824) (
-REGISTER-TYPED-REGION 4826 . 6123) (REGION-TYPE 6125 . 6727)) (6730 15428 (RM-CREATEW 6740 . 8863) (
-RM-CLOSEW 8865 . 12512) (RM-GETREGION 12514 . 14663) (CLOSE-TYPED-W 14665 . 15426)) (16071 23550 (
-RELCREATEREGION 16081 . 20704) (RELGETREGION 20706 . 23313) (RELCREATEPOSITION 23315 . 23548)) (23551 
-31126 (\RELCREATEREGION.REF 23561 . 28083) (\RELCREATEREGION.SIZE 28085 . 31124)) (31179 40521 (
-RM-ATTACHWINDOW 31189 . 40519)) (40522 42256 (CLOSEWITH 40532 . 41059) (CLOSEWITH.DOIT 41061 . 41341) 
-(MOVEWITH 41343 . 41866) (MOVEWITH.DOIT 41868 . 42254)))))
+  (FILEMAP (NIL (1619 7322 (SET-TYPED-REGIONS 1629 . 3804) (GRAB-TYPED-REGION 3806 . 5417) (
+REGISTER-TYPED-REGION 5419 . 6716) (REGION-TYPE 6718 . 7320)) (7323 16021 (RM-CREATEW 7333 . 9456) (
+RM-CLOSEW 9458 . 13105) (RM-GETREGION 13107 . 15256) (CLOSE-TYPED-W 15258 . 16019)) (16664 24143 (
+RELCREATEREGION 16674 . 21297) (RELGETREGION 21299 . 23906) (RELCREATEPOSITION 23908 . 24141)) (24144 
+31719 (\RELCREATEREGION.REF 24154 . 28676) (\RELCREATEREGION.SIZE 28678 . 31717)) (31772 41114 (
+RM-ATTACHWINDOW 31782 . 41112)) (41115 42849 (CLOSEWITH 41125 . 41652) (CLOSEWITH.DOIT 41654 . 41934) 
+(MOVEWITH 41936 . 42459) (MOVEWITH.DOIT 42461 . 42847)))))
 STOP

lispusers/REGIONMANAGER.TEDIT

@@ -34,8 +34,9 @@ where each regionsi is a possibly empty list of regions.  For convenience, if TY
 Typically, a call to SET-TYPED-REGIONS would be placed in a user's INIT file to set up the preference order for the regions that the user wants to participate in this reallocation scheme.  If an application uses a type that is not on TYPED-REGIONS, then that type-atom is treated as NIL and always gives rise to the normal ghost-region prompting.  Thus a user will observe no change in system behavior if TYPED-REGIONS is left with its initial value NIL.  A type that is added with an empty region list (as opposed to not being on the list at all) will allow new regions to accumulate for recycling.
 The function REGION-TYPE returns NIL if X is not a typed-region or not a region of type TYPE.
 (REGION-TYPE X TYPE)	[Function]
-In most scenarios the interpretation of a typed region specification is handled automatically by the extended CREATEW and GETREGION functions.  Sometimes it may be useful to perform to for the regions dimensions to be entered into other calculations before it is installed in a window.  The function GRAB-TYPED-REGION recycles an existing REGION-TYPE window if one meets the optional minimum width and height requirements, otherwise a new region is returned.  
-(GRAB-TYPED-REGION REGION-TYPE MINWIDTH MINHEIGHT)	[Function]
+In most scenarios the interpretation of a typed region specification is handled automatically by the extended CREATEW and GETREGION functions.  Sometimes it may be useful to perform to for the regions dimensions to be entered into other calculations before it is installed in a window.  The function GRAB-TYPED-REGION recycles an existing REGION-TYPE window if one meets the optional minimum width, height , and margin requirements, otherwise a new region is returned.  
+(GRAB-TYPED-REGION REGION-TYPE MINWIDTH MINHEIGHT MARGIN)	[Function]
+If MINWIDTH is specified, the recyled window must be at least that wide, and if MARGIN is specified it can be no larger than MARGIN x MINWIDTH.  Thus, if MINWIDTH is 200 and MARGIN is 1.1, only regions REGION-TYPE regions of width between 200 and 220 points will satisfy.  MINHEIGHT restricts the height in the same way. 
 A type can be assigned to an untyped region and installed in a window by the function REGISTER-TYPED-REGION.  That region will then be recycled when the window is closed.
 (REGISTER-TYPED-REGION REGION REGION-TYPE WINDOW)	[Function]
 If REGION is NIL, the (presumably) untyped region of WINDOW will be registered. An entry in TYPED-REGIONS will be created for REGION-TYPE if it is not already present.
@@ -79,14 +80,16 @@ Establishes a link between the PARENT window and any number of CHILDREN windows
 If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before.
 
 
-(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))))
1
$4
È
$

È
4
È
$

È
1$
È
$1
È
$4
È
$

È
4
È

$

È
4
È

$

È
4
È
$

È
1
È$1ŠŠ
8$1ŠŠ
8$J
È$

È
PAGEHEADINGRUNNINGHEADMODERN
-CLASSIC
-TERMINALMODERNTERMINALÿü
TERMINALÿü
-TIMESROMAN$


HRULE.GETFN



HRULE.GETFN


HRULE.GETFN


HRULE.GETFN

HRULE.GETFN

-
@


È


	„
	•
	‘
}


/


	¯

[

	
<01>
C
*
§
<00>

T

	Û

¬
@



Á
1	


-


-


;
	3

o
)

Ä

ž

 
’



	
4


n

	©

o
2
V
@
1


%
!








A
 

&

M




m

I

S
-
g
<


-3

E


-"


-

-












l







/
4
v


2





C
	
ƒ




	

&

%





"




O


=

	,

	l



¬
)9




š

¥
Ç



W
~
æ
&
4
!
U

h'

š

2
&µ
$"

&



(


)

M





DATE:iÏ*ø5V
®zº
+(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))))1
$4
È
$

È
4
È
$

È
1$
È
$1
È
$4
È
$

È
4
È
$

È
4
È

$

È
4
È

$

È
4
È
$

È
1
È$1ŠŠ
8$1ŠŠ
8$J
È$

È
PAGEHEADINGRUNNINGHEAD1TERMINAL(CHARPROPS (COLOR . BLACK))0CLASSIC
+(CHARPROPS (COLOR . BLACK))/MODERN
+(CHARPROPS (COLOR . BLACK))/MODERN(CHARPROPS (COLOR . BLACK))1TERMINALÿü(CHARPROPS (COLOR . BLACK))
1TERMINALÿü(CHARPROPS (COLOR . BLACK))3
+TIMESROMAN$(CHARPROPS (COLOR . BLACK))
HRULE.GETFN

HRULE.GETFN

HRULE.GETFN



HRULE.GETFN

HRULE.GETFN
@
È

+„
+•
+‘}
/

	
¯
[
	

<01>C
*
§<00>

T
	
Û
¬
@


Á1
	
	


+




+



;	
3

o
)
Ä

ž

 
’



	
4

n
	
©

y9

E
'




<0

V
@1


%
!






A

 

&

M




m

I

S-g
<

+
3

E

+
"
+

+













l





/4
v


2





C
	
ƒ



	

&

%





"



O
=
	
,
	
l



¬)
9


š

¥Ç



W~
æ&
4
!
U
h
'

š

2&
µ$
"
&




(

)


M


(((CHARENCODING . MCCS)))PROPS:#DATE:jÄ"<6©
Àzº

lispusers/WHICHKEY

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Jan-2025 15:47:23" {WMEDLEY}<lispusers>WHICHKEY.;3
 1037   
+
(FILECREATED "21-Oct-2025 08:40:16" {WMEDLEY}<lispusers>WHICHKEY.;5
 1172   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS WHICHKEY)
+      :CHANGES-TO (FNS DOWNP)
 
-      :PREVIOUS-DATE "23-Jan-2025 15:46:57" {WMEDLEY}<lispusers>WHICHKEY.;2)
+      :PREVIOUS-DATE "12-Oct-2025 20:53:41" {WMEDLEY}<lispusers>WHICHKEY.;4)
 
 
 (PRETTYCOMPRINT WHICHKEYCOMS)
@@ -14,15 +14,19 @@
 (RPAQQ WHICHKEYCOMS
 ((FNS DOWNP WHICHKEY)))
 (DEFINEQ
 
-(DOWNP

+(DOWNP

+  [LAMBDA (KEYNAME DELAY)
                                    (* ; "Edited 21-Oct-2025 08:37 by rmk")

+    (DISMISS (OR DELAY 3000))
+    (KEYDOWNP KEYNAME])
 
 (WHICHKEY

-           (KEYDOWNP KEYNAME])
+  [LAMBDA (DELAY)
                                            (* ; "Edited 12-Oct-2025 11:52 by rmk")


+                                                             (* ; "Edited 23-Jan-2025 15:44 by rmk")


                                                              (* ; "Edited  4-Dec-2023 16:04 by rmk")


                                                             (* ; "Edited 18-May-2018 13:09 by rmk:")

     (PROGN (DISMISS (OR DELAY 3000))
-                                                             (* ; "Edited  4-Dec-2023 16:04 by rmk")


+           (for
 X IN
 \KEYNAMES as
 I from
 0 when
 (KEYDOWNP (CAR X)) collect
 (LIST I X])
 )
 (DECLARE%: DONTCOPY
-           (for
 X IN
 \KEYNAMES when
 (KEYDOWNP (CAR X)) collect
 X])
+  (FILEMAP (NIL (365 1149 (DOWNP 375 . 548) (WHICHKEY 550 . 1147)))))
 STOP

sources/ADIR

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Feb-2025 17:48:54" {DSK}<home>frank>il>medley>sources>ADIR.;6
 70091  
+
(FILECREATED "15-Oct-2025 15:20:48" {WMEDLEY}<sources>ADIR.;62
 70135  
 
-      :CHANGES-TO (FNS INTERPRET.REM.CM)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "20-Jan-2025 13:37:28" {DSK}<home>frank>il>medley>sources>ADIR.;3)
+      :CHANGES-TO (MACROS \UPF.EXTRACT)
+
+      :PREVIOUS-DATE " 6-Feb-2025 17:48:54" {WMEDLEY}<sources>ADIR.;61)
 
 
 (PRETTYCOMPRINT ADIRCOMS)
@@ -742,7 +744,8 @@
                                      OFFST _ STARTOFFSET
                                      LENGTH _ (ADD1 (IDIFFERENCE ENDOFFSET STARTOFFSET))
                                      BASE _ $$BASE
-                                     READONLY _ $$READONLY)))
+                                     READONLY _ $$READONLY
+                                     FATSTRINGP _ $$FATP)))
 
 (PUTPROPS \UPF.DIRTYPE
 MACRO
 [(DIRSTART)
                     (* ; "Edited 20-Apr-2022 20:14 by rmk")

                               (SELCHARQ (\GETBASECHAR $$FATP $$BASE DIRSTART)
@@ -1279,14 +1282,14 @@
 (ADDTOVAR LAMA
 PACKFILENAME.STRING PACKFILENAME)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3183 16010 (DELFILE 3193 . 3354) (FULLNAME 3356 . 3723) (INFILE 3725 . 3984) (INFILEP 
-3986 . 4121) (IOFILE 4123 . 4374) (OPENFILE 4376 . 4679) (OPENSTREAM 4681 . 9021) (OUTFILE 9023 . 9285
-) (OUTFILEP 9287 . 9423) (RENAMEFILE 9425 . 9731) (SIMPLE.FINDFILE 9733 . 10143) (VMEMSIZE 10145 . 
-10312) (\COPYSYS 10314 . 14605) (\FLUSHVM 14607 . 15679) (\LOGOUT0 15681 . 16008)) (16509 41169 (
-UNPACKFILENAME.STRING 16519 . 38355) (\UPF.DIRECTORY 38357 . 41167)) (42697 45003 (UNPACKFILENAME 
-42707 . 42893) (LASTCHPOS 42895 . 43589) (FILENAMEFIELD 43591 . 43885) (FILENAMEFIELD.STRING 43887 . 
-44291) (PACKFILENAME 44293 . 44636) (PACKFILENAME.STRING 44638 . 45001)) (59473 60386 (
-FILEDIRCASEARRAY 59483 . 60384)) (60553 67850 (LOGOUT 60563 . 61608) (MAKESYS 61610 . 63239) (SYSOUT 
-63241 . 64793) (SAVEVM 64795 . 65595) (HERALD 65597 . 65757) (INTERPRET.REM.CM 65759 . 67473) (
-\USEREVENT 67475 . 67848)) (68032 69759 (USERNAME 68042 . 68998) (SETUSERNAME 69000 . 69757)))))
+  (FILEMAP (NIL (3170 15997 (DELFILE 3180 . 3341) (FULLNAME 3343 . 3710) (INFILE 3712 . 3971) (INFILEP 
+3973 . 4108) (IOFILE 4110 . 4361) (OPENFILE 4363 . 4666) (OPENSTREAM 4668 . 9008) (OUTFILE 9010 . 9272
+) (OUTFILEP 9274 . 9410) (RENAMEFILE 9412 . 9718) (SIMPLE.FINDFILE 9720 . 10130) (VMEMSIZE 10132 . 
+10299) (\COPYSYS 10301 . 14592) (\FLUSHVM 14594 . 15666) (\LOGOUT0 15668 . 15995)) (16496 41156 (
+UNPACKFILENAME.STRING 16506 . 38342) (\UPF.DIRECTORY 38344 . 41154)) (42741 45047 (UNPACKFILENAME 
+42751 . 42937) (LASTCHPOS 42939 . 43633) (FILENAMEFIELD 43635 . 43929) (FILENAMEFIELD.STRING 43931 . 
+44335) (PACKFILENAME 44337 . 44680) (PACKFILENAME.STRING 44682 . 45045)) (59517 60430 (
+FILEDIRCASEARRAY 59527 . 60428)) (60597 67894 (LOGOUT 60607 . 61652) (MAKESYS 61654 . 63283) (SYSOUT 
+63285 . 64837) (SAVEVM 64839 . 65639) (HERALD 65641 . 65801) (INTERPRET.REM.CM 65803 . 67517) (
+\USEREVENT 67519 . 67892)) (68076 69803 (USERNAME 68086 . 69042) (SETUSERNAME 69044 . 69801)))))
 STOP

sources/AOFD

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-May-2023 08:29:55" {DSK}<home>larry>il>medley>sources>AOFD.;5
 36263  
+
(FILECREATED "24-Apr-2025 21:46:04" {WMEDLEY}<sources>AOFD.;10
 36381  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "17-May-2023 08:05:56" {DSK}<home>larry>il>medley>sources>AOFD.;4)
+      :CHANGES-TO (FNS MAKE-STRING-FORMAT)
+
+      :PREVIOUS-DATE "17-May-2023 08:29:55" {WMEDLEY}<sources>AOFD.;9)
 
 
 (PRETTYCOMPRINT AOFDCOMS)
@@ -558,9 +560,10 @@
          STREAM])
 
 (MAKE-STRING-FORMAT

-  [LAMBDA NIL
                                               (* ; "Edited  8-Aug-2021 00:10 by rmk:")

+  [LAMBDA NIL
                                                (* ; "Edited 24-Apr-2025 21:45 by rmk")


+                                                            (* ; "Edited  8-Aug-2021 00:10 by rmk:")

 
-    (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")

+    (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (MCCS) encoding, and that the string is fat. ")

 
     (MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
                                              (DECLARE
 (USEDFREE *BYTECOUNTER*))
@@ -761,15 +764,15 @@
 (ADDTOVAR LAMA
 WHENCLOSE)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2363 3482 (\ADD-OPEN-STREAM 2373 . 2654) (\GENERIC-UNREGISTER-STREAM 2656 . 3480)) (
-3523 10587 (CLOSEALL 3533 . 4011) (CLOSEF 4013 . 5227) (EOFCLOSEF 5229 . 5529) (INPUT 5531 . 6301) (
-OPENP 6303 . 6706) (OUTPUT 6708 . 7480) (POSITION 7482 . 8290) (RANDACCESSP 8292 . 8682) (\IOMODEP 
-8684 . 9313) (WHENCLOSE 9315 . 10585)) (10588 10710 (STREAMADDPROP 10598 . 10708)) (11668 24521 (
-\BASEBYTES.IO.INIT 11678 . 14878) (\MAKEBASEBYTESTREAM 14880 . 17808) (\MBS.OUTCHARFN 17810 . 18210) (
-\BASEBYTES.NAME.FROM.STREAM 18212 . 18671) (\BASEBYTES.BOUT 18673 . 19427) (\BASEBYTES.SETFILEPTR 
-19429 . 20050) (\BASEBYTES.READP 20052 . 20696) (\BASEBYTES.BIN 20698 . 21205) (\BASEBYTES.PEEKBIN 
-21207 . 22037) (\BASEBYTES.TRUNCATEFN 22039 . 22547) (\BASEBYTES.OPENFN 22549 . 23343) (
-\BASEBYTES.BLOCKIO 23345 . 24519)) (24644 27948 (OPENSTRINGSTREAM 24654 . 26363) (MAKE-STRING-FORMAT 
-26365 . 27946)) (28220 32528 (\STRINGSTREAM.INIT 28230 . 32526)) (32605 35305 (GETSTREAM 32615 . 32846
-) (\CLEAROFD 32848 . 33141) (\GETSTREAM 33143 . 35303)))))
+  (FILEMAP (NIL (2372 3491 (\ADD-OPEN-STREAM 2382 . 2663) (\GENERIC-UNREGISTER-STREAM 2665 . 3489)) (
+3532 10596 (CLOSEALL 3542 . 4020) (CLOSEF 4022 . 5236) (EOFCLOSEF 5238 . 5538) (INPUT 5540 . 6310) (
+OPENP 6312 . 6715) (OUTPUT 6717 . 7489) (POSITION 7491 . 8299) (RANDACCESSP 8301 . 8691) (\IOMODEP 
+8693 . 9322) (WHENCLOSE 9324 . 10594)) (10597 10719 (STREAMADDPROP 10607 . 10717)) (11677 24530 (
+\BASEBYTES.IO.INIT 11687 . 14887) (\MAKEBASEBYTESTREAM 14889 . 17817) (\MBS.OUTCHARFN 17819 . 18219) (
+\BASEBYTES.NAME.FROM.STREAM 18221 . 18680) (\BASEBYTES.BOUT 18682 . 19436) (\BASEBYTES.SETFILEPTR 
+19438 . 20059) (\BASEBYTES.READP 20061 . 20705) (\BASEBYTES.BIN 20707 . 21214) (\BASEBYTES.PEEKBIN 
+21216 . 22046) (\BASEBYTES.TRUNCATEFN 22048 . 22556) (\BASEBYTES.OPENFN 22558 . 23352) (
+\BASEBYTES.BLOCKIO 23354 . 24528)) (24653 28066 (OPENSTRINGSTREAM 24663 . 26372) (MAKE-STRING-FORMAT 
+26374 . 28064)) (28338 32646 (\STRINGSTREAM.INIT 28348 . 32644)) (32723 35423 (GETSTREAM 32733 . 32964
+) (\CLEAROFD 32966 . 33259) (\GETSTREAM 33261 . 35421)))))
 STOP

sources/ATBL

@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "26-Dec-2021 14:32:50" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>ATBL.;32
 91860  
+
(FILECREATED "24-Apr-2025 21:52:35" {WMEDLEY}<sources>ATBL.;33
 91754  
 
-      :CHANGES-TO (FNS MAKE-READER-ENVIRONMENT)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "19-Dec-2021 14:09:43" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>ATBL.;31)
+      :CHANGES-TO (FNS \ATBLSET EQUAL-READER-ENVIRONMENT)
 
+      :PREVIOUS-DATE "26-Dec-2021 14:32:50" {WMEDLEY}<sources>ATBL.;32)
 
-(* ; "
-Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT ATBLCOMS)
 
@@ -1733,26 +1730,27 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (\ATBLSET

-  [LAMBDA NIL
                                           (* ; "Edited 28-Jun-2021 09:29 by rmk:")


-                                                             (* ; "Edited  3-Dec-86 18:07 by Pavel")

+  [LAMBDA NIL
                                                (* ; "Edited 24-Apr-2025 21:51 by rmk")


+                                                            (* ; "Edited 28-Jun-2021 09:29 by rmk:")


+                                                             (* ; "Edited  3-Dec-86 18:07 by Pavel")

     (DECLARE
 (GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE))
     (COND
        ((NULL (BOUNDP '\PRIMREADTABLE))
         (initrecord
 CHARTABLE)
 
-        (* ;; "Read tables")

+        (* ;; "Read tables")

 
-        (* ;; "RMK:  If reloading, don't smash an existing hash table")

+        (* ;; "RMK:  If reloading, don't smash an existing hash table")

 
         [OR (HARRAYP \READTABLEHASH)
             (SETQ \READTABLEHASH (HASHARRAY 20 NIL (FUNCTION STRING-EQUAL-HASHBITS)
                                         (FUNCTION STRING-EQUAL]
         (LET (TRDTBL NEW-IL-RDTBL)
-             (PROGN                                          (* ; "The ORIG read table")

+             (PROGN                                          (* ; "The ORIG read table")

                     (SETQ \ORIGREADTABLE (\ORIGREADTABLE
))
                     (READTABLEPROP
 \ORIGREADTABLE 'NAME 'ORIG))
-             (PROGN                                          (* ; 
-
                            "The old Interlisp T read table.  May not have a use for this any more")

+             (PROGN                                          (* ; 
+
                              "The old Interlisp T read table.  May not have a use for this any more")

                     (SETQ TRDTBL (COPYREADTABLE
 \ORIGREADTABLE))
                     (SETSYNTAX
 (CHARCODE "|")
                            '(MACRO READVBAR)
@@ -1767,9 +1765,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
                            '(MACRO FIRST READQUOTE)
                            TRDTBL)
                     (READTABLEPROP
 TRDTBL 'NAME "OLD-INTERLISP-T")
-                    (PROGN                                   (* ; "Temporary")

+                    (PROGN                                   (* ; "Temporary")

                            (SETTOPVAL '%#CURRENTRDTBL# TRDTBL)))
-             (PROGN                                          (* ; "The old FILERDTBL")

+             (PROGN                                          (* ; "The old FILERDTBL")

                     (SETQ FILERDTBL (COPYREADTABLE
 \ORIGREADTABLE))
                     (SETSYNTAX
 (CHARCODE "|")
                            TRDTBL FILERDTBL)
@@ -1778,12 +1776,12 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
                      (create
 READER-ENVIRONMENT
                             REREADTABLE _ FILERDTBL
                             REBASE _ 10
-                            REFORMAT _ :XCCS))               (* ; 
-
                                                           "need this to read files in the loadup")

+                            REFORMAT _ :MCCS))               (* ; 
+
                                                             "need this to read files in the loadup")

                     )
              (PROGN (SETQ NEW-IL-RDTBL (COPYREADTABLE
 TRDTBL))
-                                                             (* ; 
-
                                                "The new Interlisp read table is more common lispy")

+                                                             (* ; 
+
                                                  "The new Interlisp read table is more common lispy")

                     (READTABLEPROP
 NEW-IL-RDTBL 'MULTIPLE-ESCAPECHAR (CHARCODE "|"))
                     (READTABLEPROP
 NEW-IL-RDTBL 'HASHMACROCHAR (CHARCODE "#"))
                     (SET-DEFAULT-HASHMACRO-SETTINGS NEW-IL-RDTBL)
@@ -1791,11 +1789,11 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
                     (READTABLEPROP
 NEW-IL-RDTBL 'USESILPACKAGE NIL)
                     (READTABLEPROP
 NEW-IL-RDTBL 'NAME "INTERLISP")
                     (for
 I from
 1 to
 26 do
 (SETSYNTAX
 I 'SEPRCHAR FILERDTBL) 
-                                                             (* ; "Make font switch chars seprs")

-                                                          (SETSYNTAX
 I 'SEPRCHAR NEW-IL-RDTBL))
+                                                             (* ; "Make font switch chars seprs")

+                                           (SETSYNTAX
 I 'SEPRCHAR NEW-IL-RDTBL))
                     (SETQ *READTABLE* NEW-IL-RDTBL))
 
-             (* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.")

+             (* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.")

 
              (SETSYNTAX
 (CHARCODE ^Y)
                     '[MACRO ALWAYS (LAMBDA (FILE RDTBL)
@@ -1805,7 +1803,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
                     TRDTBL NEW-IL-RDTBL)
              (DEFPRINT 'READTABLEP '\READTABLEP.DEFPRINT))
 
-        (* ;; "Terminal tables")

+        (* ;; "Terminal tables")

 
         (SETQ \ORIGTERMTABLE (\ORIGTERMTABLE
))
         (SETQ \PRIMTERMTABLE (COPYTERMTABLE
 \ORIGTERMTABLE))
@@ -1868,7 +1866,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 (EQUAL-READER-ENVIRONMENT

   [LAMBDA (ENV1 ENV2)
 
-    (* ;; "Edited 19-Dec-2021 14:09 by rmk: Replace constant :XCCS with *DEFAULT-EXTERNALFORMAT*")

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

+
+    (* ;; "Edited 19-Dec-2021 14:09 by rmk:  Use *DEFAULT-EXTERNALFORMAT*")

 
     (* ;; "Edited 19-Dec-2021 14:01 by rmk")

 
@@ -1921,25 +1921,23 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA
 READTABLEPROP)
 )
-(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018 
-2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17749 28901 (GETSYNTAX 17759 . 22590) (SETSYNTAX 22592 . 23665) (SYNTAXP 23667 . 26164)
- (\COPYSYNTAX 26166 . 26883) (\GETCHARCODE 26885 . 27173) (\SETFATSYNCODE 27175 . 28466) (
-\MAPCHARTABLE 28468 . 28899)) (28934 43900 (CONTROL 28944 . 29196) (COPYTERMTABLE 29198 . 29565) (
-DELETECONTROL 29567 . 32208) (GETDELETECONTROL 32210 . 33172) (ECHOCHAR 33174 . 34615) (ECHOCONTROL 
-34617 . 35074) (ECHOMODE 35076 . 35322) (GETECHOMODE 35324 . 35488) (GETCONTROL 35490 . 35656) (
-GETTERMTABLE 35658 . 35725) (RAISE 35727 . 36153) (GETRAISE 36155 . 36317) (RESETTERMTABLE 36319 . 
-37403) (SETTERMTABLE 37405 . 37639) (TERMTABLEP 37641 . 37802) (\GETTERMSYNTAX 37804 . 38075) (
-\GTTERMTABLE 38077 . 38413) (\ORIGTERMTABLE 38415 . 42025) (\SETTERMSYNTAX 42027 . 42662) (
-\TERMCLASSTOCODE 42664 . 43093) (\TERMCODETOCLASS 43095 . 43482) (\LITCHECK 43484 . 43898)) (46411 
-70235 (COPYREADTABLE 46421 . 46619) (FIND-READTABLE 46621 . 46768) (IN-READTABLE 46770 . 46930) (
-ESCAPE 46932 . 47185) (GETBRK 47187 . 47325) (GETREADTABLE 47327 . 47463) (GETSEPR 47465 . 47603) (
-READMACROS 47605 . 47868) (READTABLEP 47870 . 48033) (READTABLEPROP 48035 . 53193) (RESETREADTABLE 
-53195 . 57442) (SETBRK 57444 . 59054) (SETREADTABLE 59056 . 59244) (SETSEPR 59246 . 60788) (
-\GETREADSYNTAX 60790 . 63480) (\GTREADTABLE 63482 . 63707) (\GTREADTABLE1 63709 . 63965) (
-\ORIGREADTABLE 63967 . 65875) (\READCLASSTOCODE 65877 . 66328) (\SETMACROSYNTAX 66330 . 68125) (
-\SETREADSYNTAX 68127 . 69188) (\READTABLEP.DEFPRINT 69190 . 70233)) (83067 87520 (\ATBLSET 83077 . 
-87518)) (87967 91384 (MAKE-READER-ENVIRONMENT 87977 . 89634) (EQUAL-READER-ENVIRONMENT 89636 . 90786) 
-(SET-READER-ENVIRONMENT 90788 . 91382)))))
+  (FILEMAP (NIL (17619 28771 (GETSYNTAX 17629 . 22460) (SETSYNTAX 22462 . 23535) (SYNTAXP 23537 . 26034)
+ (\COPYSYNTAX 26036 . 26753) (\GETCHARCODE 26755 . 27043) (\SETFATSYNCODE 27045 . 28336) (
+\MAPCHARTABLE 28338 . 28769)) (28804 43770 (CONTROL 28814 . 29066) (COPYTERMTABLE 29068 . 29435) (
+DELETECONTROL 29437 . 32078) (GETDELETECONTROL 32080 . 33042) (ECHOCHAR 33044 . 34485) (ECHOCONTROL 
+34487 . 34944) (ECHOMODE 34946 . 35192) (GETECHOMODE 35194 . 35358) (GETCONTROL 35360 . 35526) (
+GETTERMTABLE 35528 . 35595) (RAISE 35597 . 36023) (GETRAISE 36025 . 36187) (RESETTERMTABLE 36189 . 
+37273) (SETTERMTABLE 37275 . 37509) (TERMTABLEP 37511 . 37672) (\GETTERMSYNTAX 37674 . 37945) (
+\GTTERMTABLE 37947 . 38283) (\ORIGTERMTABLE 38285 . 41895) (\SETTERMSYNTAX 41897 . 42532) (
+\TERMCLASSTOCODE 42534 . 42963) (\TERMCODETOCLASS 42965 . 43352) (\LITCHECK 43354 . 43768)) (46281 
+70105 (COPYREADTABLE 46291 . 46489) (FIND-READTABLE 46491 . 46638) (IN-READTABLE 46640 . 46800) (
+ESCAPE 46802 . 47055) (GETBRK 47057 . 47195) (GETREADTABLE 47197 . 47333) (GETSEPR 47335 . 47473) (
+READMACROS 47475 . 47738) (READTABLEP 47740 . 47903) (READTABLEPROP 47905 . 53063) (RESETREADTABLE 
+53065 . 57312) (SETBRK 57314 . 58924) (SETREADTABLE 58926 . 59114) (SETSEPR 59116 . 60658) (
+\GETREADSYNTAX 60660 . 63350) (\GTREADTABLE 63352 . 63577) (\GTREADTABLE1 63579 . 63835) (
+\ORIGREADTABLE 63837 . 65745) (\READCLASSTOCODE 65747 . 66198) (\SETMACROSYNTAX 66200 . 67995) (
+\SETREADSYNTAX 67997 . 69058) (\READTABLEP.DEFPRINT 69060 . 70103)) (82937 87494 (\ATBLSET 82947 . 
+87492)) (87941 91385 (MAKE-READER-ENVIRONMENT 87951 . 89608) (EQUAL-READER-ENVIRONMENT 89610 . 90787) 
+(SET-READER-ENVIRONMENT 90789 . 91383)))))
 STOP

sources/LLPACKAGE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
 
-
(IL:FILECREATED " 5-Sep-2024 17:42:20" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;3|
 87515  
+
(IL:FILECREATED " 2-Nov-2025 19:49:02" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;2|
 92970  
 
       :EDIT-BY "mth"
 
       :CHANGES-TO (IL:FNS XCL:DEFPACKAGE)
 
-      :PREVIOUS-DATE " 4-Sep-2024 13:17:23" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;2|
+      :PREVIOUS-DATE "30-Oct-2025 14:25:43" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;1|
 )
 
 
@@ -524,7 +524,9 @@
 (IL:DEFINEQ
 
 (XCL:DEFPACKAGE

-  (IL:NLAMBDA IL:ARGS
                                 (IL:* IL:\; "Edited  4-Sep-2024 13:17 by mth")


+  (IL:NLAMBDA IL:ARGS
                                 (IL:* IL:\; "Edited  2-Nov-2025 19:48 by mth")


+                                                      (IL:* IL:\; "Edited 30-Oct-2025 11:34 by mth")


+                                                      (IL:* IL:\; "Edited  4-Sep-2024 13:17 by mth")


                                                         (IL:* IL:\; "Edited  2-Dec-87 10:39 by raf")

     (IL:SETQ IL:ARGS (XCL:REMOVE-COMMENTS IL:ARGS))
     (LET
@@ -571,6 +573,30 @@
                                                                         IL:SYMBOL)))
                                         PACKAGE))
                         (:IMPORT (IMPORT
 VALUES PACKAGE))
+                        (:IMPORT-FROM (LET* ((PACKAGE-NAME
 (POP VALUES))
+                                             (XCL::PACKAGE-FROM (FIND-PACKAGE
 PACKAGE-NAME)))
+                                            (IMPORT
 (IL:MAPCAR VALUES
+                                                           (IL:FUNCTION (IL:LAMBDA (XCL::SN)
+                                                                          (COND
+                                                                             ((IL:LITATOM XCL::SN)
+                                                                              (SETQ XCL::SN
+                                                                                    (SYMBOL-NAME
+                                                                                     XCL::SN))))
+                                                                          (COND
+                                                                             ((IL:STRINGP XCL::SN)
+                                                                              (OR (FIND-SYMBOL
 
+                                                                                         XCL::SN 
+                                                                                    XCL::PACKAGE-FROM
+                                                                                         )
+                                                                                  (ERROR 
+                             "Symbol ~S not found in package ~S in :import-from option of defpackage"
+                                                                                         XCL::SN 
+                                                                                         PACKAGE-NAME
+                                                                                         )))
+                                                                             (T (IL:ERROR 
+                                                   "Bad object in :import-from option of defpackage "
+                                                                                       XCL::SN))))))
+                                                   PACKAGE)))
                         ((:SHADOW :SHADOWING-IMPORT) 
                               (LET ((IL:SYMBOLS-TO-SHADOW (IL:MAPCONC
                                                            VALUES
@@ -620,7 +646,8 @@
                                                 ((:PREFIX-NAME :INTERNAL-SYMBOLS :EXTERNAL-SYMBOLS 
                                                         :EXTERNAL-ONLY) 
                                                       (LIST IL:KEY (CAR VALUES)))
-                                                ((:SHADOW :EXPORT :IMPORT :SHADOWING-IMPORT) 
+                                                ((:SHADOW :EXPORT :IMPORT :IMPORT-FROM 
+                                                        :SHADOWING-IMPORT) 
                                                       (IL:SETQ IL:POST-MAKE-FORMS
                                                        (CONS (CONS IL:KEY VALUES)
                                                              IL:POST-MAKE-FORMS))
@@ -648,6 +675,37 @@
                                           PACKAGE))
                                 (:IMPORT (IMPORT
 (CDR IL:FORM)
                                                 PACKAGE))
+                                (:IMPORT-FROM (LET* ((PACKAGE-NAME
 (CADR IL:FORM))
+                                                     (XCL::PACKAGE-FROM (FIND-PACKAGE
 PACKAGE-NAME)))
+                                                    (IMPORT
 (IL:MAPCAR (CDDR IL:FORM)
+                                                                   (IL:FUNCTION (IL:LAMBDA (XCL::SN)
+                                                                                  (COND
+                                                                                     ((IL:LITATOM
+                                                                                       XCL::SN)
+                                                                                      (SETQ
+                                                                                       XCL::SN
+                                                                                       (SYMBOL-NAME
+                                                                                        XCL::SN))))
+                                                                                  (COND
+                                                                                     ((IL:STRINGP
+                                                                                       XCL::SN)
+                                                                                      (OR
+                                                                                       (FIND-SYMBOL

+                                                                                        XCL::SN 
+                                                                                    XCL::PACKAGE-FROM
+                                                                                        )
+                                                                                       (ERROR 
+                             "Symbol ~S not found in package ~S in :import-from option of defpackage"
+                                                                                              XCL::SN
+                                                                                              
+                                                                                         PACKAGE-NAME
+                                                                                              )))
+                                                                                     (T (IL:ERROR
+                                                                                         
+                                                   "Bad object in :import-from option of defpackage "
+                                                                                         XCL::SN)))))
+                                                                   )
+                                                           PACKAGE)))
                                 (:SHADOWING-IMPORT 
                                       (SHADOWING-IMPORT
 (CDR IL:FORM)
                                              PACKAGE))
@@ -1663,7 +1721,7 @@
 (IL:* IL:|;;| "Proper compiler, readtable and package environment")

 
 
-(IL:PUTPROPS IL:LLPACKAGE
 IL:FILETYPE
 COMPILE-FILE)
+(IL:PUTPROPS IL:LLPACKAGE
 IL:FILETYPE
 :FAKE-COMPILE-FILE)
 
 (IL:PUTPROPS IL:LLPACKAGE
 IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE "LISP"))
 (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS 
@@ -1691,23 +1749,23 @@ IL:\\PKG-FIND-FREE-PACKAGE-INDEX 17838 . 18248)) (18305 18451 (IL:SETF-SYMBOL-PA
 IL:ENTRY-HASH 20528 . 20919)) (20968 21314 (IL:COUNT-PACKAGE-HASHTABLE 20968 . 21314)) (21316 21488 (
 IL:INTERNAL-SYMBOL-COUNT 21316 . 21488)) (21490 21608 (IL:EXTERNAL-SYMBOL-COUNT 21490 . 21608)) (21610
  22766 (IL:ENTER-NEW-NICKNAMES 21610 . 22766)) (22768 23194 (IL:MAKE-PRIME-HASHTABLE-SIZE 22768 . 
-23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 34317 (XCL:DEFPACKAGE 24859 . 34315)) (34366
- 34588 (FIND-PACKAGE 34366 . 34588)) (34590 37951 (USE-PACKAGE 34590 . 37951)) (37953 38433 (
-IN-PACKAGE 37953 . 38433)) (38435 38709 (XCL:PKG-GOTO 38435 . 38709)) (38711 39811 (RENAME-PACKAGE 
-38711 . 39811)) (39813 41264 (XCL:DELETE-PACKAGE 39813 . 41264)) (41266 44212 (EXPORT 41266 . 44212)) 
-(44214 45457 (UNEXPORT 44214 . 45457)) (45459 47103 (IMPORT 45459 . 47103)) (47105 48385 (
-SHADOWING-IMPORT 47105 . 48385)) (48387 49441 (SHADOW 48387 . 49441)) (49443 50098 (UNUSE-PACKAGE 
-49443 . 50098)) (50162 50468 (LIST-ALL-PACKAGES 50162 . 50468)) (50525 54208 (IL:ADD-SYMBOL 50525 . 
-54208)) (54210 58263 (IL:WITH-SYMBOL 54210 . 58263)) (58265 59568 (IL:INTERN* 58265 . 59568)) (59570 
-65402 (IL:FIND-SYMBOL* 59570 . 65402)) (65404 66855 (INTERN 65404 . 66855)) (66857 67435 (FIND-SYMBOL 
-66857 . 67435)) (67493 68389 (IL:NUKE-SYMBOL 67493 . 68389)) (68391 70505 (UNINTERN 68391 . 70505)) (
-70507 71650 (IL:MOBY-UNINTERN 70507 . 71650)) (71709 71781 (IL:\\INDEXATOMPNAME 71709 . 71781)) (71893
- 72040 (IL:MAKE-DO-SYMBOLS-VARS 71893 . 72040)) (72042 73497 (IL:MAKE-DO-SYMBOLS-CODE 72042 . 73497)) 
-(73501 74279 (DO-EXTERNAL-SYMBOLS 73501 . 74279)) (74281 75627 (XCL:DO-LOCAL-SYMBOLS 74281 . 75627)) (
-75629 76745 (XCL:DO-INTERNAL-SYMBOLS 75629 . 76745)) (76747 79045 (DO-SYMBOLS 76747 . 79045)) (79047 
-80729 (DO-ALL-SYMBOLS 79047 . 80729)) (80797 81322 (FIND-ALL-SYMBOLS 80797 . 81322)) (81324 81603 (
-IL:BRIEFLY-DESCRIBE-SYMBOL 81324 . 81603)) (81605 83119 (APROPOS 81605 . 83119)) (83121 84688 (
-APROPOS-LIST 83121 . 84688)) (84792 86319 (IL:FIND-EXTERNAL-SYMBOL 84792 . 86319)) (86321 86841 (
-IL:FIND-EXACT-SYMBOL 86321 . 86841)) (86843 86923 (IL:PACKAGE-NAME-AS-SYMBOL 86843 . 86923)) (86925 
-87074 (IL:\\FIND.PACKAGE.INTERNAL 86925 . 87074)))))
+23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 39766 (XCL:DEFPACKAGE 24859 . 39764)) (39815
+ 40037 (FIND-PACKAGE 39815 . 40037)) (40039 43400 (USE-PACKAGE 40039 . 43400)) (43402 43882 (
+IN-PACKAGE 43402 . 43882)) (43884 44158 (XCL:PKG-GOTO 43884 . 44158)) (44160 45260 (RENAME-PACKAGE 
+44160 . 45260)) (45262 46713 (XCL:DELETE-PACKAGE 45262 . 46713)) (46715 49661 (EXPORT 46715 . 49661)) 
+(49663 50906 (UNEXPORT 49663 . 50906)) (50908 52552 (IMPORT 50908 . 52552)) (52554 53834 (
+SHADOWING-IMPORT 52554 . 53834)) (53836 54890 (SHADOW 53836 . 54890)) (54892 55547 (UNUSE-PACKAGE 
+54892 . 55547)) (55611 55917 (LIST-ALL-PACKAGES 55611 . 55917)) (55974 59657 (IL:ADD-SYMBOL 55974 . 
+59657)) (59659 63712 (IL:WITH-SYMBOL 59659 . 63712)) (63714 65017 (IL:INTERN* 63714 . 65017)) (65019 
+70851 (IL:FIND-SYMBOL* 65019 . 70851)) (70853 72304 (INTERN 70853 . 72304)) (72306 72884 (FIND-SYMBOL 
+72306 . 72884)) (72942 73838 (IL:NUKE-SYMBOL 72942 . 73838)) (73840 75954 (UNINTERN 73840 . 75954)) (
+75956 77099 (IL:MOBY-UNINTERN 75956 . 77099)) (77158 77230 (IL:\\INDEXATOMPNAME 77158 . 77230)) (77342
+ 77489 (IL:MAKE-DO-SYMBOLS-VARS 77342 . 77489)) (77491 78946 (IL:MAKE-DO-SYMBOLS-CODE 77491 . 78946)) 
+(78950 79728 (DO-EXTERNAL-SYMBOLS 78950 . 79728)) (79730 81076 (XCL:DO-LOCAL-SYMBOLS 79730 . 81076)) (
+81078 82194 (XCL:DO-INTERNAL-SYMBOLS 81078 . 82194)) (82196 84494 (DO-SYMBOLS 82196 . 84494)) (84496 
+86178 (DO-ALL-SYMBOLS 84496 . 86178)) (86246 86771 (FIND-ALL-SYMBOLS 86246 . 86771)) (86773 87052 (
+IL:BRIEFLY-DESCRIBE-SYMBOL 86773 . 87052)) (87054 88568 (APROPOS 87054 . 88568)) (88570 90137 (
+APROPOS-LIST 88570 . 90137)) (90241 91768 (IL:FIND-EXTERNAL-SYMBOL 90241 . 91768)) (91770 92290 (
+IL:FIND-EXACT-SYMBOL 91770 . 92290)) (92292 92372 (IL:PACKAGE-NAME-AS-SYMBOL 92292 . 92372)) (92374 
+92523 (IL:\\FIND.PACKAGE.INTERNAL 92374 . 92523)))))
 IL:STOP

sources/UFS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "18-Dec-2024 12:52:23" {WMEDLEY}<sources>UFS.;39
 79633  
+
(FILECREATED "27-Oct-2025 11:10:55" {WMEDLEY}<sources>UFS.;61
 91949  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \UFSRenameFile)
+      :CHANGES-TO (FNS \UFSDeleteFile)
 
-      :PREVIOUS-DATE "16-Sep-2023 09:22:55" {WMEDLEY}<sources>UFS.;38)
+      :PREVIOUS-DATE "17-Oct-2025 08:49:57" {WMEDLEY}<sources>UFS.;60)
 
 
 (PRETTYCOMPRINT UFSCOMS)
@@ -14,6 +14,11 @@
 (RPAQQ UFSCOMS

        [(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
               UFS)
+        [COMS 
+              (* ;; "For filename coercion before UNICODE-TABLES and UNICODE are loaded.  Until then, only files with 7-bit MCCS names are allowed.")

+
+              (P (MOVD? 'EVQ 'UTF8TOMSTRING)
+                 (MOVD? 'EVQ 'MTOUTF8STRING]
         (DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP)
                                                               DIRECTORY FILEIO))
         (INITVARS (\UFS.DEFAULT.EOLC NIL))
@@ -130,6 +135,17 @@
 (PUTPROPS UFS
 FILETYPE
 :BCOMPL)
 
 (PUTPROPS UFS
 MAKEFILE-ENVIRONMENT
 (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10))
+
+
+
+(* ;; 
+"For filename coercion before UNICODE-TABLES and UNICODE are loaded.  Until then, only files with 7-bit MCCS names are allowed."
+)

+
+
+(MOVD? 'EVQ 'UTF8TOMSTRING)
+
+(MOVD? 'EVQ 'MTOUTF8STRING)
 (DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY 
 
 (FILESLOAD (LOADCOMP)
@@ -274,23 +290,160 @@
 (DEFINEQ
 
 (\UFSOpenFile

-(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited  6-Jun-90 12:18 by nm") (* ;;; "Open a file.") (WITH.MONITOR (\UFSGetMonitor FDEV) (PROG ((ACC (SELECTQ ACCESS (INPUT ACCESS-INPUT) (OUTPUT ACCESS-OUTPUT) (BOTH ACCESS-BOTH) (APPEND ACCESS-APPEND) ACCESS-OTHER)) (REC (SELECTQ RECOG (OLD RECOG-OLD) (OLDEST RECOG-OLDEST) (NEW RECOG-NEW) (OLD/NEW RECOG-NEW-OLD) (SELECTQ ACCESS (INPUT RECOG-OLD) (OUTPUT RECOG-NEW) ((BOTH APPEND) RECOG-NEW-OLD) RECOG-OTHER))) (EOF-FN (FUNCTION \EOSERROR)) (ERRNO (CREATECELL \FIXP)) OTHER FILEID BYTESIZE CDATE FULLNAME CINFO STRM CASE.CORRECT.NAME CASE.CORRECT.FULLFILENAME) (SETQ CASE.CORRECT.NAME (if (type? STREAM FILE) then (COND ((fetch (UFSSTREAM FILEID) of FILE) (* ; "Already open--this really ought to be an error") (RETURN FILE)) (T (LET ((FULLNAME (fetch (UFSSTREAM UNIXNAME) of FILE))) (SETQ STRM FILE) (* ; "Re use the old stream") (SUBSTRING FULLNAME (ADD1 (STRPOS "}" FULLNAME)))))) else (\UFS.RECOGNIZE.FILE FILE RECOG FDEV))) (COND ((NOT CASE.CORRECT.NAME) (RETURN NIL)) ((AND (NULL OLDSTREAM) (EQ (fetch (FDEV DEVICENAME) of FDEV) (QUOTE DSK)) (SETQ OTHER (\UFS.OPENP CASE.CORRECT.NAME FDEV)) (SELECTQ ACCESS (INPUT (* ; "ok if other file is also input") (DIRTYABLE OTHER)) T)) (* ; "Access conflict.  Don't check this when just revalidating, of course.  I also don't mess with this on UNIX device--let user get in trouble...") (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME (\UFS.FULLNAME CASE.CORRECT.NAME FDEV)))) (SETQ CASE.CORRECT.FULLFILENAME (\UFS.ADD.HOST.FIELD CASE.CORRECT.NAME FDEV)) (* ;; "DSK cannot open a directory.") (AND (DSKP FDEV) (DIRECTORYNAMEP CASE.CORRECT.FULLFILENAME) (PROGN (PROMPTPRINT "{DSK} cannot open a directory file.  Use {UNIX} device.") (\UFSError CASE.CORRECT.NAME 23 FDEV))) (SETQ CDATE (CREATECELL \FIXP)) (SETQ BYTESIZE (CREATECELL \FIXP)) (SETQ FILEID (OR (\UFSOpenFile-C CASE.CORRECT.FULLFILENAME REC ACC CDATE BYTESIZE ERRNO) (RETURN (\UFSError CASE.CORRECT.NAME ERRNO FDEV)))) (if (= (IPLUS BYTESIZE 0) -1) then (SETQ EOF-FN (FUNCTION \DEVICEFILE.EOSERROR)) (SETQ BYTESIZE 0) elseif (EQ ACCESS (QUOTE OUTPUT)) then (SETQ BYTESIZE 0)) (if STRM then (replace (STREAM FULLFILENAME) of STRM with (\UFS.FULLNAME CASE.CORRECT.NAME FDEV T)) (replace (STREAM DEVICE) of STRM with FDEV) (replace (STREAM EPAGE) of STRM with (FOLDLO BYTESIZE BYTESPERPAGE)) (replace (STREAM EOFFSET) of STRM with (IMOD BYTESIZE BYTESPERPAGE)) (replace (STREAM EOLCONVENTION) of STRM with (\UFSeol CASE.CORRECT.NAME (FASSOC (QUOTE TYPE) OTHERINFO))) (replace (STREAM VALIDATION) of STRM with CDATE) (replace (STREAM ENDOFSTREAMOP) of STRM with EOF-FN) else (SETQ STRM (create STREAM FULLFILENAME _ (\UFS.FULLNAME CASE.CORRECT.NAME FDEV T) DEVICE _ FDEV EPAGE _ (FOLDLO BYTESIZE BYTESPERPAGE) EOFFSET _ (IMOD BYTESIZE BYTESPERPAGE) EOLCONVENTION _ (\UFSeol CASE.CORRECT.NAME (FASSOC (QUOTE TYPE) OTHERINFO)) VALIDATION _ CDATE ENDOFSTREAMOP _ EOF-FN))) (replace (UFSSTREAM FILEID) of STRM with FILEID) (replace (UFSSTREAM CDATE) of STRM with (if (SETQ CINFO (FASSOC (QUOTE CREATIONDATE) OTHERINFO)) then (IDATE (CADR CINFO)) else 0)) (replace (UFSSTREAM UNIXNAME) of STRM with CASE.CORRECT.FULLFILENAME) (* ; "Save the case sensitive full file name for closef & getfileinfo.") (RETURN STRM))))
-)
+  [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
       (* ; "Edited 16-Oct-2025 08:52 by rmk")


+                                                             (* ; "Edited  6-Jun-90 12:18 by nm")

+
+(* ;;; "Open a file.")

+
+    (WITH.MONITOR (\UFSGetMonitor FDEV)
+        (PROG ((ACC (SELECTQ ACCESS
+                        (INPUT ACCESS-INPUT)
+                        (OUTPUT ACCESS-OUTPUT)
+                        (BOTH ACCESS-BOTH)
+                        (APPEND ACCESS-APPEND)
+                        ACCESS-OTHER))
+               (REC (SELECTQ RECOG
+                        (OLD RECOG-OLD)
+                        (OLDEST RECOG-OLDEST)
+                        (NEW RECOG-NEW)
+                        (OLD/NEW RECOG-NEW-OLD)
+                        (SELECTQ ACCESS
+                            (INPUT RECOG-OLD)
+                            (OUTPUT RECOG-NEW)
+                            ((BOTH APPEND) 
+                                 RECOG-NEW-OLD)
+                            RECOG-OTHER)))
+               (EOF-FN (FUNCTION \EOSERROR))
+               (ERRNO (CREATECELL \FIXP))
+               OTHER FILEID BYTESIZE CDATE FULLNAME CINFO STRM CASE.CORRECT.NAME 
+               CASE.CORRECT.FULLFILENAME)
+
+         (* ;; "CASE.CORRECT.NAME is MCCS")

+
+              (SETQ CASE.CORRECT.NAME (if
 (type?
 STREAM FILE)
+                                          then
 [COND
+                                                  ((fetch
 (UFSSTREAM FILEID) of
 FILE)
+                                                             (* ; 
+
                                                     "Already open--this really ought to be an error")

+                                                   (RETURN FILE))
+                                                  (T (LET ((FULLNAME (fetch
 (UFSSTREAM UNIXNAME)
+                                                                        of
 FILE)))
+                                                          (SETQ STRM FILE)
+                                                             (* ; "Re use the old stream")

+                                                          (SUBSTRING FULLNAME (ADD1 (STRPOS "}" 
+                                                                                           FULLNAME]
+                                        else
 (\UFS.RECOGNIZE.FILE
 FILE RECOG FDEV)))
+              [COND
+                 ((NOT CASE.CORRECT.NAME)
+                  (RETURN NIL))
+                 ((AND (NULL OLDSTREAM)
+                       (EQ (fetch
 (FDEV DEVICENAME) of
 FDEV)
+                           'DSK)
+                       (SETQ OTHER (\UFS.OPENP
 CASE.CORRECT.NAME FDEV))
+                       (SELECTQ ACCESS
+                           (INPUT                            (* ; "ok if other file is also input")

+                                  (DIRTYABLE OTHER))
+                           T))                               (* ; "Access conflict.  Don't check this when just revalidating, of course.  I also don't mess with this on UNIX device--let user get in trouble...")

+                  (CL:ERROR 'XCL:FILE-WONT-OPEN :PATHNAME (\UFS.FULLNAME
 CASE.CORRECT.NAME FDEV]
+              (SETQ CASE.CORRECT.FULLFILENAME (\UFS.ADD.HOST.FIELD
 CASE.CORRECT.NAME FDEV))
+
+         (* ;; "DSK cannot open a directory.")

+
+              (AND (DSKP FDEV)
+                   (DIRECTORYNAMEP CASE.CORRECT.FULLFILENAME)
+                   (PROGN (PROMPTPRINT "{DSK} cannot open a directory file.  Use {UNIX} device.")
+                          (\UFSError
 CASE.CORRECT.NAME 23 FDEV)))
+              (SETQ CDATE (CREATECELL \FIXP))
+              (SETQ BYTESIZE (CREATECELL \FIXP))
+              [SETQ FILEID (OR (\UFSOpenFile-C (MTOUTF8STRING CASE.CORRECT.FULLFILENAME)
+                                      REC ACC CDATE BYTESIZE ERRNO)
+                               (RETURN (\UFSError
 CASE.CORRECT.NAME ERRNO FDEV]
+              (if
 (= (IPLUS BYTESIZE 0)
+                     -1)
+                  then
 (SETQ EOF-FN (FUNCTION \DEVICEFILE.EOSERROR))
+                       (SETQ BYTESIZE 0)
+                elseif
 (EQ ACCESS 'OUTPUT)
+                  then
 (SETQ BYTESIZE 0))
+              (if
 STRM
+                  then
 (replace
 (STREAM FULLFILENAME) of
 STRM with
 (\UFS.FULLNAME
 CASE.CORRECT.NAME 
+                                                                          FDEV T))
+                       (replace
 (STREAM DEVICE) of
 STRM with
 FDEV)
+                       (replace
 (STREAM EPAGE) of
 STRM with
 (FOLDLO BYTESIZE BYTESPERPAGE))
+                       (replace
 (STREAM EOFFSET) of
 STRM with
 (IMOD BYTESIZE BYTESPERPAGE))
+                       (replace
 (STREAM EOLCONVENTION) of
 STRM with
 (\UFSeol
 CASE.CORRECT.NAME
+                                                                           (FASSOC 'TYPE OTHERINFO)))
+                       (replace
 (STREAM VALIDATION) of
 STRM with
 CDATE)
+                       (replace
 (STREAM ENDOFSTREAMOP) of
 STRM with
 EOF-FN)
+                else
 (SETQ STRM (create
 STREAM
+                                       FULLFILENAME _ (\UFS.FULLNAME
 CASE.CORRECT.NAME FDEV T)
+                                       DEVICE _ FDEV
+                                       EPAGE _ (FOLDLO BYTESIZE BYTESPERPAGE)
+                                       EOFFSET _ (IMOD BYTESIZE BYTESPERPAGE)
+                                       EOLCONVENTION _ (\UFSeol
 CASE.CORRECT.NAME (FASSOC
+                                                                                   'TYPE OTHERINFO))
+                                       VALIDATION _ CDATE
+                                       ENDOFSTREAMOP _ EOF-FN)))
+              (replace
 (UFSSTREAM FILEID) of
 STRM with
 FILEID)
+              (replace
 (UFSSTREAM CDATE) of
 STRM with
 (if
 (SETQ CINFO (FASSOC 'CREATIONDATE OTHERINFO
+                                                                             ))
+                                                          then
 (IDATE (CADR CINFO))
+                                                        else
 0))
+              (replace
 (UFSSTREAM UNIXNAME) of
 STRM with
 CASE.CORRECT.FULLFILENAME)
+                                                             (* ; 
+
                                   "Save the case sensitive full file name for closef & getfileinfo.")

+              (RETURN STRM)))])
 
 (\UFS.OPENP

 (LAMBDA (UNIXNAME DEV) (* ; "Edited  3-Mar-89 11:47 by bvm") (* ;; "Returns first open file having specified unix name") (for S in (fetch (FDEV OPENFILELST) of DEV) bind (COMPAREFN _ (if (EQ (fetch (FDEV DEVICENAME) of DEV) (QUOTE DSK)) then (* ; "We're case-insensitive, and it seems like not all functions return the correct Unix case") (FUNCTION STRING-EQUAL) else (* ; "Exact") (FUNCTION STREQUAL))) thereis (CL:FUNCALL COMPAREFN UNIXNAME (fetch (UFSSTREAM UNIXNAME) of S))))
 )
 
 (\UFS.RECOGNIZE.FILE

-(LAMBDA (FILENAME RECOG DEV) (* ; "Edited 13-Mar-90 11:19 by nm") (* ;; "Perform recognition on FILENAME, returning the %"true%" name for the file, or NIL.  The result file name is following the Xerox Lisp file naming convention but does not include HOST field.  It will be supplied by \UFS.FULLNAME.") (WITH.MONITOR (\UFSGetMonitor DEV) (LET ((NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) (ERRNO (CREATECELL \FIXP)) LEN) (SETQ LEN (CL:FUNCALL (\UFS.FILE.RECOGNIZER DEV) (\UFS.REMOVE.HOST.FIELD FILENAME DEV) (SELECTQ RECOG (OLD RECOG-OLD) (OLDEST RECOG-OLDEST) (NEW RECOG-NEW) (OLD/NEW RECOG-NEW-OLD) (NON RECOG-NON) RECOG-NEW-OLD) NAMEAREA ERRNO)) (COND ((FIXP LEN) (SUBSTRING NAMEAREA 1 LEN)) (T (\UFSError FILENAME ERRNO))))))
-)
+  [LAMBDA (FILENAME RECOG DEV)
                               (* ; "Edited 16-Oct-2025 10:19 by rmk")


+                                                             (* ; "Edited 13-Mar-90 11:19 by nm")

+
+    (* ;; "This assumes that input FILENAME is MCCS, returns MCCS")

+
+    (* ;; "Perform recognition on FILENAME, returning the %"true%" name for the file, or NIL.  The result file name is following the Xerox Lisp file naming convention but does not include HOST field.  It will be supplied by \UFS.FULLNAME.")

+
+    (WITH.MONITOR (\UFSGetMonitor DEV)
+        [LET ((NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN))
+              (ERRNO (CREATECELL \FIXP))
+              LEN)
+             (SETQ LEN (CL:FUNCALL (\UFS.FILE.RECOGNIZER DEV)
+                              (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD
 FILENAME DEV))
+                              (SELECTQ RECOG
+                                  (OLD RECOG-OLD)
+                                  (OLDEST RECOG-OLDEST)
+                                  (NEW RECOG-NEW)
+                                  (OLD/NEW RECOG-NEW-OLD)
+                                  (NON RECOG-NON)
+                                  RECOG-NEW-OLD)
+                              NAMEAREA ERRNO))
+             (COND
+                ((FIXP LEN)
+                 (UTF8TOMSTRING (SUBSTRING NAMEAREA 1 LEN)))
+                (T (\UFSError
 FILENAME ERRNO])])
 
 (\UFS.DIRECTORY.NAME

-(LAMBDA (DIRSTRING NAMEAREA DEV) (* ; "Edited  1-Apr-90 23:36 by nm") (* ;;; "Accepts a Xerox Lisp canonical directory name, and recognize it.  If such directory exists, sets the %"ture%" name of the directory in  NAMEAREA and returns the length of the name.  If such directory does not exist, returns NIL.  The canonical directory name does not include the initial directory delimiter and the trail directory delimiter, but the result %"ture%" name includes both of them.  If DIRSTRING is %"<%", it means the root directory.") (if (STREQUAL DIRSTRING "<") then (RPLSTRING NAMEAREA 1 "<") 1 else (WITH.MONITOR (\UFSGetMonitor DEV) (CL:FUNCALL (\UFS.DIRECTORY.RECOGNIZER DEV) DIRSTRING NAMEAREA (CREATECELL \FIXP)))))
-)
+  [LAMBDA (DIRSTRING NAMEAREA DEV)
                           (* ; "Edited 15-Oct-2025 16:30 by rmk")


+                                                             (* ; "Edited  1-Apr-90 23:36 by nm")

+
+(* ;;; "Accepts a Xerox Lisp canonical directory name, and recognize it.  If such directory exists, sets the %"true%" name of the directory in  NAMEAREA and returns the length of the name.  If such directory does not exist, returns NIL.  The canonical directory name does not include the initial directory delimiter and the trail directory delimiter, but the result %"true%" name includes both of them.  If DIRSTRING is %"<%", it means the root directory.")

+
+    (* ;; "DIRSTRING is MCCS, the true name is not")

+
+    (if
 (STREQUAL DIRSTRING "<")
+        then
 (RPLSTRING NAMEAREA 1 "<")
+             1
+      else
 (WITH.MONITOR (\UFSGetMonitor DEV)
+               (CL:FUNCALL (\UFS.DIRECTORY.RECOGNIZER DEV)
+                      (MTOUTF8STRING DIRSTRING)
+                      NAMEAREA
+                      (CREATECELL \FIXP)))])
 
 (\UFSCloseFile

-  [LAMBDA (STREAMFILE)
                                    (* ; "Edited 16-Sep-2023 09:21 by briggs")


+  [LAMBDA (STREAMFILE)
                                       (* ; "Edited 16-Oct-2025 13:47 by rmk")


+                                                          (* ; "Edited 16-Sep-2023 09:21 by briggs")


                                                              (* ; "Edited 30-Mar-90 10:39 by nm")

                                                              (* ; "return stream")

 
@@ -314,7 +467,8 @@
               then
                                           (* ; "Open for output")

                    (FDEVOP 'TRUNCATEFILE DEVICE STREAMFILE)
                    (SETQ CDATE (fetch
 (UFSSTREAM CDATE) of
 STREAMFILE)))
-          (RETURN (if
 (\UFSCloseFile-C UNIXNAME (fetch
 (UFSSTREAM FILEID) of
 STREAMFILE)
+          (RETURN (if
 (\UFSCloseFile-C (MTOUTF8STRING UNIXNAME)
+                             (fetch
 (UFSSTREAM FILEID) of
 STREAMFILE)
                              CDATE ERRNO)
                       then
 (replace
 (UFSSTREAM FILEID) of
 STREAMFILE with
 NIL)
                            (replace
 (UFSSTREAM CDATE) of
 STREAMFILE with
 NIL) 
@@ -328,11 +482,26 @@
 )
 
 (\UFSDeleteFile

-(LAMBDA (FILENAME DEV) (* ; "Edited 30-Mar-90 10:46 by nm") (* ; "return deleted file name") (* ; "if error, return NIL") (WITH.MONITOR (\UFSGetMonitor DEV) (LET ((NAME (\UFS.RECOGNIZE.FILE FILENAME (QUOTE OLDEST) DEV))) (COND ((AND NAME (NOT (\UFS.OPENP NAME DEV))) (* ; "file found and not open, so try to delete") (LET ((ERRNO (CREATECELL \FIXP))) (COND ((\UFSDeleteFile-C (\UFS.REMOVE.HOST.FIELD NAME DEV) DEV ERRNO) (* ; "Success") (\UFS.FULLNAME NAME DEV T)) (T (* ; "Failure") (\UFSError NAME ERRNO DEV)))))))))
-)
+  [LAMBDA (FILENAME DEV)
                                     (* ; "Edited 27-Oct-2025 11:10 by rmk")


+                                                             (* ; "Edited 30-Mar-90 10:46 by nm")

+                                                             (* ; "return deleted file name")

+                                                             (* ; "if error, return NIL")

+    (WITH.MONITOR (\UFSGetMonitor DEV)
+        [LET ((NAME (\UFS.RECOGNIZE.FILE
 FILENAME 'OLDEST DEV)))
+             (COND
+                ((AND NAME (NOT (\UFS.OPENP
 NAME DEV)))      (* ; 
+
                                                          "file found and not open, so try to delete")

+                 (LET ((ERRNO (CREATECELL \FIXP)))
+                      (COND
+                         ((\UFSDeleteFile-C (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD
 NAME DEV))
+                                 DEV ERRNO)                  (* ; "Success")

+                          (\UFS.FULLNAME
 NAME DEV T))
+                         (T                                  (* ; "Failure")

+                            (\UFSError
 NAME ERRNO DEV])])
 
 (\UFSRenameFile

-  [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME)
          (* ; "Edited 18-Dec-2024 12:52 by rmk")


+  [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME)
          (* ; "Edited 16-Oct-2025 08:46 by rmk")


+                                                             (* ; "Edited 18-Dec-2024 12:52 by rmk")


                                                              (* ; "Edited 16-Apr-90 13:46 by nm")

     (if
 (NEQ OLD-DEVICE NEW-DEVICE)
         then
 
@@ -349,8 +518,10 @@
                          (LET ((NEWUNIXNAME (\UFS.RECOGNIZE.FILE
 NEW-NAME 'NEW NEW-DEVICE))
                                (ERRNO (CREATECELL \FIXP)))
                               (COND
-                                 ((\UFSRenameFile-C (\UFS.REMOVE.HOST.FIELD
 OLDUNIXNAME OLD-DEVICE)
-                                         (\UFS.REMOVE.HOST.FIELD
 NEWUNIXNAME NEW-DEVICE)
+                                 ((\UFSRenameFile-C (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD
 
+                                                                          OLDUNIXNAME OLD-DEVICE))
+                                         (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD
 NEWUNIXNAME 
+                                                               NEW-DEVICE))
                                          NEW-DEVICE ERRNO)
                                   (\UFS.FULLNAME
 NEWUNIXNAME NEW-DEVICE))
                                  (T (if
 (EQL (IPLUS ERRNO 0)
@@ -372,32 +543,200 @@
 )
 
 (\UFSTruncateFile

-(LAMBDA (STREAM PAGE# OFFSET) (* ; "Edited 22-Aug-90 16:46 by nm") (* ;;; "Used to shorten or lengthen STREAM.  If lengthening, pad the file with nulls.  Used by SETEOFPTR and FORCEOUTPUT.") (\UPDATEOF STREAM) (OR (FIXP PAGE#) (SETQ PAGE# (fetch (STREAM EPAGE) of STREAM))) (OR (FIXP OFFSET) (SETQ OFFSET (fetch (STREAM EOFFSET) of STREAM))) (* ; "Truncate size was set to PAGE# and OFFSET") (PROG ((curEof (+ (UNFOLD (fetch (STREAM EPAGE) of STREAM) BYTESPERPAGE) (fetch (STREAM EOFFSET) of STREAM))) (needSize (+ (UNFOLD PAGE# BYTESPERPAGE) OFFSET)) (ERRNO (CREATECELL \FIXP))) (if (> needSize curEof) then (* ; "Push 0 to extend file.") (LET ((FILEPTR (\GETFILEPTR STREAM))) (\SETFILEPTR STREAM curEof) (to (- needSize curEof) do (\BOUT STREAM 0)) (\SETFILEPTR STREAM FILEPTR)) elseif T then (* ; "Call c to shorten file.  It would be good if we kept track of the file's eof, so that we wouldn't have to do this on closef when nothing had changed") (OR (\UFSGetSize-C (fetch (UFSSTREAM FILEID) of STREAM) needSize ERRNO) (RETURN (\UFSError STREAM ERRNO))) else (RETURN)) (* ;; "Set new value to stream") (replace (STREAM EPAGE) of STREAM with PAGE#) (replace (STREAM EOFFSET) of STREAM with OFFSET) (LET ((DT (CREATECELL \FIXP))) (* ;; "Set new validation value. UNIX mtime is updated, so Lisp stream validation must be updated.") (if (\UFSGetFileInfo-C (fetch (UFSSTREAM UNIXNAME) of STREAM) ATTR-WDATE DT ERRNO) then (replace (STREAM VALIDATION) of STREAM with DT)))))
-)
+  [LAMBDA (STREAM PAGE# OFFSET)
                              (* ; "Edited 16-Oct-2025 08:56 by rmk")


+                                                             (* ; "Edited 22-Aug-90 16:46 by nm")

+
+(* ;;; "Used to shorten or lengthen STREAM.  If lengthening, pad the file with nulls.  Used by SETEOFPTR and FORCEOUTPUT.")

+
+    (\UPDATEOF STREAM)
+    (OR (FIXP PAGE#)
+        (SETQ PAGE# (fetch
 (STREAM EPAGE) of
 STREAM)))
+    (OR (FIXP OFFSET)
+        (SETQ OFFSET (fetch
 (STREAM EOFFSET) of
 STREAM)))    (* ; 
+
                                                          "Truncate size was set to PAGE# and OFFSET")

+    (PROG ((curEof (+ (UNFOLD (fetch
 (STREAM EPAGE) of
 STREAM)
+                             BYTESPERPAGE)
+                      (fetch
 (STREAM EOFFSET) of
 STREAM)))
+           (needSize (+ (UNFOLD PAGE# BYTESPERPAGE)
+                        OFFSET))
+           (ERRNO (CREATECELL \FIXP)))
+          (if
 (> needSize curEof)
+              then
                                           (* ; "Push 0 to extend file.")

+                   (LET ((FILEPTR (\GETFILEPTR STREAM)))
+                        (\SETFILEPTR STREAM curEof)
+                        (to
 (- needSize curEof) do
 (\BOUT STREAM 0))
+                        (\SETFILEPTR STREAM FILEPTR))
+            else
                                             (* ; "Call c to shorten file.  It would be good if we kept track of the file's eof, so that we wouldn't have to do this on closef when nothing had changed")

+                 (OR (\UFSGetSize-C (fetch
 (UFSSTREAM FILEID) of
 STREAM)
+                            needSize ERRNO)
+                     (RETURN (\UFSError
 STREAM ERRNO)))
+            else
 (RETURN))
+
+     (* ;; "Set new value to stream")

+
+          (replace
 (STREAM EPAGE) of
 STREAM with
 PAGE#)
+          (replace
 (STREAM EOFFSET) of
 STREAM with
 OFFSET)
+          (LET ((DT (CREATECELL \FIXP)))
+
+               (* ;; 
+
        "Set new validation value. UNIX mtime is updated, so Lisp stream validation must be updated.")

+
+               (if
 (\UFSGetFileInfo-C (MTOUTF8STRING (fetch
 (UFSSTREAM UNIXNAME) of
 STREAM))
+                          ATTR-WDATE DT ERRNO)
+                   then
 (replace
 (STREAM VALIDATION) of
 STREAM with
 DT])
 
 (\UFSDirectoryNameP

-(LAMBDA (DIRSPEC DEV) (* ; "Edited 21-Sep-92 15:27 by jds") (* ;;; " DIRECTORYNAMEP FDEV method.   Performs a recognition as well and returns the %"true%" name if it exists.") (LET ((DIRECTORY (CONCAT (OR (UNPACKFILENAME.STRING DIRSPEC (QUOTE DEVICE)) "") (OR (UNPACKFILENAME.STRING DIRSPEC (QUOTE DIRECTORY) (QUOTE RETURN)) (\UFS.HANDLE.RELATIVEDIRECTORY (UNPACKFILENAME.STRING DIRSPEC (QUOTE RELATIVEDIRECTORY) (QUOTE RETURN)) DEV) (\UFS.DEFAULT.DIR DEV)))) NAMEAREA LEN) (* ;; " HOST field of DIRSPEC has been defaulted by the generic file system code.  Thus we don't have to worry about the subdirectory case.") (COND (DIRECTORY (SETQ NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) (* ; "NAMEAREA will be modified by C code and hold the %"true%" name of DIRECTORY if DIRECTORY is recognized as a valid directory name.") (SETQ LEN (\UFS.DIRECTORY.NAME DIRECTORY NAMEAREA DEV)) (COND ((FIXP LEN) (* ; "LEN holds the length of the %"true%" name of DIRECTORY.") (\UFS.FULLNAME (SUBSTRING NAMEAREA 1 LEN) DEV NIL)) (T NIL))) (T NIL))))
-)
+  [LAMBDA (DIRSPEC DEV)
                                      (* ; "Edited 16-Oct-2025 10:23 by rmk")


+                                                             (* ; "Edited 21-Sep-92 15:27 by jds")

+
+(* ;;; " DIRECTORYNAMEP FDEV method.   Performs a recognition as well and returns the %"true%" name if it exists.")

+
+    (LET ([DIRECTORY (CONCAT (OR (UNPACKFILENAME.STRING DIRSPEC 'DEVICE)
+                                 "")
+                            (OR (UNPACKFILENAME.STRING DIRSPEC 'DIRECTORY 'RETURN)
+                                (\UFS.HANDLE.RELATIVEDIRECTORY
 (UNPACKFILENAME.STRING DIRSPEC
+                                                                      'RELATIVEDIRECTORY
+                                                                      'RETURN)
+                                       DEV)
+                                (\UFS.DEFAULT.DIR DEV]
+          NAMEAREA LEN)
+
+         (* ;; " HOST field of DIRSPEC has been defaulted by the generic file system code.  Thus we don't have to worry about the subdirectory case.")

+
+         (COND
+            (DIRECTORY (SETQ NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN))
+                                                             (* ; "NAMEAREA will be modified by C code and hold the %"true%" name of DIRECTORY if DIRECTORY is recognized as a valid directory name.")

+                   (SETQ LEN (\UFS.DIRECTORY.NAME
 DIRECTORY NAMEAREA DEV))
+                   (COND
+                      ((FIXP LEN)                            (* ; 
+
                                            "LEN holds the length of the %"true%" name of DIRECTORY.")

+                       (UTF8TOMSTRING (\UFS.FULLNAME
 (SUBSTRING NAMEAREA 1 LEN)
+                                             DEV NIL)))
+                      (T NIL)))
+            (T NIL])
 
 (\UFSEventFn

 (LAMBDA (Dev Event) (DECLARE (GLOBALVARS \UFS.GFS.TABLE)) (* ; "Edited  3-May-90 17:35 by nm") (WITH.MONITOR \UFStopMonitor (SELECTQ Event ((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM) (\UFSCloseDevice) (SELECTQ (MACHINETYPE) ((MAIKO) (\UFSOpenDevice) (* ;; "revalidate open streams (should probably move this into the SELECTQ above) ") (\UNVISIBLE.PAGED.REVALIDATEFILELST Dev) (\PAGED.REVALIDATEFILELST Dev) (MAPHASH \UFS.GFS.TABLE (FUNCTION (LAMBDA (VAL KEY) (\UFS.UNREGISTER.GFS VAL)))) (CLRHASH \UFS.GFS.TABLE)) NIL)) ((BEFORELOGOUT) (\UNVISIBLE.FLUSH.OPEN.STREAMS Dev) (* ; "flush output buffers.") (\FLUSH.OPEN.STREAMS Dev)) NIL)))
 )
 
 (\UFSGetFileInfo

-(LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 30-Mar-90 12:27 by nm") (* ;;; "Get the value of the attribute for a file.") (* ;;; "Allocate buffer to store the value.") (* ;;; "If attribute is AUTHOR, the type of the buffer is STRING.") (* ;;; "Otherwise the type of the buffer is FIXP.") (WITH.MONITOR (\UFSGetMonitor DEVICE) (LET ((FILENAME (if (type? STREAM STREAM) then (fetch (UFSSTREAM UNIXNAME) of STREAM) else (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE STREAM (QUOTE OLD) DEVICE) DEVICE NIL))) (ERRNO (CREATECELL \FIXP)) BUFFER NAMESIZE) (if FILENAME then (SELECTQ ATTRIBUTE (LENGTH (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (SIZE (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO) then (FOLDHI BUFFER BYTESPERPAGE) else (\UFSError FILENAME ERRNO DEVICE))) (TYPE (\UFSGetFileType FILENAME)) ((CREATIONDATE WRITEDATE) (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO) then (GDATE BUFFER) else (\UFSError FILENAME ERRNO DEVICE))) (READDATE (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO) then (GDATE BUFFER) else (\UFSError FILENAME ERRNO DEVICE))) ((ICREATIONDATE IWRITEDATE) (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (IREADDATE (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (AUTHOR (SETQ BUFFER (ALLOCSTRING MAX-UNAME-LEN)) (if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-AUTHOR BUFFER ERRNO)) then (CL:SUBSEQ BUFFER 0 NAMESIZE) else (\UFSError FILENAME ERRNO DEVICE))) (PROTECTION (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-PROTECTION BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (ALL (SETQ BUFFER (\UFS.CREATE.PROPS)) (if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-ALL BUFFER ERRNO)) then (LET ((ALIST (ASSOC (QUOTE AUTHOR) BUFFER))) (* ; "Copy string out of buffer") (RPLACD ALIST (CL:SUBSEQ (CDR ALIST) 0 NAMESIZE)) BUFFER) else (\UFSError FILENAME ERRNO DEVICE))) NIL)))))
-)
+  [LAMBDA (STREAM ATTRIBUTE DEVICE)
                          (* ; "Edited 16-Oct-2025 08:49 by rmk")


+                                                             (* ; "Edited 30-Mar-90 12:27 by nm")

+
+(* ;;; "Get the value of the attribute for a file.")

+
+(* ;;; "Allocate buffer to store the value.")

+
+(* ;;; "If attribute is AUTHOR, the type of the buffer is STRING.")

+
+(* ;;; "Otherwise the type of the buffer is FIXP.")

+
+    (WITH.MONITOR (\UFSGetMonitor DEVICE)
+        (LET ((FILENAME (if
 (type?
 STREAM STREAM)
+                            then
 (fetch
 (UFSSTREAM UNIXNAME) of
 STREAM)
+                          else
 (\UFS.FULLNAME
 (\UFS.RECOGNIZE.FILE
 STREAM 'OLD DEVICE)
+                                      DEVICE NIL)))
+              (ERRNO (CREATECELL \FIXP))
+              BUFFER NAMESIZE)
+             (if
 FILENAME
+                 then
 (SETQ FILENAME (MTOUTF8STRING FILENAME))
+                      (SELECTQ ATTRIBUTE
+                          (LENGTH (SETQ BUFFER (CREATECELL \FIXP))
+                                  (if
 (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO)
+                                      then
 BUFFER
+                                    else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (SIZE (SETQ BUFFER (CREATECELL \FIXP))
+                                (if
 (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO)
+                                    then
 (FOLDHI BUFFER BYTESPERPAGE)
+                                  else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (TYPE (\UFSGetFileType
 FILENAME))
+                          ((CREATIONDATE WRITEDATE) 
+                               (SETQ BUFFER (CREATECELL \FIXP))
+                               (if
 (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO)
+                                   then
 (GDATE BUFFER)
+                                 else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (READDATE (SETQ BUFFER (CREATECELL \FIXP))
+                                    (if
 (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO)
+                                        then
 (GDATE BUFFER)
+                                      else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          ((ICREATIONDATE IWRITEDATE) 
+                               (SETQ BUFFER (CREATECELL \FIXP))
+                               (if
 (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO)
+                                   then
 BUFFER
+                                 else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (IREADDATE (SETQ BUFFER (CREATECELL \FIXP))
+                                     (if
 (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO)
+                                         then
 BUFFER
+                                       else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (AUTHOR (SETQ BUFFER (ALLOCSTRING MAX-UNAME-LEN))
+                                  (if
 (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-AUTHOR BUFFER 
+                                                            ERRNO))
+                                      then
 (UTF8TOMSTRING (CL:SUBSEQ BUFFER 0 NAMESIZE))
+                                    else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (PROTECTION (SETQ BUFFER (CREATECELL \FIXP))
+                                      (if
 (\UFSGetFileInfo-C FILENAME ATTR-PROTECTION BUFFER ERRNO)
+                                          then
 BUFFER
+                                        else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          (ALL (SETQ BUFFER (\UFS.CREATE.PROPS
))
+                               (if
 (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-ALL BUFFER ERRNO))
+                                   then
 (LET ((ALIST (ASSOC 'AUTHOR BUFFER)))
+                                                             (* ; "Copy string out of buffer")

+                                             (RPLACD ALIST (CL:SUBSEQ (CDR ALIST)
+                                                                  0 NAMESIZE))
+                                             BUFFER)
+                                 else
 (\UFSError
 FILENAME ERRNO DEVICE)))
+                          NIL))))])
 
 (\UFS.CREATE.PROPS

 (LAMBDA NIL (* ; "Edited  2-Mar-89 12:10 by bvm") (* ;; "Returns a data structure suitable for passing to the GetFileInfo ALL routine") (BQUOTE ((LENGTH (\,@ (CREATECELL \FIXP))) (WDATE (\,@ (CREATECELL \FIXP))) (RDATE (\,@ (CREATECELL \FIXP))) (PROTECTION (\,@ (CREATECELL \FIXP))) (AUTHOR (\,@ (ALLOCSTRING MAX-UNAME-LEN))))))
 )
 
 (\UFSSetFileInfo

-(LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 30-Mar-90 12:31 by nm") (* ;;; "Get the VALUE of the ATTRIBUTE for a file.") (* ;;; "Allocate buffer to store the value.") (* ;;; "If attribute is AUTOR, the type of the buffer is STRING.") (* ;;; " Otherwise the type of the buffer is FIXP.") (WITH.MONITOR (\UFSGetMonitor DEVICE) (LET ((FILENAME (if (type? STREAM STREAM) then (fetch (UFSSTREAM UNIXNAME) of STREAM) else (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE STREAM (QUOTE OLD) DEVICE) DEVICE NIL))) (ERRNO (CREATECELL \FIXP)) BUFFER NAMESIZE PATHNAME) (if FILENAME then (SELECTQ ATTRIBUTE (TYPE (\UFSSetFileType FILENAME VALUE)) ((CREATIONDATE WRITEDATE) (if (AND (STRINGP VALUE) (SETQ VALUE (IDATE VALUE))) then (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO) (\UFSError FILENAME ERRNO DEVICE)) else (ERROR "Invalid argument" VALUE))) ((ICREATIONDATE IWRITEDATE) (if (FIXP VALUE) then (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO) (\UFSError FILENAME ERRNO DEVICE)) else (ERROR "Invalid argument" VALUE))) (PROTECTION (if (FIXP VALUE) then (OR (\UFSSetFileInfo-C FILENAME ATTR-PROTECTION VALUE ERRNO) (\UFSError FILENAME ERRNO DEVICE)) else (ERROR "Invalid argument" VALUE))) NIL)))))
-)
+  [LAMBDA (STREAM ATTRIBUTE VALUE DEVICE)
                    (* ; "Edited 16-Oct-2025 08:51 by rmk")


+                                                             (* ; "Edited 30-Mar-90 12:31 by nm")

+
+(* ;;; "Get the VALUE of the ATTRIBUTE for a file.")

+
+(* ;;; "Allocate buffer to store the value.")

+
+(* ;;; "If attribute is AUTOR, the type of the buffer is STRING.")

+
+(* ;;; " Otherwise the type of the buffer is FIXP.")

+
+    (WITH.MONITOR (\UFSGetMonitor DEVICE)
+        (LET ((FILENAME (if
 (type?
 STREAM STREAM)
+                            then
 (fetch
 (UFSSTREAM UNIXNAME) of
 STREAM)
+                          else
 (\UFS.FULLNAME
 (\UFS.RECOGNIZE.FILE
 STREAM 'OLD DEVICE)
+                                      DEVICE NIL)))
+              (ERRNO (CREATECELL \FIXP))
+              BUFFER NAMESIZE PATHNAME)
+             (if
 FILENAME
+                 then
 (SETQ FILENAME (MTOUTF8STRING FILENAME))
+                      (SELECTQ ATTRIBUTE
+                          (TYPE (\UFSSetFileType
 FILENAME VALUE))
+                          ((CREATIONDATE WRITEDATE) 
+                               (if
 (AND (STRINGP VALUE)
+                                        (SETQ VALUE (IDATE VALUE)))
+                                   then
 (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO)
+                                            (\UFSError
 FILENAME ERRNO DEVICE))
+                                 else
 (ERROR "Invalid argument" VALUE)))
+                          ((ICREATIONDATE IWRITEDATE) 
+                               (if
 (FIXP VALUE)
+                                   then
 (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO)
+                                            (\UFSError
 FILENAME ERRNO DEVICE))
+                                 else
 (ERROR "Invalid argument" VALUE)))
+                          (PROTECTION (if
 (FIXP VALUE)
+                                          then
 (OR (\UFSSetFileInfo-C FILENAME ATTR-PROTECTION VALUE
+                                                          ERRNO)
+                                                   (\UFSError
 FILENAME ERRNO DEVICE))
+                                        else
 (ERROR "Invalid argument" VALUE)))
+                          NIL))))])
 
 (\UFSGenerateFiles

   [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS)
 
+    (* ;; "Edited 16-Oct-2025 11:06 by rmk")

+
     (* ;; "Edited 27-Mar-2022 15:55 by rmk: Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults")

 
     (* ;; "rmk; Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults")

@@ -435,19 +774,22 @@
                (COND
                   ((STREQUAL DIRECTORY "/")
                    (SETQ DIRECTORY "<")))
-               [SETQ FILTER (COND
-                               ((STREQUAL DIRECTORY "<")
-                                (CONCAT "{" (LISTGET PARSED 'HOST)
-                                       "}"
-                                       (OR DEVICE "")
-                                       "<"
-                                       (PACKFILENAME.STRING 'NAME NAME 'EXTENSION EXTENSION
-                                              'VERSION VERSION)))
-                               (T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY 'HOST (LISTGET
-                                                                                   PARSED
-                                                                                   'HOST)
-                                         'DEVICE DEVICE 'NAME NAME 'EXTENSION EXTENSION 'VERSION 
-                                         VERSION]
+
+         (* ;; "DIRECTORY is MCCS, FILTER is UTF8")

+
+               [SETQ FILTER (MTOUTF8STRING (COND
+                                              ((STREQUAL DIRECTORY "<")
+                                               (CONCAT "{" (LISTGET PARSED 'HOST)
+                                                      "}"
+                                                      (OR DEVICE "")
+                                                      "<"
+                                                      (PACKFILENAME.STRING 'NAME NAME 'EXTENSION 
+                                                             EXTENSION 'VERSION VERSION)))
+                                              (T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY
+                                                        'HOST
+                                                        (LISTGET PARSED 'HOST)
+                                                        'DEVICE DEVICE 'NAME NAME 'EXTENSION 
+                                                        EXTENSION 'VERSION VERSION]
                (SETQ LEN (\UFS.DIRECTORY.NAME
 (CONCAT (OR DEVICE "")
                                                      DIRECTORY)
                                 NAMEAREA FDEV))
@@ -455,7 +797,7 @@
                   ((NOT (FIXP LEN))                          (* ; "No such directory.  We go thru this recognition step so that \UFSFindFile gives us name in the correct case")

                    (PRINTOUT PROMPTWINDOW T "Can't enumerate " PATTERN " because no such directory")
                    (RETURN (\NULLFILEGENERATOR]
-               (SETQ DIRECTORY (SUBSTRING NAMEAREA 1 LEN))
+               (SETQ DIRECTORY (SUBSTRING NAMEAREA 1 LEN))   (* ; "DIRECTORY is now UTF8")

 
          (* ;; "The information about enumerated files are cached in the emulator.  We receive the ID and the total number of enumerated files.  The ID is used to identify the object corresponding to the enumerated file.")

 
@@ -466,7 +808,8 @@
                     (SETQ TOTALNUM (\UFSReadDir-C FILTER PROPP ID ERRNO))
                     (COND
                        [(< TOTALNUM 0)
-                        (OR (\UFSError
 DIRECTORY ERRNO FDEV)
+                        (OR (\UFSError
 (UTF8TOMSTRING DIRECTORY)
+                                   ERRNO FDEV)
                             (RETURN (\NULLFILEGENERATOR]
                        (T (COND
                              ((ZEROP TOTALNUM)
@@ -475,6 +818,9 @@
                                               (EQ OPTIONS 'RESETLST))
                                          (FMEMB 'RESETLST OPTIONS))
                                      (RESETSAVE NIL '(AND RESETSTATE (\UFSFinishFileInfo-C ID]
+
+                                (* ;; "Everything in FILEGENOBJ is UTF8")

+
                                 (RETURN (create
 FILEGENOBJ
                                                NEXTFILEFN _ (FUNCTION \UFS.NEXTFILEFN)
                                                FILEINFOFN _ (FUNCTION \UFS.FILEINFOFN)
@@ -496,24 +842,31 @@
                                                                          CURRENT-DEPTH _ 1
                                                                          MAX-DEPTH _ 
                                                                          FILING.ENUMERATION.DEPTH
-                                                                         FILTER _ (
-                                                                                  PACKFILENAME.STRING
-                                                                                   'NAME NAME
-                                                                                   'EXTENSION 
-                                                                                   EXTENSION
-                                                                                   'VERSION VERSION])
-    ])
+                                                                         FILTER _
+                                                                         (PACKFILENAME.STRING
+                                                                          'NAME
+                                                                          (AND NAME (MTOUTF8STRING
+                                                                                     NAME))
+                                                                          'EXTENSION
+                                                                          (AND EXTENSION (
+                                                                                        MTOUTF8STRING
+                                                                                          EXTENSION))
+                                                                          'VERSION VERSION])])
 
 (\UFS.NEXTFILEFN

   [LAMBDA (GENFILESTATE NAMEONLY)
 
+    (* ;; "Edited 16-Oct-2025 16:59 by rmk")

+
     (* ;; 
 
    "Edited 27-Mar-2022 21:59 by rmk: Add FILTER to construct proper generator for subdirectories")

 
     (* ;; "Edited  7-Oct-93 14:31 by jds")

 
     (* ;; "Given a UFS filesystem generator, return the %"next%" file in line.")

-                                                             (* ; "")

+
+    (* ;; "All the fields of  the UFSGENFILESTATE are UTF8.  FILENAME is MCCS")

+
     (LET ((SUBGEN (fetch
 (UFSGENFILESTATE SUBGENERATOR) of
 GENFILESTATE))
           FILENAME NAMELEN NEWNAME)
          (COND
@@ -556,6 +909,9 @@
                                                                                          GENFILESTATE
                                                                  )
                                                       0 NAMELEN))
+
+                                 (* ;; "NEWNAME and DIRECTORY are both UTF8")

+
                                  (SETQ FILENAME (\UFS.FULLNAME.M (fetch
 (UFSGENFILESTATE DIRECTORY)
                                                                     of
 GENFILESTATE)
                                                        NEWNAME
@@ -607,8 +963,8 @@
                                      (* ;; "We're set up to recurse into the SUBGEN above")

 
                                      (\UFS.NEXTFILEFN
 GENFILESTATE NAMEONLY))
-                                    (NAMEONLY NEWNAME)
-                                    (T FILENAME)))
+                                    (NAMEONLY (UTF8TOMSTRING NEWNAME))
+                                    (T (UTF8TOMSTRING FILENAME))))
                              (AND RESETSTATE (\UFS.UNREGISTER.GFS
 GENFILESTATE T)))])
 
 (\UFS.FILEINFOFN

@@ -720,8 +1076,25 @@
 (DEFINEQ
 
 (CHDIR

-(LAMBDA (PATHNAME) (* ; "Edited  2-Apr-90 01:07 by nm") (* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") (WITH.MONITOR \UFStopMonitor (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) HOST) (if PATH then (SETQ HOST (U-CASE (FILENAMEFIELD PATH (QUOTE HOST)))) (if (OR (EQ HOST (QUOTE DSK)) (EQ HOST (QUOTE UNIX))) then (if (SETQ PATH (DIRECTORYNAME PATH)) then (if (\UFSCHDIR-C PATH) then (DIRECTORYNAME PATH) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "Bad Host Name" HOST)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)))))
-)
+  [LAMBDA (PATHNAME)
                                         (* ; "Edited 16-Oct-2025 18:22 by rmk")


+                                                             (* ; "Edited  2-Apr-90 01:07 by nm")

+
+(* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.")

+
+    (WITH.MONITOR \UFStopMonitor
+        (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME))
+              HOST)
+             (if
 PATH
+                 then
 [SETQ HOST (U-CASE (FILENAMEFIELD PATH 'HOST]
+                      (if
 (OR (EQ HOST 'DSK)
+                              (EQ HOST 'UNIX))
+                          then
 (if
 (SETQ PATH (DIRECTORYNAME PATH))
+                                   then
 (if
 (\UFSCHDIR-C (MTOUTF8STRING PATH))
+                                            then
 (DIRECTORYNAME PATH)
+                                          else
 (ERROR "NO-SUCH-DIRECTORY" PATHNAME))
+                                 else
 (ERROR "NO-SUCH-DIRECTORY" PATHNAME))
+                        else
 (ERROR "Bad Host Name" HOST))
+               else
 (ERROR "NO-SUCH-DIRECTORY" PATHNAME))))])
 )
 
 
@@ -1184,23 +1557,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8857 10410 (\UFSCreateDevice 8867 . 9232) (\UFS.CREATE.DEVICE 9234 . 10090) (
-\UFSOpenDevice 10092 . 10269) (\UFSCloseDevice 10271 . 10408)) (14673 52047 (\UFSOpenFile 14683 . 
-17977) (\UFS.OPENP 17979 . 18476) (\UFS.RECOGNIZE.FILE 18478 . 19231) (\UFS.DIRECTORY.NAME 19233 . 
-19976) (\UFSCloseFile 19978 . 21883) (\UFSGetFileName 21885 . 22084) (\UFSDeleteFile 22086 . 22626) (
-\UFSRenameFile 22628 . 24665) (\UFSReadPages 24667 . 25802) (\UFSWritePages 25804 . 27024) (
-\UFSTruncateFile 27026 . 28523) (\UFSDirectoryNameP 28525 . 29579) (\UFSEventFn 29581 . 30243) (
-\UFSGetFileInfo 30245 . 32527) (\UFS.CREATE.PROPS 32529 . 32882) (\UFSSetFileInfo 32884 . 34113) (
-\UFSGenerateFiles 34115 . 40995) (\UFS.NEXTFILEFN 40997 . 48635) (\UFS.FILEINFOFN 48637 . 50086) (
-\UFS.VALID.PROPP 50088 . 50380) (\UFS.REGISTER.GFS 50382 . 50637) (\UFS.UNREGISTER.GFS 50639 . 51222) 
-(\UFS.ABORT.DIRECTORY 51224 . 51572) (\UFS.ABORT.CL-DIRECTORY 51574 . 51861) (\UFS.CLEANUP.GFS.TABLE 
-51863 . 52045)) (52082 58766 (\UFSMakeUnixFormatName 52092 . 53113) (\UFSParseNameString 53115 . 53489
-) (\UFSParse-Directory 53491 . 54032) (\UFS.PARSE.BODY 54034 . 54579) (\UFS.ADJUST.HOST 54581 . 54740)
- (\UFS.FULLNAME 54742 . 55950) (\UFS.ADD.HOST.FIELD 55952 . 56312) (\UFS.REMOVE.HOST.FIELD 56314 . 
-57984) (\UFS.HANDLE.RELATIVEDIRECTORY 57986 . 58764)) (59582 60195 (CHDIR 59592 . 60193)) (60267 61253
- (\DEVICEFILE.EOSERROR 60277 . 61251)) (61326 62563 (\UNVISIBLE.PAGED.REVALIDATEFILELST 61336 . 62181)
- (\UNVISIBLE.FLUSH.OPEN.STREAMS 62183 . 62561)) (62596 64222 (\UFSError 62606 . 64220)) (64266 66681 (
-\UFSGetFileType 64276 . 64877) (\UFSSetFileType 64879 . 65476) (\UFSeol 65478 . 66679)) (75328 76452 (
-\UFSGetPrintFileType 75338 . 75750) (\UFSGetFileTypeConfirm 75752 . 76200) (\UFSPrintTypeMenu 76202 . 
-76450)) (76482 79320 (\UFStoOtherCopyMess 76492 . 78170) (\UFStoOtherRenameMess 78172 . 79318)))))
+  (FILEMAP (NIL (9321 10874 (\UFSCreateDevice 9331 . 9696) (\UFS.CREATE.DEVICE 9698 . 10554) (
+\UFSOpenDevice 10556 . 10733) (\UFSCloseDevice 10735 . 10872)) (15137 63831 (\UFSOpenFile 15147 . 
+21723) (\UFS.OPENP 21725 . 22222) (\UFS.RECOGNIZE.FILE 22224 . 23654) (\UFS.DIRECTORY.NAME 23656 . 
+24746) (\UFSCloseFile 24748 . 26807) (\UFSGetFileName 26809 . 27008) (\UFSDeleteFile 27010 . 28204) (
+\UFSRenameFile 28206 . 30523) (\UFSReadPages 30525 . 31660) (\UFSWritePages 31662 . 32882) (
+\UFSTruncateFile 32884 . 35290) (\UFSDirectoryNameP 35292 . 37155) (\UFSEventFn 37157 . 37819) (
+\UFSGetFileInfo 37821 . 42284) (\UFS.CREATE.PROPS 42286 . 42639) (\UFSSetFileInfo 42641 . 44987) (
+\UFSGenerateFiles 44989 . 52601) (\UFS.NEXTFILEFN 52603 . 60419) (\UFS.FILEINFOFN 60421 . 61870) (
+\UFS.VALID.PROPP 61872 . 62164) (\UFS.REGISTER.GFS 62166 . 62421) (\UFS.UNREGISTER.GFS 62423 . 63006) 
+(\UFS.ABORT.DIRECTORY 63008 . 63356) (\UFS.ABORT.CL-DIRECTORY 63358 . 63645) (\UFS.CLEANUP.GFS.TABLE 
+63647 . 63829)) (63866 70550 (\UFSMakeUnixFormatName 63876 . 64897) (\UFSParseNameString 64899 . 65273
+) (\UFSParse-Directory 65275 . 65816) (\UFS.PARSE.BODY 65818 . 66363) (\UFS.ADJUST.HOST 66365 . 66524)
+ (\UFS.FULLNAME 66526 . 67734) (\UFS.ADD.HOST.FIELD 67736 . 68096) (\UFS.REMOVE.HOST.FIELD 68098 . 
+69768) (\UFS.HANDLE.RELATIVEDIRECTORY 69770 . 70548)) (71366 72511 (CHDIR 71376 . 72509)) (72583 73569
+ (\DEVICEFILE.EOSERROR 72593 . 73567)) (73642 74879 (\UNVISIBLE.PAGED.REVALIDATEFILELST 73652 . 74497)
+ (\UNVISIBLE.FLUSH.OPEN.STREAMS 74499 . 74877)) (74912 76538 (\UFSError 74922 . 76536)) (76582 78997 (
+\UFSGetFileType 76592 . 77193) (\UFSSetFileType 77195 . 77792) (\UFSeol 77794 . 78995)) (87644 88768 (
+\UFSGetPrintFileType 87654 . 88066) (\UFSGetFileTypeConfirm 88068 . 88516) (\UFSPrintTypeMenu 88518 . 
+88766)) (88798 91636 (\UFStoOtherCopyMess 88808 . 90486) (\UFStoOtherRenameMess 90488 . 91634)))))
 STOP