FILEPKG: MAKEFILE now takes format identifer (e.g. :UTF-8) in its options list (#524)

Improve tedit interaction with modernize

greetfiles/NOGREET

@@ -0,0 +1,19 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "10-Sep-2021 21:25:42" {DSK}<home>larry>medley>greetfiles>NOGREET.;1
 537    )
+
+
+(PRETTYCOMPRINT NOGREETCOMS)
+
+(RPAQQ NOGREETCOMS
 [(P (COND ((STKPOS 'GREET)
+                                  (SETQ USERGREETFILES NIL)
+                                  (CLOSEF? (INPUT))
+                                  (RETFROM 'GREET])
+
+[COND
+   ((STKPOS 'GREET)
+    (SETQ USERGREETFILES NIL)
+    (CLOSEF? (INPUT))
+    (RETFROM 'GREET]
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

internal/library/MULTI-COMPILE

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "16-Nov-94 16:28:04" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;4|
 37236  
+
(FILECREATED "25-Sep-2021 21:28:08" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>internal>library>MULTI-COMPILE.;2|
 37172  
 
-      |changes| |to:|  (VARS MULTI-COMPILECOMS)
-                       (FNS FIND-UNCOMPILED-FILES)
-
-      |previous| |date:| " 9-Sep-94 13:03:19" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;3|)
+      |previous| |date:| "16-Nov-94 16:28:04" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>internal>library>MULTI-COMPILE.;1|)
 
 
-; Copyright (c) 1988, 1990, 1991, 1992, 1993, 1994 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1988, 1990-1994, 2021 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT MULTI-COMPILECOMS)
 
@@ -601,12 +600,12 @@
 
 (ADDTOVAR LAMA
 FIX-FILES)
 )
-(PUTPROPS MULTI-COMPILE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1991 1992 1993 1994))
+(PUTPROPS MULTI-COMPILE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1991 1992 1993 1994 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (7131 8389 (FIND-UNCOMPILED-FILES 7141 . 8387)) (8461 19787 (NEWERDCOMS? 8471 . 12445) (
-NEWERSOURCES? 12447 . 16359) (SETUP-FOR-RECOMPILE 16361 . 18749) (SMASH-OPCODES 18751 . 19269) (
-GET-DIRECTORY-LISTING 19271 . 19568) (GET-OPEN-FILES 19570 . 19785)) (31690 36610 (FIX-FILES 31700 . 
-34497) (FIX-FILE 34499 . 35090) (FIX-COPYRIGHT 35092 . 35319) (FIX-FILE-COPYRIGHT 35321 . 35481) (
-QUALIFY-FIELDS 35483 . 36022) (FIX-TEDIT 36024 . 36330) (FIX-DOCS 36332 . 36608)) (36735 36917 (CLFIX 
-36745 . 36915)))))
+  (FILEMAP (NIL (2676 6156 (BIGCOMP 2676 . 6156)) (6289 7061 (FIND-ALL-SOURCE-FILES 6289 . 7061)) (7062 
+8320 (FIND-UNCOMPILED-FILES 7072 . 8318)) (8392 19718 (NEWERDCOMS? 8402 . 12376) (NEWERSOURCES? 12378
+ . 16290) (SETUP-FOR-RECOMPILE 16292 . 18680) (SMASH-OPCODES 18682 . 19200) (GET-DIRECTORY-LISTING 
+19202 . 19499) (GET-OPEN-FILES 19501 . 19716)) (31621 36541 (FIX-FILES 31631 . 34428) (FIX-FILE 34430
+ . 35021) (FIX-COPYRIGHT 35023 . 35250) (FIX-FILE-COPYRIGHT 35252 . 35412) (QUALIFY-FIELDS 35414 . 
+35953) (FIX-TEDIT 35955 . 36261) (FIX-DOCS 36263 . 36539)) (36666 36848 (CLFIX 36676 . 36846)))))
 STOP

library/FILEBROWSER

@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "21-Aug-2021 23:33:58" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9|
 263236 
+
(FILECREATED "19-Sep-2021 18:08:05" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9|
 260675 
 
-      |changes| |to:|  (FNS FB.FIX-DIRECTORY-DATES)
+      |changes| |to:|  (FNS FB.EDITCOMMAND.ONEFILE)
 
-      |previous| |date:| "21-Aug-2021 23:08:34" 
+      |previous| |date:| "21-Aug-2021 23:33:58" 
 |{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
 
 
@@ -22,11 +22,11 @@
                                                       (TERPRI T))))
               (FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
               (P 
-                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

+                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

 
                  (MOVD? 'NILL 'TOTOPW.MODERNIZE))
               
-              (* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")

+              (* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")

 
               (INITVARS (FB.EXPUNGE?MENU)
                      (FB.BROWSERFONT DEFAULTFONT)
@@ -45,7 +45,7 @@
                                  (FB.PROMPTFONT LITTLEFONT)
                                  (FB.BROWSER.DIRECTORY.FONT BOLDFONT)))
               (P 
-                 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

+                 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

 
                  (FONTSET (FONTSET)))
               (ADDVARS (CACHEDMENUS FB.EXPUNGE?MENU))
@@ -170,16 +170,16 @@ You specify how many versions to keep.")))
               (VARS FB.VERSION.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS
                     FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE 
                     FB.ITEMSELECTEDSHADE))
-        (COMS                                                (* \; "Entries")

+        (COMS                                                (* \; "Entries")

               (COMMANDS "fb")
               (FNS FB FB.COPYBINARYCOMMAND FB.COPYTEXTCOMMAND FILEBROWSER FB.TABLEBROWSER 
                    FB.SELECTEDFILES FB.FETCHFILENAME FB.DIRECTORYP FB.PROMPTWPRINT FB.PROMPTW.FORMAT
                    FB.PROMPTFORINPUT FB.YES-OR-NO-P FB.ALLOW.ABORT \\FB.HARDCOPY.TOFILE.EXTENSION)
-                                                             (* \; "Setup")

+                                                             (* \; "Setup")

               (FNS FB.STARTUP FB.MAKERIGIDWINDOW)
               (FNS FB.PRINTFN FB.COPYFN))
-        (COMS                                                (* \; 
-
                                                           "commands and major subfunctions")

+        (COMS                                                (* \; 
+
                                                           "commands and major subfunctions")

               (FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY 
                    FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON)
               (FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES 
@@ -204,7 +204,7 @@ You specify how many versions to keep.")))
               (FNS FB.EXPUNGECOMMAND FB.NEWPATTERNCOMMAND FB.NEWINFOCOMMAND FB.DEPTHCOMMAND 
                    FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN 
                    FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
-        (COMS                                                (* \; "window functions")

+        (COMS                                                (* \; "window functions")

               (FNS FB.INFOMENU.SHADEINITIALSELECTIONS FB.INFO.ITEM.NAMED)
               (FNS FB.MAKECOUNTERWINDOW FB.COUNTERW.REDISPLAYFN FB.UPDATE.COUNTERS 
                    FB.DISPLAY.COUNTERS FB.COUNTER.STRING)
@@ -253,7 +253,7 @@ You specify how many versions to keep.")))
 (FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)
 
 
-(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

+(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

 
 
 (MOVD? 'NILL 'TOTOPW.MODERNIZE)
@@ -295,7 +295,7 @@ You specify how many versions to keep.")))
                           (FB.BROWSER.DIRECTORY.FONT BOLDFONT))
 
 
-(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

+(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

 
 
 (FONTSET (FONTSET))
@@ -1684,84 +1684,49 @@ Your deletions are thus ignored.")))
                ELSE
 (FB.FASTSEECOMMAND
 BROWSER KEY ITEM MENU)))))
 
 (FB.EDITCOMMAND.ONEFILE

-  (LAMBDA (BROWSER FILE OPTION ITEM MENU)
              (* \; "Edited  8-Aug-2021 11:16 by rmk:")


-                                                           (* \; "Edited 27-Feb-2021 20:07 by rmk:")


-                                                             (* \; "Edited  1-Feb-88 19:00 by bvm:")

+  (LAMBDA (BROWSER FILE OPTION ITEM MENU)
              (* \; "Edited 19-Sep-2021 18:07 by rmk:")


+                                                           (* \; "Edited 27-Feb-2021 20:07 by rmk:")


+                                                             (* \; "Edited  1-Feb-88 19:00 by bvm:")

 
-    (* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists.  If OPTION is READONLY, we don't want to edit, just view.  If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE.")

+    (* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists.  If OPTION is READONLY, we don't want to edit, just view.  .")

 
-    (* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region.  We don't factor it to the top because we want to do whatever heavy lifting (copying files) before.  Don't factor to the end because then it is too late--the TEDIT window was up and then buried.  (If TEDIT had a don'topen option, we could set things up, then change the shade, then open.  We could also do the manufactured title on the window before it shows.")

+    (* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region.   Don't factor to the end because then it is too late--the TEDIT window was up and then buried.  (If TEDIT had a don'topen option, we could set things up, then change the shade, then open.  We could also do the manufactured title on the window before it shows.")

 
-    (CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))
-    (CL:MULTIPLE-VALUE-BIND
-     (IGNORE CONDITION)
-     (IGNORE-ERRORS
-      (LET ((ENV (LISPSOURCEFILEP FILE)))
-           (IF
 ENV
-               THEN
 (SELECTQ OPTION
-                            ((LISP NIL TEDIT) 
-                                              (* |;;| 
-
"Asks to load prop and edits the coms.  We really don't want to use a text editor on a source file.")

+    (CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))       (* \; "Default editor is TEDIT. ")

 
-                                 
-                                 (* |;;| "The FUNCALL at the bottom is concerning.")

+    (* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that.  That way, the FB window won't pop up on top.")

 
-                                 (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                                 (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
-                                 (FB.EDITLISPFILE
 FILE BROWSER))
-                            (READONLY                        (* \; "READONLY on call from SEE")

-                                      (CL:WITH-OPEN-FILE
-                                       (STREAM FILE :DIRECTION :INPUT)
-                                       (LET ((NSTR (OPENTEXTSTREAM)))
-                                            (\\EXTERNALFORMAT STREAM ENV)
-                                            (COPY.TEXT.TO.IMAGE STREAM NSTR)
+    (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
+    (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
 
-                                 (* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that.  That way, the FB window won't pop up on top.")

+    (* |;;| "The particular item may be a subitem of the EDIT or SEE menu item, in which case we want to unshade that too.  Seems a little bruteforce")

 
-                                            (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                                            (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM 
+    (CL:UNLESS (MEMBER ITEM (FETCH
 (MENU ITEMS) OF
 MENU))
+        (FOR
 I IN
 (FETCH
 (MENU ITEMS) OF
 MENU)
+           WHEN
 (MEMBER ITEM (CDR (SASSOC 'SUBITEMS I))) DO
 (SHADEITEM I MENU 
+                                                                           FB.ITEMUNSELECTEDSHADE)
+                                                                   (PUTMENUPROP MENU 'ITEMSHADE
+                                                                          (CONS I 
                                                                                FB.ITEMUNSELECTEDSHADE
-                                                                               ))
-                                            (WINDOWPROP (WFROMDS (TEXTSTREAM
-                                                                  (TEDIT NSTR NIL NIL
-                                                                         '(READONLY T))))
-                                                   'TITLE
-                                                   (CONCAT "SEE window for " (FULLNAME STREAM))))))
-                            (CL:FUNCALL OPTION (MKATOM FILE)))
-             ELSE
 (SELECTQ OPTION
-                          (READONLY 
+                                                                                ))))
+    (CL:MULTIPLE-VALUE-BIND (IGNORE CONDITION)
+           (IGNORE-ERRORS (SELECTQ OPTION
+                              (READONLY (TEDIT-SEE FILE))
+                              (LISP                          (* \; 
+
"Original code allowed OPTION=NIL in thie branch, but NIL should have been coerced to TEDIT above.")

 
-                                 (* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access.  So in that case we do a secret NODIRCORE copy and look at that.")

+                                    (* |;;| "Asks to load prop and edits the coms, presumably with SEDIT.  We really don't want to use a text editor on a source file.")

 
-                                    (CL:WITH-OPEN-FILE
-                                     (STREAM FILE :DIRECTION :INPUT)
-                                     (LET ((NSTR))
-                                          (CL:UNLESS (RANDACCESSP STREAM)
-                                              (SETQ NSTR (OPENSTREAM
-                                                          '{NODIRCORE}
-                                                          'BOTH
-                                                          'NEW NIL (LIST (LIST 'TYPE
-                                                                               (GETFILEINFO
-                                                                                STREAM
-                                                                                'TYPE)))))
-                                              (COPYBYTES STREAM NSTR))
-                                          (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                                          (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM 
-                                                                             FB.ITEMUNSELECTEDSHADE))
-                                          (WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
-                                                                                  NIL NIL
-                                                                                  '(READONLY T))))
-                                                 'TITLE
-                                                 (CONCAT "SEE window for " (FULLNAME STREAM))))))
-                          ((TEDIT NIL) 
-                               (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                               (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
-                               (TEDIT (MKATOM FILE)))
-                          (LISP (FB.PROMPTW.FORMAT
 BROWSER 
-                                       "Failed because not a Lisp source file"))
-                          (CL:FUNCALL OPTION (MKATOM FILE))))))
-     (|if|
 CONDITION
-         |then|
 (FB.PROMPTW.FORMAT
 BROWSER "Failed because ~A" CONDITION)))))
+                                    (IF
 (LISPSOURCEFILEP FILE)
+                                        THEN
 (FB.EDITLISPFILE
 FILE BROWSER)
+                                      ELSE
 (FB.PROMPTW.FORMAT
 BROWSER 
+                                                      "Failed because not a Lisp source file")))
+                              (PROGN 
+                                     (* |;;| "Might just be a call to TEDIT (if OPTION = TEDIT)")

+
+                                     (CL:FUNCALL OPTION (MKATOM FILE)))))
+           (|if|
 CONDITION
+               |then|
 (FB.PROMPTW.FORMAT
 BROWSER "Failed because ~A" CONDITION)))))
 
 (FB.EDITLISPFILE

   (LAMBDA (FILE BROWSER)
                               (* \; "Edited 21-Feb-2021 17:29 by rmk:")

@@ -3838,26 +3803,26 @@ then click Recompute"))))
 
 (RECORD INFOFIELD
 (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
 
-(DATATYPE FBFILEDATA
 ((FILENAME POINTER)                 (* \; "Full name of this file")

-                          (FILEINFO POINTER)                 (* \; "Plist of attributes")

-                          (VERSIONLESSNAME POINTER)          (* \; "FILENAME sans version")

-                          (DIRECTORYP FLAG)                  (* \; "True if it's a directory line")

-                          (HASDIRPREFIX FLAG)                (* \; 
-
                         "True if it has a directory prefix beyond that in common to all the files")

-                          (DIRECTORYFILEP FLAG)              (* \; 
-
                                     "True if the \"file\" in this item is actually a subdirectory")

-                          (SIZE POINTER)                     (* \; "Size of file, for stats")

-                          (FILEDEPTH BYTE)                   (* \; 
-
          "Number of levels of subdirectory beneath the main pattern--zero for files at that level")

-                          (SORTVALUE POINTER)                (* \; 
-
                                                    "Cached value by which we are sorting the dir.")

-                          (SUBDIREND WORD)                   (* \; 
-
                             "Index of last char in subdirectory, or zero if HASDIRPREFIX is false")

-                          (STARTOFPNAME WORD)                (* \; 
-
            "Start of name for printing purposes.  Same as STARTOFNAME when browser sorted by name")

-                          (VERSION WORD)                     (* \; "Version, or zero if none")

-                          (STARTOFNAME WORD)                 (* \; 
-
                                                           "Index beyond all directory fields")

+(DATATYPE FBFILEDATA
 ((FILENAME POINTER)                 (* \; "Full name of this file")

+                          (FILEINFO POINTER)                 (* \; "Plist of attributes")

+                          (VERSIONLESSNAME POINTER)          (* \; "FILENAME sans version")

+                          (DIRECTORYP FLAG)                  (* \; "True if it's a directory line")

+                          (HASDIRPREFIX FLAG)                (* \; 
+
                         "True if it has a directory prefix beyond that in common to all the files")

+                          (DIRECTORYFILEP FLAG)              (* \; 
+
                                     "True if the \"file\" in this item is actually a subdirectory")

+                          (SIZE POINTER)                     (* \; "Size of file, for stats")

+                          (FILEDEPTH BYTE)                   (* \; 
+
          "Number of levels of subdirectory beneath the main pattern--zero for files at that level")

+                          (SORTVALUE POINTER)                (* \; 
+
                                                    "Cached value by which we are sorting the dir.")

+                          (SUBDIREND WORD)                   (* \; 
+
                             "Index of last char in subdirectory, or zero if HASDIRPREFIX is false")

+                          (STARTOFPNAME WORD)                (* \; 
+
            "Start of name for printing purposes.  Same as STARTOFNAME when browser sorted by name")

+                          (VERSION WORD)                     (* \; "Version, or zero if none")

+                          (STARTOFNAME WORD)                 (* \; 
+
                                                           "Index beyond all directory fields")

                           DUMMY)
                          (ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH
 (FBFILEDATA FILENAME
                                                                                         )
@@ -3872,85 +3837,85 @@ then click Recompute"))))
                                                                                        ) OF

                                                                                          DATUM))))))
 
-(DATATYPE FILEBROWSER
 ((NOSUBDIRECTORIES FLAG)           (* \; 
-
               "True if we don't want separate subdirectory lines -- subdirs then included in name")

-                           (NSPATTERN? FLAG)                 (* \; "True if host is an ns host")

-                           (SHOWUNDELETED? FLAG)             (* \; 
-
                        "True if counter window should show `Undeleted' rather than `Total' counts")

-                           (PATTERNPARSED? FLAG)             (* \; 
-
                                     "True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")

-                           (SORTBYDATE FLAG)                 (* \; 
-
                                              "True if SORTATTRIBUTE is one of the date attributes")

-                           (FBREADY FLAG)                    (* \; "False while FB is enumerating.")

-                           (ABORTING FLAG)                   (* \; 
-
                                                           "True if enumeration is being aborted")

-                           (FIXEDTITLE FLAG)                 (* \; "True if caller supplied title")

-                           (FBCOMPUTEDDEPTH BYTE)            (* \; 
-
                                    "Depth at the time we enumerated directory (zero for infinite)")

-                           (FBDISPLAYEDDEPTH BYTE)           (* \; 
-
                                            "Depth we are currently displaying (zero for infinite)")

-                           (TABLEBROWSER POINTER)            (* \; 
-
                                           "Pointer to TABLEBROWSER object controlling the browser")

-                           (BROWSERWINDOW POINTER)           (* \; "Main window")

-                           (COUNTERWINDOW POINTER)           (* \; 
-
                                                       "Window that counts files, pages, deletions")

-                           (HEADINGWINDOW POINTER)           (* \; 
-
                                                         "Window with headings for browser columns")

-                           (INFOMENUW POINTER)               (* \; 
-
                           "Window containing choices for info to be displayed, or NIL if none yet")

-                           (PROMPTWINDOW POINTER)            (* \; "GETPROMPTWINDOW BROWSERWINDOW")

-                           (INFODISPLAYED POINTER)           (* \; 
-
                                                          "List of attribute specs to be displayed")

-                           (PATTERN POINTER)                 (* \; 
-
                                                           "Directory pattern being enumerated")

-                           (PREPAREDPATTERN POINTER)         (* \; "DIRECTORY.MATCH.SETUP of same")

-                           (SEEWINDOW POINTER)               (* \; 
-
                                                          "Primary window used by FAST SEE command")

-                           (BROWSERFONT POINTER)             (* \; "Font of BROWSERWINDOW")

-                           (SORTBY POINTER)                  (* \; 
-
                                                         "Sorting function or NIL for default sort")

-                           (NAMESTART WORD)                  (* \; 
-
                     "Index of first character in file name beyond the common prefix shared by all")

-                           (DIRECTORYSTART WORD)             (* \; 
-
                                              "Index of first character of directory in file names")

-                           (INFOSTART WORD)                  (* \; 
-
                                       "X position in browser where first col of info is displayed")

-                           (NAMEOVERHEAD WORD)               (* \; 
-
                              "This plus width of name gives is how much to allow before INFOSTART")

-                           (OVERFLOWSPACING WORD)            (* \; 
-
                                                 "Increment between sizes considered for INFOSTART")

+(DATATYPE FILEBROWSER
 ((NOSUBDIRECTORIES FLAG)           (* \; 
+
               "True if we don't want separate subdirectory lines -- subdirs then included in name")

+                           (NSPATTERN? FLAG)                 (* \; "True if host is an ns host")

+                           (SHOWUNDELETED? FLAG)             (* \; 
+
                        "True if counter window should show `Undeleted' rather than `Total' counts")

+                           (PATTERNPARSED? FLAG)             (* \; 
+
                                     "True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")

+                           (SORTBYDATE FLAG)                 (* \; 
+
                                              "True if SORTATTRIBUTE is one of the date attributes")

+                           (FBREADY FLAG)                    (* \; "False while FB is enumerating.")

+                           (ABORTING FLAG)                   (* \; 
+
                                                           "True if enumeration is being aborted")

+                           (FIXEDTITLE FLAG)                 (* \; "True if caller supplied title")

+                           (FBCOMPUTEDDEPTH BYTE)            (* \; 
+
                                    "Depth at the time we enumerated directory (zero for infinite)")

+                           (FBDISPLAYEDDEPTH BYTE)           (* \; 
+
                                            "Depth we are currently displaying (zero for infinite)")

+                           (TABLEBROWSER POINTER)            (* \; 
+
                                           "Pointer to TABLEBROWSER object controlling the browser")

+                           (BROWSERWINDOW POINTER)           (* \; "Main window")

+                           (COUNTERWINDOW POINTER)           (* \; 
+
                                                       "Window that counts files, pages, deletions")

+                           (HEADINGWINDOW POINTER)           (* \; 
+
                                                         "Window with headings for browser columns")

+                           (INFOMENUW POINTER)               (* \; 
+
                           "Window containing choices for info to be displayed, or NIL if none yet")

+                           (PROMPTWINDOW POINTER)            (* \; "GETPROMPTWINDOW BROWSERWINDOW")

+                           (INFODISPLAYED POINTER)           (* \; 
+
                                                          "List of attribute specs to be displayed")

+                           (PATTERN POINTER)                 (* \; 
+
                                                           "Directory pattern being enumerated")

+                           (PREPAREDPATTERN POINTER)         (* \; "DIRECTORY.MATCH.SETUP of same")

+                           (SEEWINDOW POINTER)               (* \; 
+
                                                          "Primary window used by FAST SEE command")

+                           (BROWSERFONT POINTER)             (* \; "Font of BROWSERWINDOW")

+                           (SORTBY POINTER)                  (* \; 
+
                                                         "Sorting function or NIL for default sort")

+                           (NAMESTART WORD)                  (* \; 
+
                     "Index of first character in file name beyond the common prefix shared by all")

+                           (DIRECTORYSTART WORD)             (* \; 
+
                                              "Index of first character of directory in file names")

+                           (INFOSTART WORD)                  (* \; 
+
                                       "X position in browser where first col of info is displayed")

+                           (NAMEOVERHEAD WORD)               (* \; 
+
                              "This plus width of name gives is how much to allow before INFOSTART")

+                           (OVERFLOWSPACING WORD)            (* \; 
+
                                                 "Increment between sizes considered for INFOSTART")

                            (DIGITWIDTH WORD)
-                           (TOTALFILES WORD)                 (* \; 
-
                         "Total number of files, deleted files, pages, deleted pages at the moment")

+                           (TOTALFILES WORD)                 (* \; 
+
                         "Total number of files, deleted files, pages, deleted pages at the moment")

                            (DELETEDFILES WORD)
                            (TOTALPAGES POINTER)
                            (DELETEDPAGES POINTER)
-                           (PAGECOUNT? POINTER)              (* \; 
-
                          "True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")

-                           (COUNTERPOSITIONS POINTER)        (* \; 
-
     "List of pairs (left right) describing regions where the values of the counters are displayed")

-                           (COUNTERPAGESTRING POINTER)       (* \; 
-
                                                           "String to print after file/page count")

-                           (OVERFLOWWIDTHS POINTER)          (* \; 
-
                 "List of (xpos occurrences) describing files whose names exceed default INFOSTART")

-                           (INFOMENUCHOICES POINTER)         (* \; 
-
            "Selections user has made in Info window, not necessarily the info currently displayed")

-                           (UPDATEPROC POINTER)              (* \; 
-
                                                           "Process doing an Update (Recompute)")

-                           (DEFAULTDIR POINTER)              (* \; 
-
                                                 "Default directory for destination of Copy/Rename")

-                           (SORTATTRIBUTE POINTER)           (* \; 
-
                                                     "Attribute being sorted on, or NIL if by name")

+                           (PAGECOUNT? POINTER)              (* \; 
+
                          "True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")

+                           (COUNTERPOSITIONS POINTER)        (* \; 
+
     "List of pairs (left right) describing regions where the values of the counters are displayed")

+                           (COUNTERPAGESTRING POINTER)       (* \; 
+
                                                           "String to print after file/page count")

+                           (OVERFLOWWIDTHS POINTER)          (* \; 
+
                 "List of (xpos occurrences) describing files whose names exceed default INFOSTART")

+                           (INFOMENUCHOICES POINTER)         (* \; 
+
            "Selections user has made in Info window, not necessarily the info currently displayed")

+                           (UPDATEPROC POINTER)              (* \; 
+
                                                           "Process doing an Update (Recompute)")

+                           (DEFAULTDIR POINTER)              (* \; 
+
                                                 "Default directory for destination of Copy/Rename")

+                           (SORTATTRIBUTE POINTER)           (* \; 
+
                                                     "Attribute being sorted on, or NIL if by name")

                            (SORTMENU POINTER)
-                           (FBLOCK POINTER)                  (* \; 
-
                                                          "Lock acquired by filebrowser operations")

-                           (SORTINDEX WORD)                  (* \; 
-
                                            "Index (zero-based) in file info of the sort attribute")

-                           (SIZEINDEX WORD)                  (* \; "Index of size attribute")

-                           (FBDEPTH POINTER)                 (* \; 
-
                                                           "Enumeration depth, or NIL for default")

-                           (ABORTWINDOW POINTER)             (* \; 
-
                            "Dotted pair of (abortwindow . menuw) for this browser's abort window.")

+                           (FBLOCK POINTER)                  (* \; 
+
                                                          "Lock acquired by filebrowser operations")

+                           (SORTINDEX WORD)                  (* \; 
+
                                            "Index (zero-based) in file info of the sort attribute")

+                           (SIZEINDEX WORD)                  (* \; "Index of size attribute")

+                           (FBDEPTH POINTER)                 (* \; 
+
                                                           "Enumeration depth, or NIL for default")

+                           (ABORTWINDOW POINTER)             (* \; 
+
                            "Dotted pair of (abortwindow . menuw) for this browser's abort window.")

                            DUMMY))
 )
 
@@ -4253,35 +4218,35 @@ FB.UNDELETEALLCOMMAND 69511 . 69790) (FB.UNDELETE.FILE 69792 . 70537)) (70540 94
 FB.COPY/RENAME.ONE 72023 . 74345) (FB.COPY/RENAME.MANY 74347 . 80567) (FB.MERGE.DIRECTORIES 80569 . 
 80987) (FB.GREATEST.PREFIX 80989 . 82345) (FB.MAYBE.INSERT.FILE 82347 . 89787) (FB.GET.NEW.FILE.SPEC 
 89789 . 93620) (FB.CANONICAL.DIRECTORY 93622 . 94719)) (94722 102506 (FB.HARDCOPYCOMMAND 94732 . 95862
-) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 114945 (FB.EDITCOMMAND 102517 . 103318) (
-FB.EDITCOMMAND.ONEFILE 103320 . 109161) (FB.EDITLISPFILE 109163 . 110202) (FB.BROWSECOMMAND 110204 . 
-114943)) (114946 126739 (FB.FASTSEECOMMAND 114956 . 118406) (FB.FASTSEE.ONEFILE 118408 . 121437) (
-FB.SEEFULLFN 121439 . 125570) (FB.SEEBUTTONFN 125572 . 126737)) (126740 128486 (FB.LOADCOMMAND 126750
- . 127257) (FB.COMPILECOMMAND 127259 . 127797) (FB.OPERATE.ON.FILES 127799 . 128484)) (128487 176145 (
-FB.UPDATECOMMAND 128497 . 128722) (FB.FIX-DIRECTORY-DATES 128724 . 129331) (FB.MAYBE.EXPUNGE 129333 . 
-130328) (FB.UPDATEBROWSERITEMS 130330 . 143545) (FB.DATE 143547 . 144288) (FB.ADJUST.DATE.WIDTH 144290
- . 147258) (FB.SET.BROWSER.TITLE 147260 . 148117) (FB.MAYBE.WIDEN.NAMES 148119 . 150238) (
-FB.SET.DEFAULT.NAME.WIDTH 150240 . 151604) (FB.CREATE.FILEBUCKET 151606 . 158826) (
-FB.CHECK.NAME.LENGTH 158828 . 161249) (FB.ADD.FILEGROUP 161251 . 162778) (FB.INSERT.DIRECTORY 162780
- . 163018) (FB.MAKE.SUBDIRECTORY.ITEM 163020 . 164429) (FB.ADD.FILE 164431 . 165044) (FB.INSERT.FILE 
-165046 . 168458) (FB.ANALYZE.PATTERN 168460 . 173724) (FB.CANONICALIZE.PATTERN 173726 . 175038) (
-FB.GETALLFILEINFO 175040 . 176143)) (176146 184305 (FB.SORT.VERSIONS 176156 . 178927) (
-FB.DECREASING.VERSION 178929 . 179598) (FB.INCREASING.VERSION 179600 . 180221) (
-FB.NAMES.DECREASING.VERSION 180223 . 181258) (FB.NAMES.INCREASING.VERSION 181260 . 182257) (
-FB.DECREASING.NUMERIC.ATTR 182259 . 182939) (FB.INCREASING.NUMERIC.ATTR 182941 . 183615) (
-FB.ALPHABETIC.ATTR 183617 . 184303)) (184306 194148 (FB.SORTCOMMAND 184316 . 191146) (
-FB.INSERT.SUBDIRECTORIES 191148 . 191945) (FB.GET.SORT.MENU 191947 . 194146)) (194149 210238 (
-FB.EXPUNGECOMMAND 194159 . 196678) (FB.NEWPATTERNCOMMAND 196680 . 197078) (FB.NEWINFOCOMMAND 197080 . 
-199846) (FB.DEPTHCOMMAND 199848 . 201623) (FB.SHAPECOMMAND 201625 . 204967) (FB.REMOVE.FILE 204969 . 
-206790) (FB.COUNT.FILE.CHANGE 206792 . 208237) (FB.SETNEWPATTERN 208239 . 209409) (FB.GET.NEWPATTERN 
-209411 . 209995) (FB.OPTIONSCOMMAND 209997 . 210236)) (210273 211285 (
-FB.INFOMENU.SHADEINITIALSELECTIONS 210283 . 210930) (FB.INFO.ITEM.NAMED 210932 . 211283)) (211286 
-220752 (FB.MAKECOUNTERWINDOW 211296 . 212758) (FB.COUNTERW.REDISPLAYFN 212760 . 213347) (
-FB.UPDATE.COUNTERS 213349 . 215421) (FB.DISPLAY.COUNTERS 215423 . 220483) (FB.COUNTER.STRING 220485 . 
-220750)) (220753 225396 (FB.MAKEHEADINGWINDOW 220763 . 222311) (FB.HEADINGW.REDISPLAYFN 222313 . 
-222579) (FB.HEADINGW.RESHAPEFN 222581 . 222957) (FB.HEADINGW.DISPLAY 222959 . 225394)) (225397 229580 
-(FB.ICONFN 225407 . 225754) (FB.INFOMENU.WHENSELECTEDFN 225756 . 226486) (FB.CLOSEFN 226488 . 227691) 
-(FB.EXPUNGE?.MENU 227693 . 228105) (FB.AFTERCLOSEFN 228107 . 228468) (FB.CLOSE&EXPUNGE 228470 . 229578
-)) (229581 241639 (FB.HARDCOPY.DIRECTORY 229591 . 239948) (FB.HARDCOPY.PRINT.TITLE 239950 . 240276) (
-FB.HARDCOPY.MAXWIDTH 240278 . 241637)))))
+) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 112384 (FB.EDITCOMMAND 102517 . 103318) (
+FB.EDITCOMMAND.ONEFILE 103320 . 106600) (FB.EDITLISPFILE 106602 . 107641) (FB.BROWSECOMMAND 107643 . 
+112382)) (112385 124178 (FB.FASTSEECOMMAND 112395 . 115845) (FB.FASTSEE.ONEFILE 115847 . 118876) (
+FB.SEEFULLFN 118878 . 123009) (FB.SEEBUTTONFN 123011 . 124176)) (124179 125925 (FB.LOADCOMMAND 124189
+ . 124696) (FB.COMPILECOMMAND 124698 . 125236) (FB.OPERATE.ON.FILES 125238 . 125923)) (125926 173584 (
+FB.UPDATECOMMAND 125936 . 126161) (FB.FIX-DIRECTORY-DATES 126163 . 126770) (FB.MAYBE.EXPUNGE 126772 . 
+127767) (FB.UPDATEBROWSERITEMS 127769 . 140984) (FB.DATE 140986 . 141727) (FB.ADJUST.DATE.WIDTH 141729
+ . 144697) (FB.SET.BROWSER.TITLE 144699 . 145556) (FB.MAYBE.WIDEN.NAMES 145558 . 147677) (
+FB.SET.DEFAULT.NAME.WIDTH 147679 . 149043) (FB.CREATE.FILEBUCKET 149045 . 156265) (
+FB.CHECK.NAME.LENGTH 156267 . 158688) (FB.ADD.FILEGROUP 158690 . 160217) (FB.INSERT.DIRECTORY 160219
+ . 160457) (FB.MAKE.SUBDIRECTORY.ITEM 160459 . 161868) (FB.ADD.FILE 161870 . 162483) (FB.INSERT.FILE 
+162485 . 165897) (FB.ANALYZE.PATTERN 165899 . 171163) (FB.CANONICALIZE.PATTERN 171165 . 172477) (
+FB.GETALLFILEINFO 172479 . 173582)) (173585 181744 (FB.SORT.VERSIONS 173595 . 176366) (
+FB.DECREASING.VERSION 176368 . 177037) (FB.INCREASING.VERSION 177039 . 177660) (
+FB.NAMES.DECREASING.VERSION 177662 . 178697) (FB.NAMES.INCREASING.VERSION 178699 . 179696) (
+FB.DECREASING.NUMERIC.ATTR 179698 . 180378) (FB.INCREASING.NUMERIC.ATTR 180380 . 181054) (
+FB.ALPHABETIC.ATTR 181056 . 181742)) (181745 191587 (FB.SORTCOMMAND 181755 . 188585) (
+FB.INSERT.SUBDIRECTORIES 188587 . 189384) (FB.GET.SORT.MENU 189386 . 191585)) (191588 207677 (
+FB.EXPUNGECOMMAND 191598 . 194117) (FB.NEWPATTERNCOMMAND 194119 . 194517) (FB.NEWINFOCOMMAND 194519 . 
+197285) (FB.DEPTHCOMMAND 197287 . 199062) (FB.SHAPECOMMAND 199064 . 202406) (FB.REMOVE.FILE 202408 . 
+204229) (FB.COUNT.FILE.CHANGE 204231 . 205676) (FB.SETNEWPATTERN 205678 . 206848) (FB.GET.NEWPATTERN 
+206850 . 207434) (FB.OPTIONSCOMMAND 207436 . 207675)) (207712 208724 (
+FB.INFOMENU.SHADEINITIALSELECTIONS 207722 . 208369) (FB.INFO.ITEM.NAMED 208371 . 208722)) (208725 
+218191 (FB.MAKECOUNTERWINDOW 208735 . 210197) (FB.COUNTERW.REDISPLAYFN 210199 . 210786) (
+FB.UPDATE.COUNTERS 210788 . 212860) (FB.DISPLAY.COUNTERS 212862 . 217922) (FB.COUNTER.STRING 217924 . 
+218189)) (218192 222835 (FB.MAKEHEADINGWINDOW 218202 . 219750) (FB.HEADINGW.REDISPLAYFN 219752 . 
+220018) (FB.HEADINGW.RESHAPEFN 220020 . 220396) (FB.HEADINGW.DISPLAY 220398 . 222833)) (222836 227019 
+(FB.ICONFN 222846 . 223193) (FB.INFOMENU.WHENSELECTEDFN 223195 . 223925) (FB.CLOSEFN 223927 . 225130) 
+(FB.EXPUNGE?.MENU 225132 . 225544) (FB.AFTERCLOSEFN 225546 . 225907) (FB.CLOSE&EXPUNGE 225909 . 227017
+)) (227020 239078 (FB.HARDCOPY.DIRECTORY 227030 . 237387) (FB.HARDCOPY.PRINT.TITLE 237389 . 237715) (
+FB.HARDCOPY.MAXWIDTH 237717 . 239076)))))
 STOP

library/SYSEDIT

@@ -1,9 +1,9 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "30-Aug-2021 16:04:42" {DSK}<home>larry>medley>library>SYSEDIT.;3
 1146   
+
(FILECREATED "28-Sep-2021 10:16:44" {DSK}<home>larry>medley>library>SYSEDIT.;3
 1307   
 
       changes to%:  (VARS SYSEDITCOMS)
 
-      previous date%: " 6-Aug-2021 07:35:16" {DSK}<home>larry>medley>library>SYSEDIT.;1)
+      previous date%: "24-Sep-2021 20:52:26" {DSK}<home>larry>medley>library>SYSEDIT.;2)
 
 
 (* ; "
@@ -19,7 +19,9 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
               (GLOBALVARFLG T)
               (CLISPIFTRANFLG T)
               (CROSSCOMPILING 'ASK)
-              (DFNFLG 'PROP))
+              (DFNFLG 'PROP)
+              (*REPLACE-OLD-EDIT-DATES* NIL)
+              (COPYRIGHTFLG 'PRESERVE))
         (P (RESETVARS ((CROSSCOMPILING T))
                   (LOAD? 'EXPORTS.ALL])
 
@@ -37,6 +39,10 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ DFNFLG
 PROP)
 
+(RPAQQ *REPLACE-OLD-EDIT-DATES*
 NIL)
+
+(RPAQQ COPYRIGHTFLG
 PRESERVE)
+
 (RESETVARS ((CROSSCOMPILING T))
            (LOAD? 'EXPORTS.ALL))
 (PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))

library/TEDIT

@@ -1,14 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "19-Apr-2018 12:22:03" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;2
 140045 
 
-      changes to%:  (VARS TEDITCOMS)
+
(FILECREATED "13-Oct-2021 10:00:40" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;19
 142287 
 
-      previous date%: "21-Jun-99 20:00:16" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;1)
+      changes to%:  (FNS TEDIT-SEE)
+
+      previous date%: "11-Oct-2021 14:03:12" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;18)
 
 
 (* ; "
-Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 1999, 2018 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT TEDITCOMS)
@@ -24,40 +26,40 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
               (TEDIT.DEFAULT.PROPS NIL)
               (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP))
               (TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU))
-                                                             (* ; 
-
                                            "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")

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

+                                                             (* ; 
+
                                            "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")

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

               )
         (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
-        (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE 
+        (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE 
              TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES TEDIT.MAPPIECES 
              TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM \TEDIT.INCLUDE
              \TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL \TEDIT.RESTARTFN 
              \TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS 
              \TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
         (P (MOVD? 'NILL 'OBJECTOUTOFTEDIT))
-                                                             (* ; 
-
                                  "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")

+                                                             (* ; 
+
                                  "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")

         (COMS (FNS \CREATE.TEDIT.RESTART.MENU))
-                                                             (* ; 
-
                                                    "Added by yabu.fx, for SUNLOADUP without DWIM.")

-        (COMS                                                (* ; "Debugging functions")

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

+        (COMS                                                (* ; "Debugging functions")

               (FNS PLCHAIN PRINTLINE SEEFILE))
-        (COMS                                                (* ; "Object-oriented editing")

+        (COMS                                                (* ; "Object-oriented editing")

               (FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.SUBTREE
                    TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED))
         (FILES TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY
                TEDITPAGE TEDITMENU TEDITFNKEYS)
-        (COMS                                                (* ; "TEDIT Support information")

+        (COMS                                                (* ; "TEDIT Support information")

               (E (SETQ TEDITSYSTEMDATE (DATE)))
               (VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA"))
               (FNS MAKETEDITFORM)
               (P (ADDTOVAR LAFITESPECIALFORMS
 ("TEdit Report" 'MAKETEDITFORM 
                                                          "Report a problem with TEdit"))
                  (SETQ LAFITEFORMSMENU NIL)))
-        (COMS                                                (* ; 
-
                         "LISTFILES Interface, so the system can decide if a file is a TEdit file.")

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

               (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
                                               (EXTENSION (TEDIT])
 
@@ -327,6 +329,48 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
                     (TTY.PROCESS PROC)))
                 (RETURN PROC])
 
+(TEDIT-SEE

+  [LAMBDA (FILE WINDOW FORMAT)
                          (* ; "Edited 13-Oct-2021 10:00 by rmk:")


+                                                            (* ; "Edited 27-Feb-2021 20:07 by rmk:")


+                                                             (* ; "Edited  1-Feb-88 19:00 by bvm:")

+
+    (* ;; "See FILE in a scrollable READONLY TEDIT window.  If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.")

+
+    (* ;; "FORMAT for text files defaults to :UTF-8 if present, otherwise *DEFAULT-EXTERNALFORMAT*")

+
+    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
+           (LET ((SEESTREAM STREAM)
+                 TSTREAM)
+
+                (* ;; "No need to fiddle with a TEDIT file")

+
+                (IF
 (\TEDIT.FORMATTEDP1 STREAM)
+                  ELSEIF
 (LISPSOURCEFILEP STREAM)
+                    THEN
 
+
+                          (* ;; "Lisp source file")

+
+                          (SETQ SEESTREAM (OPENTEXTSTREAM))
+                          (DSPFONT DEFAULTFONT SEESTREAM)
+                          (COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
+                  ELSE
 
+
+                        (* ;; "Not a Lisp source file and not a Tedit file.  If it is not random access, we copy it so we can scroll around.")

+
+                        (* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).")

+
+                        (SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8)
+                                                        :DEFAULT))
+                        (CL:UNLESS (RANDACCESSP STREAM)
+                            (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
+                            (COPYCHARS STREAM SEESTREAM)))
+                [SETQ TSTREAM (TEXTSTREAM
 (TEDIT
 SEESTREAM WINDOW NIL
+                                                     `(READONLY T FONT ,DEFAULTFONT]
+                (WINDOWPROP (WFROMDS TSTREAM)
+                       'TITLE
+                       (CONCAT "SEE window for " (FULLNAME STREAM)))
+                (FULLNAME STREAM])
+
 (TEDIT.CHARWIDTH

   [LAMBDA (CH FONT TERMSA)
                                   (* jds "22-OCT-83 19:32")

           
@@ -2192,7 +2236,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
 (* ; "TEDIT Support information")

 
 
-(RPAQQ TEDITSYSTEMDATE
 "19-Apr-2018 12:22:04")
+(RPAQQ TEDITSYSTEMDATE
 "13-Oct-2021 10:00:40")
 
 (RPAQ TEDITSUPPORT
 "TEditSupport.PA")
 (DEFINEQ
@@ -2216,21 +2260,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
 (ADDTOVAR PRINTFILETYPES
 (TEDIT (TEST \TEDIT.FORMATTEDP1)
                                     (EXTENSION (TEDIT))))
 (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
-1992 1993 1995 1999 2018))
+1992 1993 1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4382 115216 (\TEDIT2 4392 . 7143) (COERCETEXTOBJ 7145 . 15921) (TEDIT 15923 . 20892) (
-TEDIT.CHARWIDTH 20894 . 22918) (TEDIT.COPY 22920 . 31356) (TEDIT.DELETE 31358 . 32048) (
-TEDIT.DO.BLUEPENDINGDELETE 32050 . 35117) (TEDIT.INSERT 35119 . 40649) (TEDIT.KILL 40651 . 42208) (
-TEDIT.MAPLINES 42210 . 43609) (TEDIT.MAPPIECES 43611 . 44567) (TEDIT.MOVE 44569 . 54353) (TEDIT.QUIT 
-54355 . 56355) (TEDIT.STRINGWIDTH 56357 . 57028) (TEDIT.\INSERT 57030 . 59055) (TEXTOBJ 59057 . 60182)
- (TEXTSTREAM 60184 . 61799) (\TEDIT.INCLUDE 61801 . 65701) (\TEDIT.INSERT.PIECES 65703 . 75618) (
-\TEDIT.MOVE.PIECEMAPFN 75620 . 77699) (\TEDIT.OBJECT.SHOWSEL 77701 . 81330) (\TEDIT.RESTARTFN 81332 . 
-83327) (\TEDIT.CHARDELETE 83329 . 87291) (\TEDIT.COPY.PIECEMAPFN 87293 . 90518) (\TEDIT.DELETE 90520
- . 98038) (\TEDIT.DIFFUSE.PARALOOKS 98040 . 100804) (\TEDIT.FOREIGN.COPY? 100806 . 104533) (
-\TEDIT.QUIT 104535 . 107681) (\TEDIT.WORDDELETE 107683 . 112516) (\TEDIT1 112518 . 115214)) (115330 
-115446 (\CREATE.TEDIT.RESTART.MENU 115340 . 115444)) (115545 119234 (PLCHAIN 115555 . 115829) (
-PRINTLINE 115831 . 118595) (SEEFILE 118597 . 119232)) (119275 138918 (TEDIT.INSERT.OBJECT 119285 . 
-128362) (TEDIT.EDIT.OBJECT 128364 . 130620) (TEDIT.FIND.OBJECT 130622 . 131515) (
-TEDIT.FIND.OBJECT.SUBTREE 131517 . 132323) (TEDIT.PUT.OBJECT 132325 . 133984) (TEDIT.GET.OBJECT 133986
- . 137185) (TEDIT.OBJECT.CHANGED 137187 . 138916)) (139196 139559 (MAKETEDITFORM 139206 . 139557)))))
+  (FILEMAP (NIL (4330 117453 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) (
+TEDIT-SEE 20842 . 23129) (TEDIT.CHARWIDTH 23131 . 25155) (TEDIT.COPY 25157 . 33593) (TEDIT.DELETE 
+33595 . 34285) (TEDIT.DO.BLUEPENDINGDELETE 34287 . 37354) (TEDIT.INSERT 37356 . 42886) (TEDIT.KILL 
+42888 . 44445) (TEDIT.MAPLINES 44447 . 45846) (TEDIT.MAPPIECES 45848 . 46804) (TEDIT.MOVE 46806 . 
+56590) (TEDIT.QUIT 56592 . 58592) (TEDIT.STRINGWIDTH 58594 . 59265) (TEDIT.\INSERT 59267 . 61292) (
+TEXTOBJ 61294 . 62419) (TEXTSTREAM 62421 . 64036) (\TEDIT.INCLUDE 64038 . 67938) (\TEDIT.INSERT.PIECES
+ 67940 . 77855) (\TEDIT.MOVE.PIECEMAPFN 77857 . 79936) (\TEDIT.OBJECT.SHOWSEL 79938 . 83567) (
+\TEDIT.RESTARTFN 83569 . 85564) (\TEDIT.CHARDELETE 85566 . 89528) (\TEDIT.COPY.PIECEMAPFN 89530 . 
+92755) (\TEDIT.DELETE 92757 . 100275) (\TEDIT.DIFFUSE.PARALOOKS 100277 . 103041) (\TEDIT.FOREIGN.COPY?
+ 103043 . 106770) (\TEDIT.QUIT 106772 . 109918) (\TEDIT.WORDDELETE 109920 . 114753) (\TEDIT1 114755 . 
+117451)) (117567 117683 (\CREATE.TEDIT.RESTART.MENU 117577 . 117681)) (117782 121471 (PLCHAIN 117792
+ . 118066) (PRINTLINE 118068 . 120832) (SEEFILE 120834 . 121469)) (121512 141155 (TEDIT.INSERT.OBJECT 
+121522 . 130599) (TEDIT.EDIT.OBJECT 130601 . 132857) (TEDIT.FIND.OBJECT 132859 . 133752) (
+TEDIT.FIND.OBJECT.SUBTREE 133754 . 134560) (TEDIT.PUT.OBJECT 134562 . 136221) (TEDIT.GET.OBJECT 136223
+ . 139422) (TEDIT.OBJECT.CHANGED 139424 . 141153)) (141433 141796 (MAKETEDITFORM 141443 . 141794)))))
 STOP

library/TEDITDCL.LCOM

@@ -1,9 +1,9 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED "30-Apr-2021 17:26:58" ("compiled on " 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "29-Apr-2021 09:48:40" brecompiled 
-exprs%: nothing in "Medley  Full Sysout 30-Apr-2021 ..." dated "30-Apr-2021 14:49:58")
-(FILECREATED "30-Apr-2021 17:26:17" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2 
-86155 previous date%: "25-Aug-94 10:53:00" 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(FILECREATED "21-Sep-2021 12:53:57" ("compiled on " 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "20-Sep-2021 11:14:12" brecompiled 
+exprs%: nothing in "FULL 20-Sep-2021 ..." dated "20-Sep-2021 11:14:18")
+(FILECREATED "21-Sep-2021 12:53:57" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2 
+86549 changes to%: (VARS TEDITDCLCOMS) previous date%: "30-Apr-2021 17:26:17" 
 {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;1)
 (PRETTYCOMPRINT TEDITDCLCOMS)
 (RPAQQ TEDITDCLCOMS ((* ;;; 
@@ -38,7 +38,9 @@ WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (REDO.TTC 5) (UNDO.TTC 6)
 8) (EXPAND.TTC 9) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))) (DECLARE%: EVAL@COMPILE DONTCOPY 
 (CONSTANTS (MSPACE 153) (NSPACE 152) (THINSPACE 159) (FIGSPACE 154))) (* ;; "FROM TEDITWINDOW") (
 DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITCARET)) (INITRECORDS TEDITCARET) (* ;; 
-"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;;; "THE END") (COMS (* ;; 
+"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;; "FROM TEDITHCPY and TEDITSCREEN") (DECLARE%: 
+EVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) (* ;;; "THE END") (
+COMS (* ;; 
 "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character "
 ) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NOTBEFORE.LB 1) (* ; 
 "Must not break before this character (e.g. Japanese right-paren)") (NOTAFTER.LB 2) (* ; 

library/TEDITHCPY

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "28-Jun-2021 12:35:45" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;2
 105754 
+
(FILECREATED "21-Sep-2021 15:33:24" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;10
 106458 
 
-      changes to%:  (FNS \TEDIT.HARDCOPY.FORMATLINE)
+      changes to%:  (FNS TEDIT.HARDCOPYFN)
+                    (VARS TEDITHCPYCOMS)
 
-      previous date%: "25-Aug-94 10:54:07" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;1)
+      previous date%: "21-Sep-2021 12:54:04" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;7)
 
 
 (* ; "
@@ -20,43 +21,48 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
                (FILES (LOADCOMP)
                       TEDITDCL))
         (COMS 
-              (* ;; "Generic interface functions and common code")

+              (* ;; "Generic interface functions and common code")

 
               (FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE 
                    \TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS 
                    \TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX))
         (COMS 
-              (* ;; "Functions for scaling distances and regions as needed during hardcopy.")

+              (* ;; "Functions for scaling distances and regions as needed during hardcopy.")

 
               (FNS \TEDIT.SCALE \TEDIT.SCALEREGION))
         (COMS 
-              (* ;; "PRESS-specific code")

+              (* ;; "PRESS-specific code")

 
               (VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
-                                                             (* ; 
-
                                                           "0.75 inches from bottom, 1 from top")

+                                                             (* ; 
+
                                                           "0.75 inches from bottom, 1 from top")

               )
         [COMS 
-              (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")

+              (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")

 
               (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
               (P (LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
                         'TEDIT
                         (FUNCTION \TEDIT.HARDCOPY)))
               (P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
-                      (COND (PRESSVALUES                     (* ; 
-
                                                  "Only install PRESS printing if PRESS is loaded.")

+                      (COND (PRESSVALUES                     (* ; 
+
                                                  "Only install PRESS printing if PRESS is loaded.")

                                    (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
-        (COMS 
-              (* ;; "vars for Japanese Line Break")

+        [COMS 
+              (* ;; "vars for Japanese Line Break")

 
-              [VARS (TEDIT.DONT.BREAK.CHARS '(8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251
-                                                   9253 9255 9257 9283 9315 9317 9319 9326 9505 9507
-                                                   9509 9511 9513 9539 9571 9573 9575 9582))
-                    (TEDIT.DONT.LAST.CHARS '(8524 8538 8536 8534]
-              (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))
+              (INITVARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" 
+                                                                 "41,115" "41,133" "41,131" "41,127"
+                                                                 "Hira,41" "Hira,43" "Hira,45" 
+                                                                 "Hira,47" "Hira,51" "Hira,103" 
+                                                                 "Hira,143" "Hira,145" "Hira,147" 
+                                                                 "Hira,156" "Kata,41" "Kata,43" 
+                                                                 "Kata,45" "Kata,47" "Kata,51" 
+                                                                 "Kata,103" "Kata,143" "Kata,145" 
+                                                                 "Kata,147" "Kata,156")))
+                     (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126"]
         (COMS 
-              (* ;; "Support for hardcopying several files as one document")

+              (* ;; "Support for hardcopying several files as one document")

 
               (FNS TEDIT-BOOK))))
 
@@ -1512,22 +1518,22 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (TEDIT.HARDCOPYFN

-  [LAMBDA (WINDOW IMAGESTREAM)
                          (* ; "Edited 12-Jun-90 18:35 by mitani")

+  [LAMBDA (WINDOW IMAGESTREAM)
                          (* ; "Edited 21-Sep-2021 15:33 by rmk:")

 
-    (* ;; 
-
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")

+    (* ;; 
+
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")

 
     (PROG ((TEXTOBJ (TEXTOBJ WINDOW))
            (TEXTSTREAM (TEXTSTREAM WINDOW)))
 
-     (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it.  Please don't remove this binding!")

+     (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it.  Please don't remove this binding!")

 
           (RESETLST
               [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
                      '(AND (\TEDIT.MARKINACTIVE OLDVALUE]
               (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 'Hardcopy)
-              (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM)))  (* ; "Build the hardcopy")

-    ])
+                                                             (* ; "Build the hardcopy")

+              (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))])
 
 (\TEDIT.HARDCOPY

   [LAMBDA (FILE PFILE)
                                  (* ; "Edited 12-Jun-90 18:35 by mitani")

@@ -1568,8 +1574,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 
 [LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
      (COND
-        (PRESSVALUES                                         (* ; 
-
                                                  "Only install PRESS printing if PRESS is loaded.")

+        (PRESSVALUES                                         (* ; 
+
                                                  "Only install PRESS printing if PRESS is loaded.")

                (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
 
 
@@ -1577,15 +1583,13 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 (* ;; "vars for Japanese Line Break")

 
 
-(RPAQQ TEDIT.DONT.BREAK.CHARS
 (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 
-                                        9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539 
-                                        9571 9573 9575 9582))
+(RPAQ? TEDIT.DONT.BREAK.CHARS

+       (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133" "41,131" "41,127" 
+                        "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143" 
+                        "Hira,145" "Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" 
+                        "Kata,51" "Kata,103" "Kata,143" "Kata,145" "Kata,147" "Kata,156")))
 
-(RPAQQ TEDIT.DONT.LAST.CHARS
 (8524 8538 8536 8534))
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
-)
+(RPAQ? TEDIT.DONT.LAST.CHARS
 (CHARCODE ("41,114" "41,132" "41,130" "41,126")))
 
 
 
@@ -1612,11 +1616,11 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 (PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
 1991 1992 1993 1994 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3088 99806 (TEDIT.HARDCOPY 3098 . 4349) (TEDIT.HCPYFILE 4351 . 6425) (
-\TEDIT.HARDCOPY.DISPLAYLINE 6427 . 20572) (\TEDIT.HARDCOPY.FORMATLINE 20574 . 67896) (
-\DOFORMATTING.HARDCOPY 67898 . 81191) (\TEDIT.HARDCOPY.MODIFYLOOKS 81193 . 83600) (
-\TEDIT.HCPYLOOKS.UPDATE 83602 . 94210) (\TEDIT.HCPYFMTSPEC 94212 . 99232) (\TEDIT.INTEGER.IMAGEBOX 
-99234 . 99804)) (99895 100979 (\TEDIT.SCALE 99905 . 100199) (\TEDIT.SCALEREGION 100201 . 100977)) (
-101222 103719 (TEDIT.HARDCOPYFN 101232 . 102083) (\TEDIT.HARDCOPY 102085 . 102994) (
-\TEDIT.PRESS.HARDCOPY 102996 . 103717)) (104701 105604 (TEDIT-BOOK 104711 . 105602)))))
+  (FILEMAP (NIL (3655 100373 (TEDIT.HARDCOPY 3665 . 4916) (TEDIT.HCPYFILE 4918 . 6992) (
+\TEDIT.HARDCOPY.DISPLAYLINE 6994 . 21139) (\TEDIT.HARDCOPY.FORMATLINE 21141 . 68463) (
+\DOFORMATTING.HARDCOPY 68465 . 81758) (\TEDIT.HARDCOPY.MODIFYLOOKS 81760 . 84167) (
+\TEDIT.HCPYLOOKS.UPDATE 84169 . 94777) (\TEDIT.HCPYFMTSPEC 94779 . 99799) (\TEDIT.INTEGER.IMAGEBOX 
+99801 . 100371)) (100462 101546 (\TEDIT.SCALE 100472 . 100766) (\TEDIT.SCALEREGION 100768 . 101544)) (
+101789 104340 (TEDIT.HARDCOPYFN 101799 . 102704) (\TEDIT.HARDCOPY 102706 . 103615) (
+\TEDIT.PRESS.HARDCOPY 103617 . 104338)) (105405 106308 (TEDIT-BOOK 105415 . 106306)))))
 STOP

library/TEDITWINDOW

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "24-Aug-2021 23:30:39" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;3
 185251 
 
-      changes to%:  (FNS \TEDIT.BUTTONEVENTFN TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE)
+
(FILECREATED "12-Oct-2021 15:10:06" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;16
 187619 
 
-      previous date%: "21-Jun-99 20:00:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;1)
+      changes to%:  (FNS \TEDIT.BUTTONEVENTFN)
+
+      previous date%: "12-Oct-2021 15:01:30" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;15)
 
 
 (* ; "
@@ -25,33 +26,36 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
              \TEDIT.WINDOW.OPS \TEDIT.EXPANDFN \TEDIT.MAINW \TEDIT.PRIMARYW \TEDIT.COPYINSERTFN 
              \TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN 
              \TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.WINDOW.SETUP \SAFE.FIRST)
+        (INITVARS (\TEDIT.OP.WIDTH 12)
+               (\TEDIT.OP.BOTTOM 12))
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM))
         (CURSORS BXCARET BXHICARET TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR 
                \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR)
         (INITVARS (TEDIT.DEFAULT.WINDOW NIL))
         (GLOBALVARS TEDIT.DEFAULT.WINDOW)
-        (COMS                                                (* ; 
-
                                                 "User-level %"is this a TEdit window?%" function.")

+        (COMS                                                (* ; 
+
                                                 "User-level %"is this a TEdit window?%" function.")

               (FNS TEDITWINDOWP))
-        (COMS                                                (* ; "User-typein support")

+        (COMS                                                (* ; "User-typein support")

               (FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME))
-        (COMS                                                (* ; "Attached Prompt window support.")

+        (COMS                                                (* ; "Attached Prompt window support.")

               (FNS TEDIT.PROMPTPRINT TEDIT.PROMPTFLASH \TEDIT.PROMPT.PAGEFULLFN)
               (INITVARS (TEDIT.PROMPT.FONT (FONTCREATE 'GACHA 10))
                      (TEDIT.PROMPTWINDOW.HEIGHT NIL))
               (GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT))
-        (COMS                                                (* ; "Title creation and update")

+        (COMS                                                (* ; "Title creation and update")

               (FNS TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE \TEDIT.WINDOW.TITLE 
                    \TEXTSTREAM.FILENAME))
-        (COMS                                                (* ; "Screen updating utilities")

+        (COMS                                                (* ; "Screen updating utilities")

               (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.REPAINTFN \TEDIT.RESHAPEFN \TEDIT.SCROLLFN))
-        (COMS                                                (* ; "Process-world interfaces")

+        (COMS                                                (* ; "Process-world interfaces")

               (FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN))
         (COMS (INITVARS (\CARETRATE 333))
-                                                             (* ; 
-
                                                           "Caret handler;  stolen from CHAT.")

+                                                             (* ; 
+
                                                           "Caret handler;  stolen from CHAT.")

               (FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET 
                    TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET))
-        [COMS                                                (* ; "Menu interfacing")

+        [COMS                                                (* ; "Menu interfacing")

               (FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU 
                    \TEDIT.MENU.WHENHELDFN \TEDIT.MENU.WHENSELECTEDFN)
               (GLOBALVARS TEDIT.DEFAULT.MENU)
@@ -79,21 +83,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                                             '(TEdit '(TEDIT)
                                                                     "Opens a TEdit window for use."]
                                                  (SETQ BackgroundMenu NIL]
-        (COMS                                                (* ; "titled icon info")

+        (COMS                                                (* ; "titled icon info")

               (FILES ICONW)
               (BITMAPS TEDITICON TEDITMASK)
               (INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD))
                      [TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]
-                                                             (* ; 
-
                        "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")

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

+                                                             (* ; 
+
                        "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")

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

                      [TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS 
                                                                               TEDIT.ICON.TITLE.REGION
                                                                                        NIL]
-                                                             (* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")

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

+                                                             (* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")

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

                      ])
 
 (FILESLOAD TEDITDCL)
@@ -156,7 +160,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
     TEDIT.DEFAULT.WINDOW])
 
 (TEDIT.CURSORMOVEDFN

-  [LAMBDA (W)
                                            (* ; "Edited 30-May-91 23:39 by jds")

+  [LAMBDA (W)
                                           (* ; "Edited 12-Oct-2021 13:14 by rmk:")

 
          (* Watch the mouse and change the cursor to reflect the region of the window 
 
       it's in (line select, window split eventually?))

@@ -187,13 +191,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                                                           of
 LINE]
                 (SELECTQ (fetch
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ)
                     (TEXT [COND
-                             ((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
-                                                                 of
 TEXTOBJ)
-                                                        8)))
+                             ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
+                                                                      of
 TEXTOBJ)
+                                                             \TEDIT.OP.WIDTH)))
+                                   (IGEQ Y (IPLUS (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ)
+                                                  \TEDIT.OP.BOTTOM)))
+
+                              (* ;; "The region to the right of text, for splitting operations.")

+
                               (CURSOR \TEDIT.SPLITCURSOR)
                               (replace
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ with
 'WINDOW)
                               (replace
 LEFT of
 CURSORREG with
 LEFT)
-                              (replace
 WIDTH of
 CURSORREG with
 8))
+                              (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                              ([ILESSP X (SETQ LEFT
                                          (OR [AND LINE (COND
                                                           ((fetch
 (FMTSPEC FMTHARDCOPY)
@@ -221,13 +230,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                                                                     of
 TEXTOBJ)
                                                                            (IPLUS LEFT 8])
                     (LINE (COND
-                             ((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
-                                                                 of
 TEXTOBJ)
-                                                        8)))
+                             ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
+                                                                      of
 TEXTOBJ)
+                                                             \TEDIT.OP.WIDTH)))
+                                   (IGEQ Y (IPLUS (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ)
+                                                  \TEDIT.OP.BOTTOM)))
                               (CURSOR \TEDIT.SPLITCURSOR)
                               (replace
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ with
 'WINDOW)
                               (replace
 LEFT of
 CURSORREG with
 LEFT)
-                              (replace
 WIDTH of
 CURSORREG with
 8))
+                              (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                              [[IGEQ X (SETQ LEFT (OR [AND LINE (COND
                                                                   ((fetch
 (FMTSPEC FMTHARDCOPY)
                                                                       of
 (fetch
 (
@@ -256,13 +267,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                              (T (replace
 LEFT of
 CURSORREG with
 0)
                                 (replace
 WIDTH of
 CURSORREG with
 LEFT))))
                     (WINDOW (COND
-                               ((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
-                                                                   of
 TEXTOBJ)
-                                                          8)))
+                               ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
+                                                                        of
 TEXTOBJ)
+                                                               \TEDIT.OP.WIDTH)))
+                                     (IGEQ Y (IPLUS (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ)
+                                                    \TEDIT.OP.BOTTOM)))
                                 (replace
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ with

                                                                                   'WINDOW)
                                 (replace
 LEFT of
 CURSORREG with
 LEFT)
-                                (replace
 WIDTH of
 CURSORREG with
 8))
+                                (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                                ([IGEQ X (SETQ LEFT
                                          (OR [AND LINE (COND
                                                           ((fetch
 (FMTSPEC FMTHARDCOPY)
@@ -454,355 +467,359 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                    (PROCESSP (WINDOWPROP W 'PROCESS])
 
 (\TEDIT.BUTTONEVENTFN

-  [LAMBDA (W STREAM)
                                    (* ; "Edited 24-Aug-2021 23:30 by rmk:")

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 19-Sep-2021 22:58 by rmk:")

 
-    (* ;; "Handle button events for a TEdit window")

+    (* ;; "Handle button events for a TEdit window.  If no button is down, we got control on button-up transition, so ignore it.")

 
-    (AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
-    (PROG* ((OSEL NIL)
-            (SEL NIL)
-            [TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
-            (DS (WINDOWPROP W 'DSP))
-            USERFN
-            (GLOBALSEL TEDIT.SELECTION)
-            (X (LASTMOUSEX W))
-            (Y (LASTMOUSEY W))
-            (CLIPREGION (DSPCLIPPINGREGION NIL W))
-            (SELOPERATION 'NORMAL)
-            (SELFN (TEXTPROP TEXTOBJ 'SELFN))
-            (EXTENDFLG NIL)
-            (OLDX -32000)
-            (OLDY -32000)
-            SELFINALFN PROC NOSEL)
-           (COND
-              ((NOT (MOUSESTATE (OR LEFT MIDDLE RIGHT)))     (* ; 
-
                       "No button is down -- we got control on button-up transition, so ignore it.")

-               (RETURN))
-              (TEDIT.SELPENDING                              (* ; 
-
                     "There is already a selection in progress.  Don't allow another to interfere.")

-                     (RETURN)))
-           (replace
 (SELECTION CH#) of
 TEDIT.SCRATCHSELECTION with
 0)
-                                                             (* ; 
-
                     "Mark the user-visible scratch selection fresh, so changes can be detected...")

-           (COND
-              [[OR (NOT TEXTOBJ)
-                   (fetch
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ)
-                   (AND (NOT (WINDOWPROP W 'PROCESS))
-                        (NOT (TEXTPROP TEXTOBJ 'READONLY))
-                        (NOT (SHIFTDOWNP 'SHIFT))
-                        (NOT (SHIFTDOWNP 'CTRL))
-                        (NOT (SHIFTDOWNP 'META))
-                        (NOT (KEYDOWNP 'MOVE))
-                        (NOT (KEYDOWNP 'COPY]                (* ; "There's no edit session behind this window.  You can only do window ops, or re-establish a session.")

-               (TOTOPW W)
-               (COND
-                  ((\TEDIT.MOUSESTATE RIGHT)                 (* ; 
-
                                                        "Right button gets the window command menu")

-                   (DOWINDOWCOM W))
-                  ((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
-                        (NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
-                        [NOT (PROCESSP (WINDOWPROP W 'PROCESS]
-                        (\TEDIT.MOUSESTATE MIDDLE))          (* ; 
-
                                "Middle button on a dead window gives a menu for re-starting TEDIT")

-                   (COND
-                      ((EQ (MENU TEDIT.RESTART.MENU)
-                           'NewEditProcess)
-                       (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 NIL)
-                       (TEDIT (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                              W]
-              [(IGREATERP Y (fetch
 TOP of
 CLIPREGION))
-                                                             (* ; 
-
                                     "It's not inside the window's REAL region, so call on a menu.")

-               (TOTOPW W)
+    (TOTOPW W)
 
-               (* ;; "RMK:  This comment was originally just after the DON'T below, which generated a value-of-comment used message.")

+    (* ;; "RMK: 2021/9 TOTOPW was in (almost) all the conditional branches, I moved it up so that it always happens, even if the click is perhaps in a menu.  There were cases where a second click in the window was needed to bring it above an overlapping window that it was under.  I think perhaps it was because the mouse button may not have been seen as down on the first click, so it would return before it raised the window.  But that was really bizarre--maybe the click was to see what was obscured by the overlapping window.")

 
-               (* ;; "HAD BEEN:  (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it;  go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")

+    (CL:WHEN (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
+                  (NOT TEDIT.SELPENDING))
 
-               (COND
-                  ((\TEDIT.MOUSESTATE RIGHT)
-                   (DOWINDOWCOM W))
-                  ((MOUSESTATE (OR LEFT MIDDLE))
-                   (AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
-                        (NEQ USERFN 'DON'T)
-                        (ADD.PROCESS (LIST USERFN (KWOTE W]
-              ((AND TEXTOBJ (EQ (fetch
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ)
-                                'WINDOW))                    (* ; 
-
                    "We're in the window-ops region of the window.  Do a window split or something")

-               (\TEDIT.WINDOW.OPS
 TEXTOBJ W))
-              ((AND TEXTOBJ (NOT (fetch
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ)))
-                                                             (* ; 
-
           "Usual case -- he's really selecting something.  And there's nothing else going on now.")

-               (TOTOPW W)                                    (* ; 
-
                          "Move the editing window to the top, so he can select wherever he wants.")

-               (\CARET.DOWN)                                 (* ; 
-
                                                       "Make sure the caret isn't being displayed.")

-               (RESETLST
-                   (RESETSAVE TEDIT.SELPENDING TEXTOBJ)
+        (* ;; "(RMK:  old comment): Bail out if the mouse isn't down or there is a pending selection--don't want another selection to interfere.")

 
-                   (* ;; "Tell all TEdits not to run, since there is a selection in progress.  This is reset to NIL on return from here, to re-enable TEdit runs.")

+        (AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
+        [LET* ((OSEL NIL)
+               (SEL NIL)
+               [TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
+               (DS (WINDOWPROP W 'DSP))
+               USERFN
+               (GLOBALSEL TEDIT.SELECTION)
+               (X (LASTMOUSEX W))
+               (Y (LASTMOUSEY W))
+               (CLIPREGION (DSPCLIPPINGREGION NIL W))
+               (SELOPERATION 'NORMAL)
+               (SELFN (TEXTPROP TEXTOBJ 'SELFN))
+               (EXTENDFLG NIL)
+               (OLDX -32000)
+               (OLDY -32000)
+               SELFINALFN PROC NOSEL)
+              (replace
 (SELECTION CH#) of
 TEDIT.SCRATCHSELECTION with
 0)
+                                                             (* ; 
+
                     "Mark the user-visible scratch selection fresh, so changes can be detected...")

+              (COND
+                 [[OR (NOT TEXTOBJ)
+                      (fetch
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ)
+                      (AND (NOT (WINDOWPROP W 'PROCESS))
+                           (NOT (TEXTPROP TEXTOBJ 'READONLY))
+                           (NOT (SHIFTDOWNP 'SHIFT))
+                           (NOT (SHIFTDOWNP 'CTRL))
+                           (NOT (SHIFTDOWNP 'META))
+                           (NOT (KEYDOWNP 'MOVE))
+                           (NOT (KEYDOWNP 'COPY]             (* ; "There's no edit session behind this window.  You can only do window ops, or re-establish a session.")

+                  (COND
+                     ((\TEDIT.MOUSESTATE RIGHT)              (* ; 
+
                                                        "Right button gets the window command menu")

+                      (DOWINDOWCOM W))
+                     ((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
+                           (NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
+                           [NOT (PROCESSP (WINDOWPROP W 'PROCESS]
+                           (\TEDIT.MOUSESTATE MIDDLE))       (* ; 
+
                                "Middle button on a dead window gives a menu for re-starting TEDIT")

+                      (COND
+                         ((EQ (MENU TEDIT.RESTART.MENU)
+                              'NewEditProcess)
+                          (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 NIL)
+                          (TEDIT (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
+                                 W]
+                 [(IGREATERP Y (fetch
 TOP of
 CLIPREGION))
+                                                             (* ; 
+
                                     "It's not inside the window's REAL region, so call on a menu.")

 
-                   (RESETSAVE (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
-                                 do
 (replace
 TCCARET of
 CARET with
 (\CARET.CREATE
-                                                                                    BXHICARET)))
-                          (LIST '\TEDIT.CARET (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)))
-                                                             (* ; 
-
                                   "Then make the caret be the special, tall one so he can see it.")

-                   (COND
-                      ((KEYDOWNP 'COPY)                      (* ; 
-
                                                      "In a read-only document, you can only copy.")

-                       (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
-                       (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'COPY))
-                      ((AND (KEYDOWNP 'MOVE)
-                            (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
-                                                             (* ; 
-
                                                          "The MOVE key is down, so set MOVE mode.")

-                       (SETQ GLOBALSEL TEDIT.MOVESELECTION)
-                       (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'MOVE))
-                      [(SHIFTDOWNP 'SHIFT)                   (* ; 
-
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

-                       (COND
-                          ((AND (SHIFTDOWNP 'CTRL)
-                                (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
-                                                             (* ; "CTRL-SHIFT select means MOVE.")

-                           (SETQ GLOBALSEL TEDIT.MOVESELECTION)
-                           (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
-                           (SETQ SELOPERATION 'MOVE))
-                          (T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
-                             (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
-                             (SETQ SELOPERATION 'COPY]
-                      ((SHIFTDOWNP 'META)                    (* ; 
-
                                        "He's holding the meta key down , do a copylooks selection")

-                       (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
-                       (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'COPYLOOKS))
-                      ((AND (SHIFTDOWNP 'CTRL)
-                            (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
-                                                             (* ; 
-
                                               "He's holding the control key down;  note the fact.")

-                       (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                              NIL NIL)
-                       (SETQ GLOBALSEL TEDIT.DELETESELECTION)
-                       [COND
-                          ((fetch
 (SELECTION SET) of
 (fetch
 (TEXTOBJ DELETESEL)
-                                                                of
 TEXTOBJ))
-                                                             (* ; 
-
         "There's a pending delete selection.  Use it, and turn off the existing normal selection.")

-                           )
-                          (T                                 (* ; 
-
                     "No existing delete selection.  Use the normal selection as a starting point.")

-                             (\COPYSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                                    (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ]
-                       (replace
 (SELECTION SET) of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                          with
 NIL)
+                  (* ;; "RMK:  This comment was originally just after the DON'T below, which generated a value-of-comment used message.")

 
-                       (* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")

+                  (* ;; "HAD BEEN:  (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it;  go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")

 
-                       (SETQ OSEL (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'DELETE)
-                       (TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
-                       (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL))
-                      (T (SETQ OSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-                         (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL)
-                                                             (* ; "Reset the pending-delete flag.")

-                         ))
-                   (\COPYSEL OSEL GLOBALSEL)
-                   (bind
 (OSELOP _ SELOPERATION)
-                      while
 [OR (SHIFTDOWNP 'SHIFT)
-                                    (SHIFTDOWNP 'CTRL)
-                                    (SHIFTDOWNP 'META)
-                                    (KEYDOWNP 'MOVE)
-                                    (KEYDOWNP 'COPY)
-                                    (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
-                      do
                                 (* ; 
-
                                                   "Poll the selection & display its current state")

-                            [COND
-                               ((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
-                                                             (* ; 
-
                                                  "No mouse buttons are down;  don't try anything.")

-                                (SETQ OLDX -32000)           (* ; 
-
       "However, remember that pushing a mouse button is a change of status that we should notice.")

-                                )
-                               ((KEYDOWNP 'MOVE)             (* ; 
-
                                             "the MOVE key is down;  mark this selection for MOVE.")

-                                (SETQ SELOPERATION 'MOVE))
-                               [(OR (SHIFTDOWNP 'SHIFT)
-                                    (KEYDOWNP 'COPY))        (* ; 
-
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

-                                (COND
-                                   ((SHIFTDOWNP 'CTRL)       (* ; 
-
                                              "He's holding down both ctrl and shift -- do a move.")

-                                    (SETQ SELOPERATION 'MOVE))
-                                   (T                        (* ; 
-
                                                           "Just the SHIFT key.  It's a COPY")

-                                      (SETQ SELOPERATION 'COPY]
-                               ((SHIFTDOWNP 'META)           (* ; 
-
                                                  "He's holding the meta key down;  note the fact.")

-                                (SETQ SELOPERATION 'COPYLOOKS))
-                               ((SHIFTDOWNP 'CTRL)           (* ; 
-
                               "He's holding only the CTRL key -- mark the selection for deletion.")

-                                (SETQ SELOPERATION 'DELETE))
-                               (T                            (* ; 
-
                                             "No key being held down;  revert to normal selection.")

-                                  (SETQ SELOPERATION 'NORMAL]
-                            (COND
-                               [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
-                                         [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
-                                         (NEQ OSELOP SELOPERATION))
-                                     (INSIDEP CLIPREGION X Y))
+                  (COND
+                     ((\TEDIT.MOUSESTATE RIGHT)
+                      (DOWINDOWCOM W))
+                     ((MOUSESTATE (OR LEFT MIDDLE))
+                      (AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
+                           (NEQ USERFN 'DON'T)
+                           (ADD.PROCESS (LIST USERFN (KWOTE W]
+                 ((AND TEXTOBJ (EQ (fetch
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ)
+                                   'WINDOW))                 (* ; 
+
                    "We're in the window-ops region of the window.  Do a window split or something")

+                  (\TEDIT.WINDOW.OPS
 TEXTOBJ W))
+                 ((AND TEXTOBJ (NOT (fetch
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ)))
+                                                             (* ; 
+
           "Usual case -- he's really selecting something.  And there's nothing else going on now.")

+                  (\CARET.DOWN)                              (* ; 
+
                                                       "Make sure the caret isn't being displayed.")

+                  (RESETLST
+                      (RESETSAVE TEDIT.SELPENDING TEXTOBJ)
 
-                                (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")

+                      (* ;; "Tell all TEdits not to run, since there is a selection in progress.  This is reset to NIL on return from here, to re-enable TEdit runs.")

 
-                                (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")

+                      (RESETSAVE (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
+                                    do
 (replace
 TCCARET of
 CARET with
 (\CARET.CREATE
+                                                                                       BXHICARET)))
+                             (LIST '\TEDIT.CARET (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)))
+                                                             (* ; 
+
                                   "Then make the caret be the special, tall one so he can see it.")

+                      (COND
+                         ((KEYDOWNP 'COPY)                   (* ; 
+
                                                      "In a read-only document, you can only copy.")

+                          (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
+                          (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'COPY))
+                         ((AND (KEYDOWNP 'MOVE)
+                               (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
+                                                             (* ; 
+
                                                          "The MOVE key is down, so set MOVE mode.")

+                          (SETQ GLOBALSEL TEDIT.MOVESELECTION)
+                          (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'MOVE))
+                         [(SHIFTDOWNP 'SHIFT)                (* ; 
+
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

+                          (COND
+                             ((AND (SHIFTDOWNP 'CTRL)
+                                   (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
+                                                             (* ; "CTRL-SHIFT select means MOVE.")

+                              (SETQ GLOBALSEL TEDIT.MOVESELECTION)
+                              (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
+                              (SETQ SELOPERATION 'MOVE))
+                             (T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
+                                (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
+                                (SETQ SELOPERATION 'COPY]
+                         ((SHIFTDOWNP 'META)                 (* ; 
+
                                        "He's holding the meta key down , do a copylooks selection")

+                          (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
+                          (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'COPYLOOKS))
+                         ((AND (SHIFTDOWNP 'CTRL)
+                               (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
+                                                             (* ; 
+
                                               "He's holding the control key down;  note the fact.")

+                          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+                                 NIL NIL)
+                          (SETQ GLOBALSEL TEDIT.DELETESELECTION)
+                          [COND
+                             ((fetch
 (SELECTION SET) of
 (fetch
 (TEXTOBJ DELETESEL)
+                                                                   of
 TEXTOBJ))
+                                                             (* ; 
+
         "There's a pending delete selection.  Use it, and turn off the existing normal selection.")

+                              )
+                             (T                              (* ; 
+
                     "No existing delete selection.  Use the normal selection as a starting point.")

+                                (\COPYSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+                                       (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ]
+                          (replace
 (SELECTION SET) of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ
+                                                                     ) with
 NIL)
 
-                                (SETQ OLDX X)
-                                (SETQ OLDY Y)
-                                [COND
-                                   ((\TEDIT.MOUSESTATE LEFT) (* ; 
-
                                                           "Left button is character selection")

-                                    (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
-                                                                                          MOUSEREGION
-                                                                                          )
-                                                                           of
 TEXTOBJ)
-                                                     NIL SELOPERATION W))
-                                    (SETQ EXTENDFLG NIL))
-                                   ((\TEDIT.MOUSESTATE MIDDLE)
-                                                             (* ; "Middle button is word selection")

-                                    (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
-                                                                                          MOUSEREGION
-                                                                                          )
-                                                                           of
 TEXTOBJ)
-                                                     T SELOPERATION W))
-                                    (SETQ EXTENDFLG NIL))
-                                   [(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections")

-                                    (COND
-                                       ((NEQ SELOPERATION OSELOP)
+                          (* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")

 
-                                 (* ;; "Things changed since the last selection.  Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")

-
-                                        (\COPYSEL OSEL GLOBALSEL)))
-                                    (COND
-                                       ((fetch
 (SELECTION SET) of
 GLOBALSEL)
-                                        (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
-                                                                             'NORMAL)
-                                             (SETQ SELOPERATION 'PENDINGDEL)
-                                             (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ
-                                                with
 T)) (* ; 
-
       "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")

-                                        (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ 
-                                                         SELOPERATION W))
-                                        (SETQ EXTENDFLG T]
-                                   (T                        (* ; 
-
                        "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")

-                                      (\COPYSEL OSEL GLOBALSEL)
-                                                             (* ; 
-
                       "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")

-                                      (AND SEL (replace
 (SELECTION SET) of
 SEL with

-                                                                                       NIL]
-                                [COND
-                                   ((AND SEL (fetch
 (SELECTION SET) of
 SEL)
-                                         SELFN)              (* ; 
-
                               "The selection was set, but there's a SELFN that has veto authority")

-                                    (COND
-                                       ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
-                                            'DON'T)          (* ; 
-
                                              "The selfn vetoed this selection, so mark it un-set.")

-                                        (replace
 (SELECTION SET) of
 SEL with
 NIL]
-                                (COND
-                                   ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
-                                                             (* ; 
-
             "Something interesting about the selection changed.  We have to re-display its image.")

-                                    (COND
-                                       ((OR (EQ SELOPERATION 'NORMAL)
-                                            (EQ SELOPERATION 'PENDINGDEL))
-                                                             (* ; 
-
                        "For a normal selection, set the 'window last selected in' for the TEXTOBJ")

-                                        (replace
 (TEXTOBJ SELWINDOW) of
 TEXTOBJ with

-                                                                                        W)))
-                                    (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP 
-                                                      SELOPERATION EXTENDFLG))
-                                    (SETQ OSELOP SELOPERATION))
-                                   ([AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
-                                         (EQ (fetch
 (SELECTION SELKIND) of
 OSEL)
-                                             'VOLATILE)
-                                         (OR (NOT SEL)
-                                             (NOT (fetch
 (SELECTION SET) of
 SEL]
-
-                                 (* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it.  Turn it off.")

-
-                                    (\SHOWSEL OSEL NIL NIL)
-                                    (replace
 (SELECTION SET) of
 OSEL with
 NIL]
-                               ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
-                                                             (* ; 
-
                                    "If he moves to the scroll bar, let him scroll without trouble")

-                                (SCROLL.HANDLER W)))
-                            (BLOCK)                          (* ; "Give other processes a chance")

-                            (GETMOUSESTATE)                  (* ; "And get the new mouse info")

-                            (TEDIT.CURSORMOVEDFN
 W))
-                   (\COPYSEL OSEL GLOBALSEL)
-                   (COND
-                      ((fetch
 (SELECTION SET) of
 OSEL)
-                                                             (* ; 
-
                                        "Only if a selection REALLY got made should we do this....")

-                       (SELECTQ SELOPERATION
-                           (COPY                             (* ; 
-
           "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")

-                                 (SETQ TEDIT.COPY.PENDING T)
-                                 (replace
 (SELECTION SET) of
 OSEL with
 NIL)
-                                                             (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

-                                 (\TEDIT.FOREIGN.COPY? GLOBALSEL)
-                                                             (* ; 
-
                               "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")

-                                 )
-                           (COPYLOOKS                        (* ; "A COPYLOOKS selection")

-                                      (SETQ TEDIT.COPYLOOKS.PENDING T)
-                                                             (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

-                                      (replace
 (SELECTION SET) of
 OSEL with
 NIL))
-                           (MOVE                             (* ; 
-
                               "A MOVE selection -- set the flag to signal the TEdit command loop,")

-                                 (SETQ TEDIT.MOVE.PENDING T) (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

-                                 (replace
 (SELECTION SET) of
 OSEL with
 NIL))
-                           (DELETE (SETQ TEDIT.DEL.PENDING T)
-                                   (replace
 (SELECTION SET) of
 OSEL with
 NIL)
-                                                             (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

+                          (SETQ OSEL (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'DELETE)
+                          (TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
+                          (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL))
+                         (T (SETQ OSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+                            (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL)
+                                                             (* ; "Reset the pending-delete flag.")

+                            ))
+                      (\COPYSEL OSEL GLOBALSEL)
+                      (bind
 (OSELOP _ SELOPERATION)
+                         while
 [OR (SHIFTDOWNP 'SHIFT)
+                                       (SHIFTDOWNP 'CTRL)
+                                       (SHIFTDOWNP 'META)
+                                       (KEYDOWNP 'MOVE)
+                                       (KEYDOWNP 'COPY)
+                                       (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
+                         do
                              (* ; 
+
                                                   "Poll the selection & display its current state")

+                               [COND
+                                  ((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
+                                                             (* ; 
+
                                                  "No mouse buttons are down;  don't try anything.")

+                                   (SETQ OLDX -32000)        (* ; 
+
       "However, remember that pushing a mouse button is a change of status that we should notice.")

                                    )
-                           (NORMAL                           (* ; 
-
                                                 "This is a normal selection;  set the caret looks")

-                                   (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ
-                                      with
 (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
-                           NIL)))
-                   (AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
-                                                             (* ; 
-
                             "Give a user exit routine control, perhaps for logging of selections.")

-                   (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
-                      do
 (OR (fetch
 TCUP of
 CARET)
-                                 (\EDIT.FLIPCARET
 CARET T))))
-               (AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
-                    (fetch
 (SELECTION SELOBJ) of
 OSEL)
-                    (SETQ SELFINALFN (IMAGEOBJPROP (fetch
 (SELECTION SELOBJ) of
 OSEL)
-                                            'WHENOPERATEDONFN))
-                    (APPLY* SELFINALFN (fetch
 (SELECTION SELOBJ) of
 OSEL)
-                           (WINDOWPROP W 'DSP)
-                           'SELECTED OSEL (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ])
+                                  ((KEYDOWNP 'MOVE)          (* ; 
+
                                             "the MOVE key is down;  mark this selection for MOVE.")

+                                   (SETQ SELOPERATION 'MOVE))
+                                  [(OR (SHIFTDOWNP 'SHIFT)
+                                       (KEYDOWNP 'COPY))     (* ; 
+
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

+                                   (COND
+                                      ((SHIFTDOWNP 'CTRL)    (* ; 
+
                                              "He's holding down both ctrl and shift -- do a move.")

+                                       (SETQ SELOPERATION 'MOVE))
+                                      (T                     (* ; 
+
                                                           "Just the SHIFT key.  It's a COPY")

+                                         (SETQ SELOPERATION 'COPY]
+                                  ((SHIFTDOWNP 'META)        (* ; 
+
                                                  "He's holding the meta key down;  note the fact.")

+                                   (SETQ SELOPERATION 'COPYLOOKS))
+                                  ((SHIFTDOWNP 'CTRL)        (* ; 
+
                               "He's holding only the CTRL key -- mark the selection for deletion.")

+                                   (SETQ SELOPERATION 'DELETE))
+                                  (T                         (* ; 
+
                                             "No key being held down;  revert to normal selection.")

+                                     (SETQ SELOPERATION 'NORMAL]
+                               (COND
+                                  [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
+                                            [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
+                                            (NEQ OSELOP SELOPERATION))
+                                        (INSIDEP CLIPREGION X Y))
+
+                                  (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")

+
+                                 (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")

+
+                                   (SETQ OLDX X)
+                                   (SETQ OLDY Y)
+                                   [COND
+                                      ((\TEDIT.MOUSESTATE LEFT)
+                                                             (* ; 
+
                                                           "Left button is character selection")

+                                       (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
+                                                                                          MOUSEREGION
+                                                                                             )
+                                                                              of
 TEXTOBJ)
+                                                        NIL SELOPERATION W))
+                                       (SETQ EXTENDFLG NIL))
+                                      ((\TEDIT.MOUSESTATE MIDDLE)
+                                                             (* ; "Middle button is word selection")

+                                       (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
+                                                                                          MOUSEREGION
+                                                                                             )
+                                                                              of
 TEXTOBJ)
+                                                        T SELOPERATION W))
+                                       (SETQ EXTENDFLG NIL))
+                                      [(\TEDIT.MOUSESTATE RIGHT)
+                                                             (* ; "RIght button extends selections")

+                                       (COND
+                                          ((NEQ SELOPERATION OSELOP)
+
+                                 (* ;; "Things changed since the last selection.  Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")

+
+                                           (\COPYSEL OSEL GLOBALSEL)))
+                                       (COND
+                                          ((fetch
 (SELECTION SET) of
 GLOBALSEL)
+                                           (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
+                                                                                'NORMAL)
+                                                (SETQ SELOPERATION 'PENDINGDEL)
+                                                (replace
 (TEXTOBJ BLUEPENDINGDELETE) of

+                                                                                         TEXTOBJ
+                                                   with
 T))
+                                                             (* ; 
+
       "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")

+                                           (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ 
+                                                            SELOPERATION W))
+                                           (SETQ EXTENDFLG T]
+                                      (T                     (* ; 
+
                        "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")

+                                         (\COPYSEL OSEL GLOBALSEL)
+                                                             (* ; 
+
                       "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")

+                                         (AND SEL (replace
 (SELECTION SET) of
 SEL
+                                                     with
 NIL]
+                                   [COND
+                                      ((AND SEL (fetch
 (SELECTION SET) of
 SEL)
+                                            SELFN)           (* ; 
+
                               "The selection was set, but there's a SELFN that has veto authority")

+                                       (COND
+                                          ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
+                                               'DON'T)       (* ; 
+
                                              "The selfn vetoed this selection, so mark it un-set.")

+                                           (replace
 (SELECTION SET) of
 SEL with
 NIL]
+                                   (COND
+                                      ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
+                                                             (* ; 
+
             "Something interesting about the selection changed.  We have to re-display its image.")

+                                       (COND
+                                          ((OR (EQ SELOPERATION 'NORMAL)
+                                               (EQ SELOPERATION 'PENDINGDEL))
+                                                             (* ; 
+
                        "For a normal selection, set the 'window last selected in' for the TEXTOBJ")

+                                           (replace
 (TEXTOBJ SELWINDOW) of
 TEXTOBJ
+                                              with
 W)))
+                                       (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP 
+                                                         SELOPERATION EXTENDFLG))
+                                       (SETQ OSELOP SELOPERATION))
+                                      ([AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
+                                            (EQ (fetch
 (SELECTION SELKIND) of
 OSEL)
+                                                'VOLATILE)
+                                            (OR (NOT SEL)
+                                                (NOT (fetch
 (SELECTION SET) of
 SEL]
+
+                                 (* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it.  Turn it off.")

+
+                                       (\SHOWSEL OSEL NIL NIL)
+                                       (replace
 (SELECTION SET) of
 OSEL with
 NIL]
+                                  ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
+                                                             (* ; 
+
                                    "If he moves to the scroll bar, let him scroll without trouble")

+                                   (SCROLL.HANDLER W)))
+                               (BLOCK)                       (* ; "Give other processes a chance")

+                               (GETMOUSESTATE)               (* ; "And get the new mouse info")

+                               (TEDIT.CURSORMOVEDFN
 W))
+                      (\COPYSEL OSEL GLOBALSEL)
+                      (COND
+                         ((fetch
 (SELECTION SET) of
 OSEL)
+                                                             (* ; 
+
                                        "Only if a selection REALLY got made should we do this....")

+                          (SELECTQ SELOPERATION
+                              (COPY                          (* ; 
+
           "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")

+                                    (SETQ TEDIT.COPY.PENDING T)
+                                    (replace
 (SELECTION SET) of
 OSEL with
 NIL)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                    (\TEDIT.FOREIGN.COPY? GLOBALSEL)
+                                                             (* ; 
+
                               "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")

+                                    )
+                              (COPYLOOKS                     (* ; "A COPYLOOKS selection")

+                                         (SETQ TEDIT.COPYLOOKS.PENDING T)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                         (replace
 (SELECTION SET) of
 OSEL with
 NIL))
+                              (MOVE                          (* ; 
+
                               "A MOVE selection -- set the flag to signal the TEdit command loop,")

+                                    (SETQ TEDIT.MOVE.PENDING T)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                    (replace
 (SELECTION SET) of
 OSEL with
 NIL))
+                              (DELETE (SETQ TEDIT.DEL.PENDING T)
+                                      (replace
 (SELECTION SET) of
 OSEL with
 NIL)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                      )
+                              (NORMAL                        (* ; 
+
                                                 "This is a normal selection;  set the caret looks")

+                                      (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ
+                                         with
 (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
+                              NIL)))
+                      (AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
+                                                             (* ; 
+
                             "Give a user exit routine control, perhaps for logging of selections.")

+                      (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
+                         do
 (OR (fetch
 TCUP of
 CARET)
+                                    (\EDIT.FLIPCARET
 CARET T))))
+                  (AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
+                       (fetch
 (SELECTION SELOBJ) of
 OSEL)
+                       (SETQ SELFINALFN (IMAGEOBJPROP (fetch
 (SELECTION SELOBJ) of
 OSEL)
+                                               'WHENOPERATEDONFN))
+                       (APPLY* SELFINALFN (fetch
 (SELECTION SELOBJ) of
 OSEL)
+                              (WINDOWPROP W 'DSP)
+                              'SELECTED OSEL (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ])])
 
 (\TEDIT.WINDOW.OPS

-  [LAMBDA (TEXTOBJ WINDOWTOSPLIT)
                        (* ; "Edited 30-May-91 23:33 by jds")

+  [LAMBDA (TEXTOBJ WINDOWTOSPLIT)
                       (* ; "Edited 12-Oct-2021 15:01 by rmk:")

 
 (* ;;; "Do window operations for TEdit, e.g., splitting a window, moving the split location, or unsplitting.")

 
     (PROG ([WINDOWOPREGION (create
 REGION
                                   LEFT _ (DIFFERENCE (fetch
 (TEXTOBJ WRIGHT) of
 TEXTOBJ)
-                                                8)
-                                  BOTTOM _ 0
-                                  WIDTH _ 8
-                                  HEIGHT _ (fetch
 HEIGHT of
 (WINDOWPROP WINDOWTOSPLIT
-                                                                           'REGION]
+                                                \TEDIT.OP.WIDTH)
+                                  BOTTOM _ \TEDIT.OP.BOTTOM
+                                  WIDTH _ \TEDIT.OP.WIDTH
+                                  HEIGHT _ (fetch
 (REGION HEIGHT) of
 (WINDOWPROP 
+                                                                                    WINDOWTOSPLIT
+                                                                                    'REGION]
            Y OPERATION)
           [while
 [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
                           (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT)
@@ -842,7 +859,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                            (\TEDIT.UNSPLITW
 WINDOWTOSPLIT))
                   (MOVE                                      (* ; 
 
                                                           "Moving the divider between two panes.")

-                        (TEDIT.PROMPTPRINT
 TEXTOBJ "Can't move the split point yet." T))
+                        (TEDIT.PROMPTPRINT
 TEXTOBJ "Split-point moving is not yet implemented" T))
                   (SHOULDNT)))
              (T (CURSOR T])
 
@@ -1363,6 +1380,16 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
         (CAR LIST.OR.ATOM))
        (T LIST.OR.ATOM])
 )
+
+(RPAQ? \TEDIT.OP.WIDTH
 12)
+
+(RPAQ? \TEDIT.OP.BOTTOM
 12)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM)
+)
+)
 (RPAQ BXCARET (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@CH@@CH@@FL@@FL@@LF@@
 ) (QUOTE NIL) 3 4))
 (RPAQ BXHICARET (CURSORCREATE (QUOTE #*(16 16)A@@@A@@@A@@@A@@@A@@@A@@@A@@@A@@@CH@@GL@@FL@@LF@@HB@@@@@@@@@@@@@@
@@ -1922,9 +1949,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
       ])
 
 (\TEDIT.SCROLLFN

-  [LAMBDA (W DX DY)
                                      (* ; "Edited 31-May-91 13:32 by jds")

+  [LAMBDA (W DX DY)
                                     (* ; "Edited 19-Sep-2021 23:10 by rmk:")

                                                              (* Handle scrolling of the edit 
 
                                                           window)

+    (TOTOPW W)
     (PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
                   (PRIORCR 0)
                   SELWASON SHIFTEDSELWASON MOVESELWASON DELETESELWASON (WREG (DSPCLIPPINGREGION
@@ -2826,25 +2854,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
 (PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 
 1989 1990 1991 1993 1994 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7165 91937 (TEDIT.CREATEW 7175 . 8311) (\TEDIT.CREATEW.FROM.REGION 8313 . 9297) (
-TEDIT.CURSORMOVEDFN 9299 . 19951) (TEDIT.CURSOROUTFN 19953 . 20488) (TEDIT.WINDOW.SETUP 20490 . 22299)
- (TEDIT.MINIMAL.WINDOW.SETUP 22301 . 30090) (\TEDIT.ACTIVE.WINDOWP 30092 . 31073) (
-\TEDIT.BUTTONEVENTFN 31075 . 54913) (\TEDIT.WINDOW.OPS 54915 . 58718) (\TEDIT.EXPANDFN 58720 . 59123) 
-(\TEDIT.MAINW 59125 . 60414) (\TEDIT.PRIMARYW 60416 . 61628) (\TEDIT.COPYINSERTFN 61630 . 62601) (
-\TEDIT.NEWREGIONFN 62603 . 65070) (\TEDIT.SET.WINDOW.EXTENT 65072 . 71174) (\TEDIT.SHRINK.ICONCREATE 
-71176 . 73448) (\TEDIT.SHRINKFN 73450 . 74025) (\TEDIT.SPLITW 74027 . 80128) (\TEDIT.UNSPLITW 80130 . 
-85824) (\TEDIT.WINDOW.SETUP 85826 . 91546) (\SAFE.FIRST 91548 . 91935)) (93083 93990 (TEDITWINDOWP 
-93093 . 93988)) (94027 96523 (TEDIT.GETINPUT 94037 . 96020) (\TEDIT.MAKEFILENAME 96022 . 96521)) (
-96572 103023 (TEDIT.PROMPTPRINT 96582 . 99486) (TEDIT.PROMPTFLASH 99488 . 101443) (
-\TEDIT.PROMPT.PAGEFULLFN 101445 . 103021)) (103258 107320 (TEXTSTREAM.TITLE 103268 . 103889) (
-\TEDIT.ORIGINAL.WINDOW.TITLE 103891 . 105936) (\TEDIT.WINDOW.TITLE 105938 . 106608) (
-\TEXTSTREAM.FILENAME 106610 . 107318)) (107363 152087 (TEDIT.DEACTIVATE.WINDOW 107373 . 114522) (
-\TEDIT.REPAINTFN 114524 . 117381) (\TEDIT.RESHAPEFN 117383 . 123003) (\TEDIT.SCROLLFN 123005 . 152085)
-) (152129 154178 (\TEDIT.PROCIDLEFN 152139 . 153488) (\TEDIT.PROCENTRYFN 153490 . 153783) (
-\TEDIT.PROCEXITFN 153785 . 154176)) (154257 165257 (\EDIT.DOWNCARET 154267 . 154948) (\EDIT.FLIPCARET 
-154950 . 156485) (TEDIT.FLASHCARET 156487 . 157601) (\EDIT.UPCARET 157603 . 158056) (
-TEDIT.NORMALIZECARET 158058 . 164009) (\SETCARET 164011 . 164931) (\TEDIT.CARET 164933 . 165255)) (
-165291 179046 (TEDIT.ADD.MENUITEM 165301 . 167216) (TEDIT.DEFAULT.MENUFN 167218 . 176485) (
-TEDIT.REMOVE.MENUITEM 176487 . 177488) (\TEDIT.CREATEMENU 177490 . 177943) (\TEDIT.MENU.WHENHELDFN 
-177945 . 178715) (\TEDIT.MENU.WHENSELECTEDFN 178717 . 179044)))))
+  (FILEMAP (NIL (7288 94104 (TEDIT.CREATEW 7298 . 8434) (\TEDIT.CREATEW.FROM.REGION 8436 . 9420) (
+TEDIT.CURSORMOVEDFN 9422 . 20808) (TEDIT.CURSOROUTFN 20810 . 21345) (TEDIT.WINDOW.SETUP 21347 . 23156)
+ (TEDIT.MINIMAL.WINDOW.SETUP 23158 . 30947) (\TEDIT.ACTIVE.WINDOWP 30949 . 31930) (
+\TEDIT.BUTTONEVENTFN 31932 . 56922) (\TEDIT.WINDOW.OPS 56924 . 60885) (\TEDIT.EXPANDFN 60887 . 61290) 
+(\TEDIT.MAINW 61292 . 62581) (\TEDIT.PRIMARYW 62583 . 63795) (\TEDIT.COPYINSERTFN 63797 . 64768) (
+\TEDIT.NEWREGIONFN 64770 . 67237) (\TEDIT.SET.WINDOW.EXTENT 67239 . 73341) (\TEDIT.SHRINK.ICONCREATE 
+73343 . 75615) (\TEDIT.SHRINKFN 75617 . 76192) (\TEDIT.SPLITW 76194 . 82295) (\TEDIT.UNSPLITW 82297 . 
+87991) (\TEDIT.WINDOW.SETUP 87993 . 93713) (\SAFE.FIRST 93715 . 94102)) (95434 96341 (TEDITWINDOWP 
+95444 . 96339)) (96378 98874 (TEDIT.GETINPUT 96388 . 98371) (\TEDIT.MAKEFILENAME 98373 . 98872)) (
+98923 105374 (TEDIT.PROMPTPRINT 98933 . 101837) (TEDIT.PROMPTFLASH 101839 . 103794) (
+\TEDIT.PROMPT.PAGEFULLFN 103796 . 105372)) (105609 109671 (TEXTSTREAM.TITLE 105619 . 106240) (
+\TEDIT.ORIGINAL.WINDOW.TITLE 106242 . 108287) (\TEDIT.WINDOW.TITLE 108289 . 108959) (
+\TEXTSTREAM.FILENAME 108961 . 109669)) (109714 154455 (TEDIT.DEACTIVATE.WINDOW 109724 . 116873) (
+\TEDIT.REPAINTFN 116875 . 119732) (\TEDIT.RESHAPEFN 119734 . 125354) (\TEDIT.SCROLLFN 125356 . 154453)
+) (154497 156546 (\TEDIT.PROCIDLEFN 154507 . 155856) (\TEDIT.PROCENTRYFN 155858 . 156151) (
+\TEDIT.PROCEXITFN 156153 . 156544)) (156625 167625 (\EDIT.DOWNCARET 156635 . 157316) (\EDIT.FLIPCARET 
+157318 . 158853) (TEDIT.FLASHCARET 158855 . 159969) (\EDIT.UPCARET 159971 . 160424) (
+TEDIT.NORMALIZECARET 160426 . 166377) (\SETCARET 166379 . 167299) (\TEDIT.CARET 167301 . 167623)) (
+167659 181414 (TEDIT.ADD.MENUITEM 167669 . 169584) (TEDIT.DEFAULT.MENUFN 169586 . 178853) (
+TEDIT.REMOVE.MENUITEM 178855 . 179856) (\TEDIT.CREATEMENU 179858 . 180311) (\TEDIT.MENU.WHENHELDFN 
+180313 . 181083) (\TEDIT.MENU.WHENSELECTEDFN 181085 . 181412)))))
 STOP

library/TEXTOFD

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 6-May-2021 10:18:06" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;4
 176139 
 
-      changes to%:  (FNS \TEXTINIT)
+
(FILECREATED "12-Oct-2021 15:38:41" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;4
 176302 
 
-      previous date%: "11-Feb-2001 12:06:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;2)
+      changes to%:  (FNS \TEDITOUTCCODEFN)
+
+      previous date%: " 7-Oct-2021 08:41:13" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;3)
 
 
 (* ; "
@@ -25,24 +26,24 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
         (FNS \INSERTCH \INSERTCR)
         (COMS 
 
-(* ;;; "Functions to manipulate the Piece Table (PCTB)")

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

 
               (FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE 
                    \INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE))
-        (COMS                                                (* ; 
-
                                                           "Generic-IO type operations support")

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

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

+        (COMS                                                (* ; "Support for TEXTPROP")

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

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

 
               (INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN]
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT)))
@@ -676,29 +677,29 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
           (RETURN PC])
 
 (\TEXTINIT

-  [LAMBDA NIL
                                           (* ; "Edited  6-May-2021 10:17 by rmk:")

-                                                             (* ; 
-
                                          "Create the FDEV and STREAM prototypes for TEXT streams.")

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

+                                                             (* ; 
+
                                          "Create the FDEV and STREAM prototypes for TEXT streams.")

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

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

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

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

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

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

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

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

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

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

 
-    (* ;; "F4")

+    (* ;; "F4")

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

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

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

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

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

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

 
-    (* ;; "(FW8 WORD)")

+    (* ;; "(FW8 WORD)")

 
     (SETQ \TEXTIMAGEOPS (create
 IMAGEOPS
                                IMAGETYPE _ 'TEXT
@@ -745,6 +746,9 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                            FDEXTENDABLE _ NIL
                            TRUNCATEFILE _ (FUNCTION NILL)
                            WRITEPAGES _ (FUNCTION NILL)))
+
+    (* ;; "The prototypical Text stream")

+
     (SETQ \TEXTOFD
      (create
 STREAM
             BINABLE _ T
@@ -761,10 +765,16 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
             FW7 _ 0
             MAXBUFFERS _ 10
             IMAGEOPS _ \TEXTIMAGEOPS
-            IMAGEDATA _ (create
 TEXTIMAGEDATA)
-            OUTCHARFN _ (FUNCTION \TEDITOUTCHARFN)))         (* ; "The prototypical Text stream")

+            IMAGEDATA _ (create
 TEXTIMAGEDATA)))
 
-    (* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")

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

+
+    (MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN)
+           NIL
+           'CR)
+    (\EXTERNALFORMAT \TEXTOFD :TEDIT)
+
+    (* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")

 
     (CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
            (FUNCTION (LAMBDA (CONDITION)
@@ -772,8 +782,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                             (COND
                                [(AND (BOUNDP 'ERRORPOS)
                                      (TEXTSTREAMP
 STREAM))
-                                                             (* ; 
-
           "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")

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

                                 (LET ((XCL::RESULT (REOPENTEXTSTREAM
 STREAM)))
                                      (CL:WHEN XCL::RESULT
                                          (ENVAPPLY (STKNAME ERRORPOS)
@@ -781,8 +791,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                                 (STKNTH -1 ERRORPOS ERRORPOS)
                                                 ERRORPOS T T))]
                                (*TEDIT-OLD-STREAM-ERROR-HANDLER* 
-                                                             (* ; 
-
                         "Some other kind of stream, so punt to the old handler (if there is one):")

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

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

@@ -1782,10 +1792,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
           (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
           (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 NIL])
 
-(\TEDITOUTCHARFN

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

+(\TEDITOUTCCODEFN

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

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

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

 
     (COND
        ((EQ CHARCODE (CHARCODE EOL))
@@ -2657,25 +2667,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
 (PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 
 1990 1991 1993 1994 1995 1999 2000 2001 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2982 52971 (COPYTEXTSTREAM 2992 . 6114) (OPENTEXTSTREAM 6116 . 20993) (REOPENTEXTSTREAM
- 20995 . 21417) (TEDIT.STREAMCHANGEDP 21419 . 21717) (TEXTSTREAMP 21719 . 22033) (TXTFILE 22035 . 
-22480) (\DELETECH 22482 . 33738) (\SETUPGETCH 33740 . 41019) (\TEDIT.REOPEN.STREAM 41021 . 42871) (
-\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42873 . 45311) (\TEXTINIT 45313 . 50864) (\TEXTMARK 50866 . 51614) (
-\TEXTTTYBOUT 51616 . 52969)) (52972 78404 (\INSERTCH 52982 . 76708) (\INSERTCR 76710 . 78402)) (78470 
-98786 (\CHTOPC 78480 . 79669) (\CHTOPCNO 79671 . 80933) (\CLEARPCTB 80935 . 81731) (
-\CREATEPIECEORSTREAM 81733 . 84707) (\DELETEPIECE 84709 . 85622) (\FINDPIECE 85624 . 85990) (
-\INSERTPIECE 85992 . 89002) (\MAKEPCTB 89004 . 90919) (\SPLITPIECE 90921 . 97880) (\INSERT.FIRST.PIECE
- 97882 . 98784)) (98838 123056 (\TEXTCLOSEF 98848 . 100075) (\TEXTCLOSEF-SUBTREE 100077 . 100783) (
-\TEXTDSPFONT 100785 . 101777) (\TEXTEOFP 101779 . 103138) (\TEXTGETEOFPTR 103140 . 103350) (
-\TEXTGETFILEPTR 103352 . 105415) (\TEXTOPENF 105417 . 106247) (\TEXTOPENF-SUBTREE 106249 . 107050) (
-\TEXTOUTCHARFN 107052 . 107400) (\TEXTBACKFILEPTR 107402 . 113303) (\TEXTBOUT 113305 . 116653) (
-\TEDITOUTCHARFN 116655 . 117901) (\TEXTSETEOF 117903 . 118412) (\TEXTSETFILEPTR 118414 . 119639) (
-\TEXTDSPXPOSITION 119641 . 120498) (\TEXTDSPYPOSITION 120500 . 121045) (\TEXTLEFTMARGIN 121047 . 
-121530) (\TEXTRIGHTMARGIN 121532 . 122468) (\TEXTDSPCHARWIDTH 122470 . 122708) (\TEXTDSPSTRINGWIDTH 
-122710 . 122950) (\TEXTDSPLINEFEED 122952 . 123054)) (123057 156801 (\TEXTBIN 123067 . 139853) (
-\TEDIT.TEXTBIN.STRINGSETUP 139855 . 145568) (\TEDIT.TEXTBIN.FILESETUP 145570 . 151956) (
-\TEDIT.TEXTBIN.NEW.PAGE 151958 . 156799)) (156802 170210 (\TEXTPEEKBIN 156812 . 165951) (
-\TEDIT.PEEKBIN.NEW.PAGE 165953 . 170208)) (170248 175466 (CGETTEXTPROP 170258 . 170734) (CTEXTPROP 
-170736 . 173080) (GETTEXTPROP 173082 . 173677) (PUTTEXTPROP 173679 . 175004) (TEXTPROP 175006 . 175464
+  (FILEMAP (NIL (2989 53114 (COPYTEXTSTREAM 2999 . 6121) (OPENTEXTSTREAM 6123 . 21000) (REOPENTEXTSTREAM
+ 21002 . 21424) (TEDIT.STREAMCHANGEDP 21426 . 21724) (TEXTSTREAMP 21726 . 22040) (TXTFILE 22042 . 
+22487) (\DELETECH 22489 . 33745) (\SETUPGETCH 33747 . 41026) (\TEDIT.REOPEN.STREAM 41028 . 42878) (
+\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42880 . 45318) (\TEXTINIT 45320 . 51007) (\TEXTMARK 51009 . 51757) (
+\TEXTTTYBOUT 51759 . 53112)) (53115 78547 (\INSERTCH 53125 . 76851) (\INSERTCR 76853 . 78545)) (78613 
+98929 (\CHTOPC 78623 . 79812) (\CHTOPCNO 79814 . 81076) (\CLEARPCTB 81078 . 81874) (
+\CREATEPIECEORSTREAM 81876 . 84850) (\DELETEPIECE 84852 . 85765) (\FINDPIECE 85767 . 86133) (
+\INSERTPIECE 86135 . 89145) (\MAKEPCTB 89147 . 91062) (\SPLITPIECE 91064 . 98023) (\INSERT.FIRST.PIECE
+ 98025 . 98927)) (98981 123219 (\TEXTCLOSEF 98991 . 100218) (\TEXTCLOSEF-SUBTREE 100220 . 100926) (
+\TEXTDSPFONT 100928 . 101920) (\TEXTEOFP 101922 . 103281) (\TEXTGETEOFPTR 103283 . 103493) (
+\TEXTGETFILEPTR 103495 . 105558) (\TEXTOPENF 105560 . 106390) (\TEXTOPENF-SUBTREE 106392 . 107193) (
+\TEXTOUTCHARFN 107195 . 107543) (\TEXTBACKFILEPTR 107545 . 113446) (\TEXTBOUT 113448 . 116796) (
+\TEDITOUTCCODEFN 116798 . 118064) (\TEXTSETEOF 118066 . 118575) (\TEXTSETFILEPTR 118577 . 119802) (
+\TEXTDSPXPOSITION 119804 . 120661) (\TEXTDSPYPOSITION 120663 . 121208) (\TEXTLEFTMARGIN 121210 . 
+121693) (\TEXTRIGHTMARGIN 121695 . 122631) (\TEXTDSPCHARWIDTH 122633 . 122871) (\TEXTDSPSTRINGWIDTH 
+122873 . 123113) (\TEXTDSPLINEFEED 123115 . 123217)) (123220 156964 (\TEXTBIN 123230 . 140016) (
+\TEDIT.TEXTBIN.STRINGSETUP 140018 . 145731) (\TEDIT.TEXTBIN.FILESETUP 145733 . 152119) (
+\TEDIT.TEXTBIN.NEW.PAGE 152121 . 156962)) (156965 170373 (\TEXTPEEKBIN 156975 . 166114) (
+\TEDIT.PEEKBIN.NEW.PAGE 166116 . 170371)) (170411 175629 (CGETTEXTPROP 170421 . 170897) (CTEXTPROP 
+170899 . 173243) (GETTEXTPROP 173245 . 173840) (PUTTEXTPROP 173842 . 175167) (TEXTPROP 175169 . 175627
 )))))
 STOP

library/UNICODE

@@ -1,18 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "21-Aug-2021 13:13:04" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193
 64903  
+
(FILECREATED "30-Sep-2021 16:03:18" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;194
 64783  
 
-      changes to%:  (FNS MAKE-UNICODE-TRANSLATION-TABLES)
-
-      previous date%: " 8-Aug-2021 13:10:17" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;192)
+      previous date%: "21-Aug-2021 13:13:04" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
 
 (RPAQQ UNICODECOMS

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

+              (* ;; "External formats")

 
               (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
               (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
@@ -25,14 +23,14 @@
               (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE))
               (FNS XTOUCODE UTOXCODE))
         [COMS 
-              (* ;; "Unicode mapping files")

+              (* ;; "Unicode mapping files")

 
               (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING 
                    WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER WRITE-UNICODE-MAPPING-FILENAME
                    )
               (VARS XCCS-SET-NAMES)
               
-              (* ;; "Automate dumping of a documentation prefix")

+              (* ;; "Automate dumping of a documentation prefix")

 
               [DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE" 
                                                                               :RADIX 16))
@@ -43,7 +41,7 @@
               (P (PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR")
                                                     '/unicode/xerox/]
         (COMS 
-              (* ;; "Set up translation tables for UTF8 and UTFBE external formats")

+              (* ;; "Set up translation tables for UTF8 and UTFBE external formats")

 
               (FNS MAKE-UNICODE-TRANSLATION-TABLES)
               [INITVARS (DEFAULT-XCCS-CHARSETS '(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS 
@@ -63,7 +61,7 @@
                                                  "NOTE: UNICODE requires EXPORTS.ALL for compilation"
                                                        T)))
                
-               (* ;; "These control the layout of the translation tables.  Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")

+               (* ;; "These control the layout of the translation tables.  Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")

 
                (CONSTANTS (TRANSLATION-SEGMENT-SIZE 128)
                       (MAX-ALIST-LENGTH 10)
@@ -78,13 +76,13 @@
 (DEFINEQ
 
 (UTF8.OUTCHARFN

-  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  8-Aug-2021 13:02 by rmk:")


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


-                                                            (* ; "Edited 30-Jan-2020 23:08 by rmk:")

+  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  8-Aug-2021 13:02 by rmk:")


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


+                                                            (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
-    (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")

+    (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")

 
-    (* ;; "Print UTF8 sequence for CHARCODE.  Do not do XCCS to Unicode translation if RAW.")

+    (* ;; "Print UTF8 sequence for CHARCODE.  Do not do XCCS to Unicode translation if RAW.")

 
     (IF
 (EQ CHARCODE (CHARCODE EOL))
         THEN
 (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
@@ -97,13 +95,13 @@
                DO
 (IF
 (ILESSP C 128)
                           THEN
 (\BOUT STREAM C)
                         ELSEIF
 (ILESSP C 2048)
-                          THEN
                           (* ; "x800")

+                          THEN
                           (* ; "x800")

                                 (\BOUT STREAM (LOGOR (LLSH 3 6)
                                                      (LRSH C 6)))
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
                                                      (LOADBYTE C 0 6)))
                         ELSEIF
 (ILESSP C 65536)
-                          THEN
                           (* ; "x10000")

+                          THEN
                           (* ; "x10000")

                                 (\BOUT STREAM (LOGOR (LLSH 7 5)
                                                      (LRSH C 12)))
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
@@ -111,7 +109,7 @@
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
                                                      (LOADBYTE C 0 6)))
                         ELSEIF
 (ILESSP C 2097152)
-                          THEN
                           (* ; "x200000")

+                          THEN
                           (* ; "x200000")

                                 (\BOUT STREAM (LOGOR (LLSH 15 4)
                                                      (LRSH C 18)))
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
@@ -123,29 +121,29 @@
                         ELSE
 (ERROR "CHARCODE too big for UTF8" C])
 
 (UTF8.INCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                           (* ; "Edited  6-Aug-2021 16:02 by rmk:")


-                                                            (* ; "Edited  6-Aug-2020 17:13 by rmk:")

+  [LAMBDA (STREAM COUNTP RAW)
                           (* ; "Edited  6-Aug-2021 16:02 by rmk:")


+                                                            (* ; "Edited  6-Aug-2020 17:13 by rmk:")

 
-    (* ;; "Do not do UNICODE to XCSS translation if RAW.")

+    (* ;; "Do not do UNICODE to XCSS translation if RAW.")

 
-    (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")

+    (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (LET (BYTE1 BYTE2 BYTE3 BYTE4 CODE (COUNT
 1))
          (SETQ BYTE1 (\BIN STREAM))
 
-         (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1")

+         (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1")

 
          (CL:WHEN (SMALLP BYTE1)
              [SETQ CODE (IF
 (ILESSP BYTE1 128)
                             THEN
 
 
-                                  (* ;; 
-
                         "Test first:  Ascii is the common case.  EOL requires its own translation")

+                                  (* ;; 
+
                         "Test first:  Ascii is the common case.  EOL requires its own translation")

 
                                   (SELCHARQ BYTE1
                                        (CR (SELECTC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM)
-                                               (CR.EOLC      (* ; "Also eq BYTE1")

+                                               (CR.EOLC      (* ; "Also eq BYTE1")

                                                         (CHARCODE EOL))
                                                (CRLF.EOLC (IF
 (EQ (CHARCODE LF)
                                                                       (\PEEKBIN STREAM T))
@@ -160,7 +158,7 @@
                                                BYTE1))
                                        BYTE1)
                           ELSEIF
 (IGEQ BYTE1 (LLSH 15 4))
-                            THEN
                         (* ; "4 bytes")

+                            THEN
                         (* ; "4 bytes")

                                   (SETQ BYTE2 (\BIN STREAM))
                                   (CL:WHEN (OR (NOT (SMALLP BYTE2))
                                                (ILESSP BYTE2 128))
@@ -182,7 +180,7 @@
                                                6)
                                          (LOADBYTE BYTE4 0 6))
                           ELSEIF
 (IGEQ BYTE1 (LLSH 7 5))
-                            THEN
                         (* ; "3 bytes")

+                            THEN
                         (* ; "3 bytes")

                                   (SETQ BYTE2 (\BIN STREAM))
                                   (CL:WHEN (OR (NOT (SMALLP BYTE2))
                                                (ILESSP BYTE2 128))
@@ -197,7 +195,7 @@
                                          (LLSH (LOADBYTE BYTE2 0 6)
                                                6)
                                          (LOADBYTE BYTE3 0 6))
-                          ELSE
                           (* ; "Must be 2 bytes")

+                          ELSE
                           (* ; "Must be 2 bytes")

                                 (SETQ COUNT 2)
                                 (SETQ BYTE2 (\BIN STREAM))
                                 (CL:WHEN (OR (NOT (SMALLP BYTE2))
@@ -211,12 +209,97 @@
          (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
          CODE])
 
-(UTF8.PEEKCCODEFN

+(UTF8.PEEKCCODEFN

+  [LAMBDA (STREAM NOERROR RAW)
                          (* ; "Edited 14-Jun-2021 22:53 by rmk:")

+
+    (* ;; "Modeled this after \EUCPEEK on LLREAD.  In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0.  Returns NIL if NOERROR and either invalid UTF8 or end of file.")

+
+    (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

+
+    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+
+    (PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE)
+          (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
+
+     (* ;; "Distinguish on header bytex")

+
+          (CL:UNLESS BYTE1 (RETURN NIL))
+          [IF
 (ILESSP BYTE1 128)
+              THEN
 
+
+                    (* ;; 
+
                  "Test first:  Ascii is the common case.  No need to back up, since we peeked.")

+
+                    (SETQ CODE BYTE1)
+            ELSEIF
 (IGEQ BYTE1 (LLSH 15 4))
+              THEN
                                       (* ; "4 bytes")

+                    (\BIN STREAM)
+                    (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                                    (IGEQ BYTE2 128))
+                        (\BACKFILEPTR STREAM)
+                        (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
+                        (RETURN CODE))
+                    (\BIN STREAM)
+                    (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR))
+                                    (IGEQ BYTE3 128))
+                        (\BACKFILEPTR STREAM)
+                        (\BACKFILEPTR STREAM)
+                        (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
+                        (RETURN CODE))
+                    (\BIN STREAM)
+                    (SETQ BYTE4 (\PEEKBIN STREAM NOERROR))   (* ; 
+
                                                           "PEEK the last, no need to back it up")

+                    (\BACKFILEPTR STREAM)
+                    (\BACKFILEPTR STREAM)
+                    (\BACKFILEPTR STREAM)
+                    (IF
 (AND BYTE4 (IGEQ BYTE4 128))
+                        THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3)
+                                                         18)
+                                                   (LLSH (LOADBYTE BYTE2 0 6)
+                                                         12)
+                                                   (LLSH (LOADBYTE BYTE3 0 6)
+                                                         6)
+                                                   (LOADBYTE BYTE4 0 6)))
+                      ELSEIF
 NOERROR
+                      ELSE
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4)))
+            ELSEIF
 (IGEQ BYTE1 (LLSH 7 5))
+              THEN
                                       (* ; "3 bytes")

+                    (\BIN STREAM)
+                    (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                                    (IGEQ BYTE2 128))
+                        (\BACKFILEPTR STREAM)
+                        (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
+                        (RETURN CODE))
+                    (\BIN STREAM)
+                    (SETQ BYTE3 (\PEEKBIN STREAM NOERROR))
+                    (\BACKFILEPTR STREAM)
+                    (\BACKFILEPTR STREAM)
+                    (IF
 (AND BYTE3 (IGEQ BYTE3 128))
+                        THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4)
+                                                         12)
+                                                   (LLSH (LOADBYTE BYTE2 0 6)
+                                                         6)
+                                                   (LOADBYTE BYTE3 0 6)))
+                      ELSEIF
 NOERROR
+                      ELSE
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
+            ELSE
                                         (* ; "Must be 2 bytes")

+                  (\BIN STREAM)
+                  (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                  (\BACKFILEPTR STREAM)
+                  (IF
 (AND BYTE2 (IGEQ BYTE2 128))
+                      THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
+                                                       6)
+                                                 (LOADBYTE BYTE2 0 6)))
+                    ELSEIF
 NOERROR
+                    ELSE
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2]
+          (CL:WHEN (AND CODE (NOT RAW))
+              (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
+          (RETURN CODE])
 
 (\UTF8.BACKCCODEFN

-    (* ;; "Modeled this after \EUCPEEK on LLREAD.  In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0.  Returns NIL if NOERROR and either invalid UTF8 or end of file.")

+  [LAMBDA (STREAM COUNTP)
                               (* ; "Edited  6-Aug-2021 16:04 by rmk:")

 
-    (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

+    (* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (BIND
 (C _ 0) WHILE
 (CL:WHEN (\BACKFILEPTR STREAM)
@@ -228,12 +311,12 @@
 (DEFINEQ
 
 (UTF16BE.OUTCHARFN

-
-                    (* ;; 
+  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  8-Aug-2021 13:09 by rmk:")


+                                                            (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
-
+    (* ;; "PRINT UTF16 sequence for CHARCODE.  Do not do XCCS to UNICODE translation if RAW.")

 
-            ELSEIF
 (IGEQ BYTE1 (LLSH 15 4))
+    (* ;; "Not sure about EOL conversion if truly %"raw%"")

 
     (IF
 (EQ CHARCODE (CHARCODE EOL))
         THEN
 (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
@@ -245,10 +328,10 @@
        DO
 (\WOUT STREAM C])
 
 (UTF16BE.INCCODEFN

-                        (\BACKFILEPTR STREAM)
+  [LAMBDA (STREAM COUNTP RAW)
                           (* ; "Edited  6-Aug-2021 16:05 by rmk:")

 
-                        (RETURN CODE))
-                    (\BIN STREAM)
+    (* ;; 
+
  "Do not do UNICODE to XCCS translation if RAW.  Test for SMALLPin case of funky EOF behavior")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (LET (CODE BYTE1 BYTE2 COUNT)
@@ -264,14 +347,37 @@
                    CODE
            ELSE
 (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
 
-            ELSEIF
 (IGEQ BYTE1 (LLSH 7 5))
+(UTF16BE.PEEKCCODEFN

+  [LAMBDA (STREAM NOERROR RAW)
                          (* ; "Edited 14-Jun-2021 22:58 by rmk:")

+
+    (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

+
+    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+
+    (LET (BYTE1 BYTE2 CODE)
+         (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
+         (IF
 BYTE1
+             THEN
 (\BIN STREAM)
+                   (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                   (\BACKFILEPTR STREAM)
+                   (IF
 BYTE2
+                       THEN
 (SETQ CODE (LOGOR (LLSH BYTE1 8)
+                                                  BYTE2))
+                             (CL:IF RAW
+                                 CODE
+                                 (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
+                     ELSEIF
 NOERROR
+                       THEN
 NIL)
+           ELSEIF
 NOERROR
+             THEN
 NIL
+           ELSE
 (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
 
 (\UTF16.BACKCCODEFN

-                    (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+  [LAMBDA (STREAM COUNTP)
                               (* ; "Edited  6-Aug-2021 16:07 by rmk:")

 
-                        (\BACKFILEPTR STREAM)
+    (* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")

 
-                        (RETURN CODE))
+    (* ;; "Common for big-ending and little-ending")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (CL:WHEN (\BACKFILEPTR STREAM)
@@ -285,11 +391,11 @@
 (DEFINEQ
 
 (MAKE-UNICODE-FORMATS

-                  (\BIN STREAM)
+  [LAMBDA (EXTERNALEOL)
                                 (* ; "Edited  6-Aug-2021 16:08 by rmk:")

 
-                  (\BACKFILEPTR STREAM)
+    (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")

 
-                      THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
+    (* ;; "The EXTERNALEOL specifies the EOLCONVENTION of the stream, particularly to produce output files with the desired convention.  On input the macro \CHECKEOLC (LLREAD) coerces only that coding to the internal EOL, which is a mistake.")

 
     (MAKE-EXTERNALFORMAT :UTF-8 (FUNCTION UTF8.INCCODEFN)
            (FUNCTION UTF8.PEEKCCODEFN)
@@ -325,11 +431,11 @@
 (DEFINEQ
 
 (UNICODE.UNMAPPED

-                              CHARCODE
+  [LAMBDA (CODE TRANSLATION-TABLE)
                      (* ; "Edited 11-Aug-2020 20:23 by rmk:")

 
-       DO
 (\WOUT STREAM C])
+    (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODED has no fast mapping in TRANSLATION-TABLE.")

 
-(UTF16BE.INCCODEFN

+    (* ;; "We return an existing entry in the hash array of the table.  If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.")

 
     (LET ((FORWARD (CL:SVREF TRANSLATION-TABLE N-TRANSLATION-SEGMENTS))
           INVERSE NEXTCODE)
@@ -349,9 +455,9 @@
 (DEFINEQ
 
 (XCCS-UTF8-AFTER-OPEN

-(UTF16BE.PEEKCCODEFN

+  [LAMBDA (STREAM ACCESS PARAMETERS)
                    (* ; "Edited 13-Aug-2020 11:54 by rmk:")

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

 
     (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
                   [EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM)
@@ -379,11 +485,11 @@
 (DEFINEQ
 
 (XTOUCODE

-    (* ;; "Common for big-ending and little-ending")

+  [LAMBDA (XCCSCODE)
                                    (* ; "Edited  9-Aug-2020 09:04 by rmk:")

     (UNICODE.TRANSLATE XCCSCODE *XCCSTOUNICODE*])
 
 (UTOXCODE

-        (IF
 (\BACKFILEPTR STREAM)
+  [LAMBDA (UNICODE)
                                     (* ; "Edited  9-Aug-2020 09:04 by rmk:")

     (UNICODE.TRANSLATE UNICODE *UNICODETOXCCS*])
 )
 
@@ -394,9 +500,8 @@
 (DEFINEQ
 
 (READ-UNICODE-MAPPING-FILENAMES

-
-    (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")

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


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

     (FOR
 F X CSI INSIDE
 FILESPEC
        COLLECT
 (IF
 (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT)
                                   T UNICODEDIRECTORIES)
@@ -412,24 +517,24 @@
                      ELSE
 F])
 
 (READ-UNICODE-MAPPING

-    (MAKE-EXTERNALFORMAT :UTF-16BE (FUNCTION UTF16BE.INCCODEFN)
+  [LAMBDA (FILESPEC NOPRINT NOERROR)
                    (* ; "Edited  3-Jul-2021 13:37 by rmk:")

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

 
-           NIL EXTERNALEOL)
+    (* ;; "               Column 1:  Input hex code in the format 0xXXXX")

 
-                                                   (UTF16BE.INCCODEFN
 STREAM COUNTP T]
+    (* ;; "               Column 2:  Corresponding Unicode code-sequence in the format")

 
-                       (UTF16BE.PEEKCCODEFN
 STREAM NOERROR T]
+    (* ;; "                                            0xXXXX  ... 0xYYYY")

 
-           [FUNCTION (LAMBDA (STREAM CHARCODE)
-                       (UTF16BE.OUTCHARFN
 STREAM CHARCODE T]
+    (* ;; 
+
  "               Column 3:  (after #) Character name in some mapping files, utf-8 character")

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

 
-(MAKE-UNICODE-FORMATS
 EXTERNALEOL)
+    (* ;; "")

 
-(ADDTOVAR *DEFAULT-EXTERNALFORMATS*
 (UNIX :UTF-8))
+    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")

 
     (FOR
 FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] IN
 (
 
                                                                     READ-UNICODE-MAPPING-FILENAMES

@@ -461,18 +566,18 @@
                                                                    (NTHCHARCODE LINE START])
 
 (WRITE-UNICODE-MAPPING

-    (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
+  [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK)
        (* ; "Edited 16-Aug-2020 16:56 by rmk:")

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

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

 
-(DECLARE%: EVAL@COMPILE DONTCOPY 
+    (* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab>#  Unicode-char")

 
-
-(PUTPROPS UNICODE.TRANSLATE
 MACRO
 [OPENLAMBDA (CODE TRANSLATION-TABLE)
+    (* ;; 
+
  "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.")

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

 
     (IF
 (AND (EQ INCLUDECHARSETS T)
                  (NULL FILE))
@@ -513,15 +618,15 @@
                                      "	#  "
                                      (SELECTC FIRSTRIGHTC
                                          (UNDEFINEDCODE 
-                                                                     (CADR CSI))
+                                                        (* ;; "FFFF")

 
                                                         "UNDEFINED")
                                          (MISSINGCODE 
-                     ELSE
 F])
+                                                      (* ;; "FFFE")

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

                                                    [CONCAT "^" (CHARACTER (IPLUS FIRSTRIGHTC
                                                                                  (CHARCODE @]
                                            ELSE
 (CHARACTER FIRSTRIGHTC)))
@@ -535,13 +640,13 @@
                  NIL])
 
 (WRITE-UNICODE-INCLUDED

-    (* ;; "")

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

 
-    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")

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

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

 
          [SETQ ICSETS (FOR
 C POS KNOWN INSIDE
 (OR INCLUDECHARSETS (FOR
 CSI IN
 
                                                                                        XCCS-SET-NAMES
@@ -569,13 +674,13 @@
                                                                                 ICSETS))
                            COLLECT
 
 
-  [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK)
        (* ; "Edited 16-Aug-2020 16:56 by rmk:")

+                                 (* ;; "The attested subset of INCLUDED")

 
                                  (CL:UNLESS (MEMB CSI CSETINFO)
                                         (PUSH
 CSETINFO CSI))
                                  M))
 
-    (* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab>#  Unicode-char")

+         (* ;; "Sort as numbers, not octal strings, then group into consecutive ranges")

 
          (SETQ CSETINFO (SORT CSETINFO T))
          [SETQ RANGES (FOR
 CTAIL C START END ON
 (FOR
 CSI IN
 CSETINFO
@@ -587,7 +692,7 @@
                                               COLLECT
 (SETQ CTAIL (CDR CTAIL))
                                                     (SETQ END (CAR CTAIL]
 
-                                                                              MAPPING
+         (* ;; "Split out groups of less than 3.  But if a range exhaustively covers a known subset (like JIS), replace by the name")

 
          [SETQ RANGES (FOR
 R STR KNOWN LAST IN
 RANGES
                          JOIN
 (SETQ LAST (CAR (LAST R)))
@@ -607,9 +712,9 @@
          (CL:VALUES IMAPPING CSETINFO RANGES])
 
 (WRITE-UNICODE-MAPPING-HEADER

-                              (CL:UNLESS (EQ CSET (LRSH LEFTC 8))
+  [LAMBDA (STREAM CSETINFO RANGES)
                      (* ; "Edited  4-Aug-2020 17:38 by rmk:")

 
-                                  (SETQ CSI (ASSOC CSET CSETINFO))
+    (* ;; "Writes the standard per-file header information")

 
     (FOR
 LINE IN
 UNICODE-MAPPING-HEADER
        DO
 (PRINTOUT STREAM "#" 2)
@@ -620,7 +725,7 @@
                           THEN
 (PRINTOUT STREAM "s:" -4)
                                 (FOR
 R IN
 RANGES DO
 (PRINTOUT STREAM R " "))
                                 (TERPRI STREAM)
-                                         (UNDEFINEDCODE 
+                        ELSE
                             (* ; "Singleton")

                               (PRINTOUT STREAM ": " -4 (CADAR CSETINFO)
                                      " "
                                      (CADDAR CSETINFO)))
@@ -632,7 +737,7 @@
     (TERPRI STREAM])
 
 (WRITE-UNICODE-MAPPING-FILENAME

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

     (PACKFILENAME 'BODY [OR FILE (CONCATLIST
                                   (CONS 'XCCS- (IF
 (CDR CSETINFO)
                                                    THEN
 (FOR
 RTAIL R ON
 RANGES
@@ -736,53 +841,53 @@
 (DEFINEQ
 
 (MAKE-UNICODE-TRANSLATION-TABLES

-                 (PRINTOUT STREAM LINE T)))
-    (TERPRI STREAM])
+  [LAMBDA (MAPPING LTORVAR RTOLVAR)
                     (* ; "Edited 21-Aug-2021 13:12 by rmk:")


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

 
-(WRITE-UNICODE-MAPPING-FILENAME

+    (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.")

 
-    (PACKFILENAME 'BODY [OR FILE (CONCATLIST
+    (* ;; "This 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).")

 
-                                                   THEN
 (FOR
 RTAIL R ON
 RANGES
+    (* ;; "")

 
-                                                                     (SETQ R
+    (* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme.  But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.")

 
-                                                                          (LIST (CAR R)
+    (* ;; " ")

 
-                                                                                (CDR R))
+    (* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code.  An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes).  The latter is used to save space for sparsely populated character sets.")

 
-                                                                     (CL:IF (CDR RTAIL)
+    (* ;; "")

 
-                                                                     R)
+    (* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping.  Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.")

 
-                                                                "="
+    (* ;; "")

 
-           'DIRECTORY
+    (* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).")

 
-           'EXTENSION
+    (* ;; "")

 
-)
-
+    (* ;; 
+
  "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")

 
-       (("0" LATIN)
+    (* ;; "")

 
-        ("42" SYMBOLS2)
+    (* ;; "For the convenience of not having to deal with the multiple values, if LTORVAR or RTOLVAR are given, they are set to the constructed arrays before return.")

 
-        ("44" HIRAGANA)
+    (* ;; "")

 
     (LET ((LTORARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS)
                             :INITIAL-ELEMENT NIL))
           (RTOLARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS)
                             :INITIAL-ELEMENT NIL)))
 
-        ("341" HEBREW)
+         (* ;; "The left-to-right direction (into Unicode).    We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte).  The second loop converts long alists into arrays.")

 
          [FOR
 M LEFTC RBASE RCODES IN
 MAPPING EACHTIME
 (SETQ RCODES (CDR M))
                                                             (SETQ RBASE (CAR RCODES))
             UNLESS
 (IGEQ RBASE MISSINGCODE) DO
 (SETQ LEFTC (CAR M)) 
 
-        ("360" LIGATURES)
-        ("361" ACCENTED-LATIN)
+                                                      (* ;; 
+
                                                    "(CDR RCODES) contains combiners on the base")

 
                                                       (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
                                                                      (CL:IF (CDR RCODES)
@@ -796,7 +901,7 @@
                             MAX-ALIST-LENGTH)
             DO
 
 
-
+                  (* ;; "Leave it alone if the alist is short")

 
                   (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
                   (FOR
 P IN
 (CL:SVREF LTORARRAY I)
@@ -806,17 +911,17 @@
                   (CL:SETF (CL:SVREF LTORARRAY I)
                          CSA))
 
-           DATE "        Author:           Ron Kaplan <Ron.Kaplan@post.harvard.edu>" "" 
+         (* ;; "")

 
-           "XC1-3-3-0, 1987) into Unicode 3.0. standard codes.  That is the version of" 
+         (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.")

 
          (FOR
 M LEFTC RBASE RCOMBINERS PREV IN
 MAPPING EACHTIME
 (SETQ RBASE (CADR M))
                                                                      (SETQ RCOMBINERS (CDDR M))
             UNLESS
 (OR (IGEQ RBASE MISSINGCODE)
                            RCOMBINERS) DO
 
 
-           "        Unicode character itself (since the Unicode character names" 
-           "        are not available)" 
+                                             (* ;; 
+
                                     "Have we already seen an explicit mapping from right to left?")

 
                                              (SETQ LEFTC (CAR M))
                                              [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
@@ -838,7 +943,7 @@
                             MAX-ALIST-LENGTH)
             DO
 
 
-
+                  (* ;; "Long list, make an array")

 
                   (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
                   (FOR
 P IN
 (CL:SVREF RTOLARRAY I)
@@ -848,9 +953,9 @@
                   (CL:SETF (CL:SVREF RTOLARRAY I)
                          CSA))
 
-
+         (* ;; "")

 
-
+         (* ;; "Allocate the hash arrays for future out-of-map codes.  We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.")

 
          (CL:SETF (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)
                 (LIST (HASHARRAY 10)
@@ -863,14 +968,14 @@
                       (CHARCODE.DECODE "U+F8FF")
                       (CHARCODE.DECODE "U+E000")))
 
-    (* ;; "")

+         (* ;; "Now put in the inverse unmapped hash arrays")

 
          (CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS))
                 (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
          (CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS))
                 (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS))
 
-
  "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")

+         (* ;; "")

 
          (CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY))
          (CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY))
@@ -892,11 +997,11 @@
 (DEFINEQ
 
 (HEXSTRING

-                                                      (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
-                                                                     (CL:IF (CDR RCODES)
+  [LAMBDA (N WIDTH)
                                     (* ; "Edited 23-Jul-2020 08:28 by rmk:")


+                                                             (* ; "Edited 20-Dec-93 17:51 by rmk:")

 
-                                                                         RBASE))
-                                                             (CL:SVREF LTORARRAY (LRSH LEFTC 
+    (* ;; 
+
  "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")

 
     (CL:UNLESS (FIXP N)
         (SETQ N (CHARCODE.DECODE N)))
@@ -915,21 +1020,21 @@
          STR])
 
 (UTF8HEXSTRING

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

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

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

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

                              (LOGOR (LLSH (LOGOR (LLSH 7 5)
                                                  (LRSH CHARCODE 12))
                                           16)
@@ -939,7 +1044,7 @@
                                     (LOGOR (LLSH 2 6)
                                            (LOADBYTE CHARCODE 0 6)))
                      ELSEIF
 (ILESSP CHARCODE 2097152)
-                                                                 LEFTC)
+                       THEN
                              (* ; "x200000")

                              (LOGOR (LLSH (LOGOR (LLSH 15 4)
                                                  (LRSH CHARCODE 18))
                                           24)
@@ -954,27 +1059,27 @@
                      ELSE
 (ERROR "CHARCODE too big for UTF8" CHARCODE])
 
 (NUTF8CODEBYTES

-                         CSA))
+  [LAMBDA (N)
                                           (* ; "Edited 10-Aug-2020 12:35 by rmk:")

 
-         (* ;; "")

+    (* ;; "Returns the number of bytes needed to encode N in UTF8, ")

 
     (IF
 (ILESSP N 128)
         THEN
 1
       ELSEIF
 (ILESSP N 2048)
-                (LIST (HASHARRAY 10)
+        THEN
                                             (* ; "x800")

               4
       ELSEIF
 (ILESSP N 65536)
-                      (CHARCODE.DECODE "5,0")))
+        THEN
                                             (* ; "x10000")

               3
       ELSEIF
 (ILESSP N 2097152)
-                      (CHARCODE.DECODE "U+E000")
+        THEN
                                             (* ; "x200000")

               2
       ELSE
 (SHOULDNT])
 
 (NUTF8STRINGBYTES

-
+  [LAMBDA (STRING RAWFLG)
                               (* ; "Edited 10-Aug-2020 09:06 by rmk:")

 
-                (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
+    (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ")

 
     (FOR
 I C FROM
 1 WHILE
 (SETQ C (NTHCHARCODE STRING I))
        SUM
 (NUTF8CODEBYTES
 (CL:IF RAWFLG
@@ -982,11 +1087,11 @@
                                        (XTOUCODE
 C))])
 
 (XTOUSTRING

-         (LIST LTORARRAY RTOLARRAY])
+  [LAMBDA (XCCSSTRING
 RAWFLG)
                       (* ; "Edited 10-Aug-2020 21:42 by rmk:")

 
-
+    (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING.  Applies the XCCSTOUNICODE translation unless RAWFLG.  ")

 
-                                         ACCENTED-LATIN GREEK))
+    (* ;; "The resulting string will not be readable inside Medley.")

 
     (LET [(USTR (ALLOCSTRING (NUTF8STRINGBYTES
 XCCSSTRING RAWFLG]
          (FOR
 I CHARCODE (SINDEX _ 0) FROM
 1 WHILE
 (SETQ CHARCODE (NTHCHARCODE XCCSSTRING
@@ -997,7 +1102,7 @@
                       THEN
 (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                       CHARCODE)
                     ELSEIF
 (ILESSP CHARCODE 2048)
-(DEFINEQ
+                      THEN
                               (* ; "x800")

                             (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                    (LOGOR (LLSH 3 6)
                                           (LRSH CHARCODE 6)))
@@ -1005,7 +1110,7 @@
                                    (LOGOR (LLSH 2 6)
                                           (LOADBYTE CHARCODE 0 6)))
                     ELSEIF
 (ILESSP CHARCODE 65536)
-
+                      THEN
                               (* ; "x10000")

                             (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                    (LOGOR (LLSH 7 5)
                                           (LRSH CHARCODE 12)))
@@ -1016,7 +1121,7 @@
                                    (LOGOR (LLSH 2 6)
                                           (LOADBYTE CHARCODE 0 6)))
                     ELSEIF
 (ILESSP CHARCODE 2097152)
-                                         THEN
 (+ CHAR (CHARCODE 0))
+                      THEN
                               (* ; "x200000")

                             (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                    (LOGOR (LLSH 15 4)
                                           (LRSH CHARCODE 18)))
@@ -1033,9 +1138,9 @@
          USTR])
 
 (XCCSSTRING

-                                          8)
+  [LAMBDA (CODE)
                                        (* ; "Edited 13-Aug-2020 12:16 by rmk:")

 
-                                           (LOADBYTE CHARCODE 0 6)))
+    (* ;; "Returns XCCS character representation of string %"cset,char%"")

 
     (CL:UNLESS (FIXP CODE)
         (SETQ CODE (CHCON1 CODE)))
@@ -1046,14 +1151,14 @@
 (DEFINEQ
 
 (SHOWCHARS

-                     ELSEIF
 (ILESSP CHARCODE 2097152)
+  [LAMBDA (FROMCHAR TOCHAR FONT)
                        (* ; "Edited  1-Aug-2020 09:27 by rmk:")

     (RESETFORM (DSPFONT (OR FONT '(CLASSIC 12))
                       T)
            (CL:WHEN (AND (SMALLP FROMCHAR)
                          (NOT TOCHAR))
 
-                                                 (LOADBYTE CHARCODE 12 6))
-                                          16)
+               (* ;; 
+
    "If a small number, assume it's an octal (in decimal) character set, no need for string quotes")

 
                (SETQ TOCHAR (CONCAT FROMCHAR "," 376))
                (SETQ FROMCHAR (CONCAT FROMCHAR "," 41)))
@@ -1100,15 +1205,15 @@
 )
 )
 (DECLARE%: DONTCOPY
-                       (SETQ CHARCODE (XTOUCODE
 CHARCODE)))
-                  (IF
 (ILESSP CHARCODE 128)
-                      THEN
 (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                                      CHARCODE)
-                    ELSEIF
 (ILESSP CHARCODE 2048)
-                      THEN
                               (* ; "x800")

-                            (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                                   (LOGOR (LLSH 3 6)
-                                          (LRSH CHARCODE 6)))
-                            (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                                   (LOGOR (LLSH 2 6)
+  (FILEMAP (NIL (4046 17726 (UTF8.OUTCHARFN 4056 . 6887) (UTF8.INCCODEFN 6889 . 12379) (UTF8.PEEKCCODEFN
+ 12381 . 17155) (\UTF8.BACKCCODEFN 17157 . 17724)) (17727 21053 (UTF16BE.OUTCHARFN 17737 . 18561) (
+UTF16BE.INCCODEFN 18563 . 19462) (UTF16BE.PEEKCCODEFN 19464 . 20535) (\UTF16.BACKCCODEFN 20537 . 21051
+)) (21083 22891 (MAKE-UNICODE-FORMATS 21093 . 22889)) (22988 24294 (UNICODE.UNMAPPED 22998 . 24292)) (
+24295 24831 (XCCS-UTF8-AFTER-OPEN 24305 . 24829)) (25901 26250 (XTOUCODE 25911 . 26079) (UTOXCODE 
+26081 . 26248)) (26290 42412 (READ-UNICODE-MAPPING-FILENAMES 26300 . 27401) (READ-UNICODE-MAPPING 
+27403 . 30701) (WRITE-UNICODE-MAPPING 30703 . 34920) (WRITE-UNICODE-INCLUDED 34922 . 39644) (
+WRITE-UNICODE-MAPPING-HEADER 39646 . 40878) (WRITE-UNICODE-MAPPING-FILENAME 40880 . 42410)) (45749 
+54228 (MAKE-UNICODE-TRANSLATION-TABLES 45759 . 54226)) (54649 62553 (HEXSTRING 54659 . 55820) (
+UTF8HEXSTRING 55822 . 58027) (NUTF8CODEBYTES 58029 . 58692) (NUTF8STRINGBYTES 58694 . 59175) (
+XTOUSTRING 59177 . 62188) (XCCSSTRING 62190 . 62551)) (62554 64023 (SHOWCHARS 62564 . 64021)))))
 STOP

library/UNIXTELNET

@@ -1,18 +1,27 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "16-Feb-90 17:00:31" "{piglet/n}<piglet>vanmelle>lispusers>UNIXTELNET;11"
 3551   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "30-Sep-2021 19:23:57" {DSK}<Users>briggs>Projects>medley>library>UNIXTELNET.;2
 3970   
 
-      changes to%:  (VARS UNIXTELNETCOMS) (FNS UNIX-TCPCHAT.INIT UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.GET.LOGIN)
+      changes to%:  (FNS UNIX-TCPCHAT.OPEN)
 
-      previous date%: "30-Jan-90 17:47:34" "{piglet/n}<piglet>vanmelle>lispusers>UNIXTELNET;7")
+      previous date%: "16-Feb-90 17:00:31" {DSK}<Users>briggs>Projects>medley>library>UNIXTELNET.;1
+)
 
 
-(* "
-Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
+(* ; "
+Copyright (c) 1989-1990 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT UNIXTELNETCOMS)
 
-(RPAQQ UNIXTELNETCOMS ((FNS UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.GET.LOGIN UNIX-TCPCHAT.INIT) (INITVARS (CHAT.LOGINS) (CHAT.LOGINS.MENU)) (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCHAT) (ADDVARS (AROUNDEXITFNS UNIX-TCPCHAT.INIT)) (P (UNIX-TCPCHAT.INIT)))))
+(RPAQQ UNIXTELNETCOMS

+       [(FNS UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.GET.LOGIN UNIX-TCPCHAT.INIT)
+        (INITVARS (CHAT.LOGINS)
+               (CHAT.LOGINS.MENU))
+        (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
+                                               UNIXCHAT)
+               (ADDVARS (AROUNDEXITFNS UNIX-TCPCHAT.INIT))
+               (P (UNIX-TCPCHAT.INIT])
 (DEFINEQ
 
 (UNIX-TCPCHAT.HOST.FILTER

@@ -20,8 +29,20 @@ Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
 )
 
 (UNIX-TCPCHAT.OPEN

-(LAMBDA (HOST TERMTYPE LOGOPTION) (* ; "Edited 14-Feb-90 18:36 by bvm") (* ;; "For use on Maiko: chat to HOST by using rlogin in a shell window.") (LET (NAME STR) (if (AND (OR (NEQ LOGOPTION (QUOTE NONE)) (SETQ NAME (UNIX-TCPCHAT.GET.LOGIN HOST))) (SETQ STR (CREATE-SHELL-STREAM TERMTYPE (CL:FORMAT NIL "exec rlogin ~@[-l ~A ~]~A" NAME HOST)))) then (STREAMPROP STR (QUOTE SENDSCREENPARAMS) (FUNCTION UNIX.SENDSCREENPARAMS)) (STREAMPROP STR (QUOTE SETDISPLAYTYPE) (FUNCTION UNIX.SETDISPLAYTYPE)) (LIST STR STR (QUOTE LOGOPTION) (QUOTE NONE)))))
-)
+  [LAMBDA (HOST TERMTYPE LOGOPTION)                          (* ; 
+
                                                           "Edited 30-Sep-2021 19:23 by briggs")

+                                                             (* ; "Edited 14-Feb-90 18:36 by bvm")

+
+    (* ;; "For use on Maiko: chat to HOST by using ssh in a shell window.")

+
+    (LET (NAME STR)
+         (if
 [AND (OR (NEQ LOGOPTION 'NONE)
+                          (SETQ NAME (UNIX-TCPCHAT.GET.LOGIN
 HOST)))
+                      (SETQ STR (CREATE-SHELL-STREAM TERMTYPE (CL:FORMAT NIL "exec ssh ~@[-l ~A ~]~A"
+                                                                     NAME HOST]
+             then
 (STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
+                   (STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
+                   (LIST STR STR 'LOGOPTION 'NONE])
 
 (UNIX-TCPCHAT.GET.LOGIN

 (LAMBDA (HOST) (* ; "Edited 15-Feb-90 11:28 by bvm") (LET (NAME) (if (OR (NULL CHAT.LOGINS) (EQ (SETQ NAME (MENU (OR CHAT.LOGINS.MENU (SETQ CHAT.LOGINS.MENU (create MENU ITEMS _ (APPEND CHAT.LOGINS (QUOTE (("**other**" T "Prompts for a name to login as")))) CENTERFLG _ T TITLE _ "Log in as:"))))) T)) then (* ; "Prompt for a name") (if (SETQ NAME (CHAT.PROMPT.FOR.INPUT (CL:FORMAT NIL "Log in to ~A as user: " HOST) NIL 16)) then (SETQ CHAT.LOGINS (SORT (CONS NAME CHAT.LOGINS) (FUNCTION UALPHORDER))) (SETQ CHAT.LOGINS.MENU NIL))) NAME))
@@ -32,25 +53,26 @@ Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(RPAQ? CHAT.LOGINS)
+(RPAQ? CHAT.LOGINS
 )
 
-(RPAQ? CHAT.LOGINS.MENU)
+(RPAQ? CHAT.LOGINS.MENU
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU)
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(FILESLOAD (SYSLOAD) UNIXCHAT)
+(FILESLOAD (SYSLOAD)
+       UNIXCHAT)
 
 
-(ADDTOVAR AROUNDEXITFNS UNIX-TCPCHAT.INIT)
+(ADDTOVAR AROUNDEXITFNS
 UNIX-TCPCHAT.INIT)
 
 
-(UNIX-TCPCHAT.INIT)
+(UNIX-TCPCHAT.INIT
)
 )
 (PUTPROPS UNIXTELNET COPYRIGHT ("Xerox Corporation" 1989 1990))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (836 3203 (UNIX-TCPCHAT.HOST.FILTER 846 . 1353) (UNIX-TCPCHAT.OPEN 1355 . 1924) (
-UNIX-TCPCHAT.GET.LOGIN 1926 . 2495) (UNIX-TCPCHAT.INIT 2497 . 3201)))))
+  (FILEMAP (NIL (872 3597 (UNIX-TCPCHAT.HOST.FILTER 882 . 1389) (UNIX-TCPCHAT.OPEN 1391 . 2318) (
+UNIX-TCPCHAT.GET.LOGIN 2320 . 2889) (UNIX-TCPCHAT.INIT 2891 . 3595)))))
 STOP

library/VTCHAT

@@ -1,40 +1,37 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-Jan-93 15:06:01" {DSK}<python>lde>lispcore>library>VTCHAT.;2
 21782  
+
(FILECREATED "30-Sep-2021 17:41:51" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;4
 21924  
 
-      changes to%:  (RECORDS VT100SAVE VT100.STATE)
+      changes to%:  (FNS VTCHAT.STATUS)
 
-      previous date%: "13-Jun-90 01:22:35" {DSK}<python>lde>lispcore>library>VTCHAT.;1)
+      previous date%: "20-Jan-93 15:06:01" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;3)
 
 
 (* ; "
-Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1983-1988, 1990, 1993 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT VTCHATCOMS)
 
-(RPAQQ VTCHATCOMS
 [
-                       (* ;; "VT100 emulator")

+(RPAQQ VTCHATCOMS

+       [
+        (* ;; "VT100 emulator")

 
-                       (FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
-                       (FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT 
-                            VTCHAT.CLEARMODES VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE 
-                            VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
-                       (INITVARS (VTCHAT.DEBUGGING.FLG)
-                              (VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
-                       (GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT 
-                              VTCHAT.TERM.IDENTITY.STRING)
-                       (ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
-                       (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
-                              (FILES (LOADCOMP)
-                                     CHATDECLS)
-                              (RECORDS VT100SAVE VT100.STATE))
-                       (INITRECORDS VT100.STATE)
-                       (SYSRECORDS VT100.STATE)
-                       (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
-                                                              VT100KP)
-                              (ADDVARS (CHAT.DISPLAYTYPES (
-                                                       "Replace this string with NIL to prefer vt100"
-                                                           NIL VT100])
+        (FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
+        (FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT VTCHAT.CLEARMODES
+             VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
+        (INITVARS (VTCHAT.DEBUGGING.FLG)
+               (VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
+        (GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT VTCHAT.TERM.IDENTITY.STRING)
+        (ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
+               (FILES (LOADCOMP)
+                      CHATDECLS)
+               (RECORDS VT100SAVE VT100.STATE))
+        (INITRECORDS VT100.STATE)
+        (SYSRECORDS VT100.STATE)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
+                                               VT100KP)
+               (ADDVARS (CHAT.DISPLAYTYPES ("Replace this string with NIL to prefer vt100" NIL VT100])
 
 
 
@@ -101,8 +98,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
 )
 
 (VTCHAT.STATUS

-(LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ; "Edited 18-Dec-86 15:16 by amd") (* ;; "Returns VT100 status info") (LET ((OUTSTREAM (ffetch (CHAT.STATE OUTSTREAM) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE))))) (SELECTQ TYPE (5 (* ; "Host wants device status") (PRIN1 "" OUTSTREAM)) (6 (* ; "Host wants cursor coords") (BOUT OUTSTREAM (CHARCODE ESC)) (BOUT OUTSTREAM (CHARCODE %[)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE YPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE ;)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE XPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE R))) NIL) (FORCEOUTPUT OUTSTREAM)))
-)
+  [LAMBDA (CHAT.STATE VT100.STATE TYPE)                      (* ; 
+
                                                           "Edited 30-Sep-2021 17:30 by briggs")

+                                                             (* ; "Edited 18-Dec-86 15:16 by amd")

+
+    (* ;; "Returns VT100 status info")

+
+    (LET [(OUTSTREAM (ffetch
 (CHAT.STATE OUTSTREAM) of
 (\DTEST CHAT.STATE 'CHAT.STATE]
+         (SELECTQ TYPE
+             (5                                              (* ; "Host wants device status")

+                (PRIN1 "" OUTSTREAM))
+             (6                                              (* ; "Host wants cursor coords")

+                (BOUT OUTSTREAM (CHARCODE ESC))
+                (BOUT OUTSTREAM (CHARCODE %[))
+                (PRIN1 (ADD1 (IQUOTIENT (ffetch
 (CHAT.STATE YPOS) of
 CHAT.STATE)
+                                    (ffetch
 (CHAT.STATE FONTHEIGHT) of
 CHAT.STATE)))
+                       OUTSTREAM)
+                (BOUT OUTSTREAM (CHARCODE ;))
+                (PRIN1 (ADD1 (IQUOTIENT (ffetch
 (CHAT.STATE XPOS) of
 CHAT.STATE)
+                                    (ffetch
 (CHAT.STATE FONTWIDTH) of
 CHAT.STATE)))
+                       OUTSTREAM)
+                (BOUT OUTSTREAM (CHARCODE R)))
+             NIL)
+         (FORCEOUTPUT OUTSTREAM])
 )
 
 (RPAQ? VTCHAT.DEBUGGING.FLG
 )
@@ -236,10 +254,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
 )
 (PUTPROPS VTCHAT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1995 10061 (VTCHAT.STATE 2005 . 2515) (VTCHAT.HANDLECHARACTER 2517 . 5091) (
-VTCHAT.SEQUENCE 5093 . 6636) (VTCHAT.DOCOMMAND 6638 . 10059)) (10062 16968 (VTCHAT.ADDRESS 10072 . 
-10590) (VTCHAT.REVERSE.INDEX 10592 . 11161) (VTCHAT.ATTRIBUTES 11163 . 11549) (VTCHAT.DECLFONT 11551
- . 11820) (VTCHAT.CLEARMODES 11822 . 12325) (VTCHAT.SAVE 12327 . 13066) (VTCHAT.RESTORE 13068 . 13775)
- (VTCHAT.SETMODE 13777 . 14849) (VTCHAT.SETMARGINS 14851 . 15442) (VTCHAT.REPORT 15444 . 16204) (
-VTCHAT.STATUS 16206 . 16966)))))
+  (FILEMAP (NIL (1532 9598 (VTCHAT.STATE 1542 . 2052) (VTCHAT.HANDLECHARACTER 2054 . 4628) (
+VTCHAT.SEQUENCE 4630 . 6173) (VTCHAT.DOCOMMAND 6175 . 9596)) (9599 17110 (VTCHAT.ADDRESS 9609 . 10127)
+ (VTCHAT.REVERSE.INDEX 10129 . 10698) (VTCHAT.ATTRIBUTES 10700 . 11086) (VTCHAT.DECLFONT 11088 . 11357
+) (VTCHAT.CLEARMODES 11359 . 11862) (VTCHAT.SAVE 11864 . 12603) (VTCHAT.RESTORE 12605 . 13312) (
+VTCHAT.SETMODE 13314 . 14386) (VTCHAT.SETMARGINS 14388 . 14979) (VTCHAT.REPORT 14981 . 15741) (
+VTCHAT.STATUS 15743 . 17108)))))
 STOP

library/lafite/LAFITE

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "24-Jun-2021 19:17:01" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4
 71992  
+
(FILECREATED "30-Sep-2021 22:59:08" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;5
 71956  
 
-      changes to%:  (FNS \LAFITE.EOF)
-                    (FILES LAFITEDECLS)
+      changes to%:  (FILES LAFITEDECLS)
 
-      previous date%: "22-Aug-94 13:00:22" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;2)
+      previous date%: "24-Jun-2021 19:17:01" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4)
 
 
 (* ; "
@@ -75,19 +74,19 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
                      (LAFITE.PERSONAL.VARS LAFITEDEFAULTHOST&DIR LAFITE.SIGNATURE))
               (FNS LAFITE.AROUNDEXIT \LAFITE.MARK.FOLDERS.OBSOLETE \LAFITE.CHECK.FOLDERS 
                    \LAFITE.ASSURE.FOLDER.READY \LAFITE.AFTERLOGIN))
-        (COMS                                                (* ; "misc utilities")

+        (COMS                                                (* ; "misc utilities")

               (FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY 
                    \LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT \LAFITEMSG.DEFPRINT 
                    LA.POSITION.FROM.REGION MAILFOLDERBUSY)
               (CURSORS LA.CROSSCURSOR)
-                                                             (* ; "Low level file functions")

+                                                             (* ; "Low level file functions")

               (FNS TOCFILENAME DELETEMAILFOLDER \LAFITE.OPEN.FOLDER \LAFITE.REPORT.FILE.WONT.OPEN 
                    \LAFITE.FOLDER.CHANGED \LAFITE.REBROWSE.FOLDER \LAFITE.FOLDER.CHANGED.MENU 
                    \LAFITE.SET.FOLDER.STREAM \LAFITE.OPENSTREAM \LAFITE.CREATE.MENU \LAFITE.EOF 
                    \LAFITE.CLOSE.FOLDER)
               (FNS \LAFITE.DESCRIBE.FOLDER))
-        (COMS                                                (* ; 
-
                                                      "Make is easy to load new versions of Lafite")

+        (COMS                                                (* ; 
+
                                                      "Make is easy to load new versions of Lafite")

               (FNS LOAD-LAFITE)
               (VARS LAFITEFILES))
         [DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
@@ -102,14 +101,14 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
                      (FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL 
                             LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
                      (P * (PROGN LAFITE.PROCLAMATIONS))
-                                                             (* ; 
-
                                      "Proclaim user interface variables.  Value is on LAFITEDECLS")

+                                                             (* ; 
+
                                      "Proclaim user interface variables.  Value is on LAFITEDECLS")

                      (P (\LAFITE.GLOBAL.INIT)
                         (COND ((EQ MAKESYSNAME :LYRIC)
                                (FILESLOAD (SYSLOAD)
                                       NSCHARPATCH)
-                                                             (* ; 
-
                                                           "Patch to horrid Lyric NS chars bug")

+                                                             (* ; 
+
                                                           "Patch to horrid Lyric NS chars bug")

                                (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
         (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                            (NLAML)
@@ -117,7 +116,7 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
 
 (RPAQQ LAFITEVERSION#
 10)
 
-(RPAQQ LAFITESYSTEMDATE
 "24-Jun-2021 19:17:01")
+(RPAQQ LAFITESYSTEMDATE
 "30-Sep-2021 22:59:08")
 (DEFINEQ
 
 (LAFITE

@@ -277,8 +276,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                                                 DEFAULTFONT)
                                          (CHARWIDTH (CHARCODE "W")
                                                 DEFAULTFONT))
-                                                             (* ; 
-
                                       "Yes, user has not changed default to a variable width font")

+                                                             (* ; 
+
                                       "Yes, user has not changed default to a variable width font")

                                      DEFAULTFONT)
                                     (T (FONTCREATE '(GACHA 10]
         (LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
@@ -317,8 +316,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                          DEFAULTFONT)
                   (CHARWIDTH (CHARCODE "W")
                          DEFAULTFONT))
-                                                             (* ; 
-
                                       "Yes, user has not changed default to a variable width font")

+                                                             (* ; 
+
                                       "Yes, user has not changed default to a variable width font")

               DEFAULTFONT)
              (T (FONTCREATE '(GACHA 10])
 
@@ -864,8 +863,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (COND
    ((EQ MAKESYSNAME :LYRIC)
     (FILESLOAD (SYSLOAD)
-           NSCHARPATCH)                                      (* ; 
-
                                                           "Patch to horrid Lyric NS chars bug")

+           NSCHARPATCH)                                      (* ; 
+
                                                           "Patch to horrid Lyric NS chars bug")

     (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)))
 )
 (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
@@ -879,28 +878,28 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985 
 1986 1987 1988 1989 1993 1994 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7140 22186 (LAFITE 7150 . 8461) (LAFITE.ON.FROM.BACKGROUND 8463 . 8834) (\LAFITE.OFF 
-8836 . 9220) (\LAFITE.START.PROC 9222 . 10998) (LAFITE.COMPUTE.CACHED.VARS 11000 . 13702) (
-\LAFITE.PROCESS 13704 . 14070) (\LAFITE.START.ABORT 14072 . 14264) (\LAFITE.QUIT 14266 . 14508) (
-\LAFITE.RESTART 14510 . 14643) (\LAFITE.SUBQUIT 14645 . 15943) (\LAFITE.QUIT.PROC 15945 . 18681) (
-\LAFITEDEFAULTHOST&DIR 18683 . 19493) (LAFITEDEFAULTHOST&DIR 19495 . 19665) (MAKELAFITECOMMANDWINDOW 
-19667 . 21306) (EXTRACTMENUCOMMAND 21308 . 21556) (DOMAINLAFITECOMMAND 21558 . 21707) (
-LAFITE.TOGGLE.SERVER.TRACE 21709 . 22184)) (22261 25229 (LAFITEMODE 22271 . 22751) (\LAFITE.INFER.MODE
- 22753 . 23106) (\LAFITE.SHOW.MODE 23108 . 23345) (\LAFITE.MODE.TITLE 23347 . 23632) (
-LAFITE.SHOW.MODE.P 23634 . 23875) (LAFITE.ALL.MODES.P 23877 . 24220) (SET.LAFITE.MODE.INTERACTIVELY 
-24222 . 24804) (\LAFITE.COMPUTE.MODE.COMMANDS 24806 . 25227)) (26079 27835 (\LAFITE.LOGIN 26089 . 
-26471) (\LAFITE.LOGIN.NORESTART 26473 . 26579) (LAFITE.PROMPT.FOR.LOGIN 26581 . 27600) (
-\LAFITE.REAUTHENTICATE 27602 . 27833)) (35346 38788 (LAFITE.AROUNDEXIT 35356 . 35894) (
-\LAFITE.MARK.FOLDERS.OBSOLETE 35896 . 36812) (\LAFITE.CHECK.FOLDERS 36814 . 37213) (
-\LAFITE.ASSURE.FOLDER.READY 37215 . 37625) (\LAFITE.AFTERLOGIN 37627 . 38786)) (38820 41758 (
-LA.RESETSHADE 38830 . 39208) (LA.MENU.ITEM 39210 . 39628) (NTHMESSAGE 39630 . 39713) (
-\LAFITE.MAKE.MSGARRAY 39715 . 40145) (\LAFITE.ADDMESSAGES.TO.ARRAY 40147 . 40728) (
-\MAILFOLDER.DEFPRINT 40730 . 40977) (\LAFITEMSG.DEFPRINT 40979 . 41141) (LA.POSITION.FROM.REGION 41143
- . 41620) (MAILFOLDERBUSY 41622 . 41756)) (41936 58324 (TOCFILENAME 41946 . 42377) (DELETEMAILFOLDER 
-42379 . 42899) (\LAFITE.OPEN.FOLDER 42901 . 47516) (\LAFITE.REPORT.FILE.WONT.OPEN 47518 . 48242) (
-\LAFITE.FOLDER.CHANGED 48244 . 50648) (\LAFITE.REBROWSE.FOLDER 50650 . 53615) (
-\LAFITE.FOLDER.CHANGED.MENU 53617 . 54540) (\LAFITE.SET.FOLDER.STREAM 54542 . 55236) (
-\LAFITE.OPENSTREAM 55238 . 55777) (\LAFITE.CREATE.MENU 55779 . 56132) (\LAFITE.EOF 56134 . 57476) (
-\LAFITE.CLOSE.FOLDER 57478 . 58322)) (58325 58909 (\LAFITE.DESCRIBE.FOLDER 58335 . 58907)) (58970 
-60076 (LOAD-LAFITE 58980 . 60074)) (67787 69064 (\LAFITE.GLOBAL.INIT 67797 . 69062)))))
+  (FILEMAP (NIL (7104 22150 (LAFITE 7114 . 8425) (LAFITE.ON.FROM.BACKGROUND 8427 . 8798) (\LAFITE.OFF 
+8800 . 9184) (\LAFITE.START.PROC 9186 . 10962) (LAFITE.COMPUTE.CACHED.VARS 10964 . 13666) (
+\LAFITE.PROCESS 13668 . 14034) (\LAFITE.START.ABORT 14036 . 14228) (\LAFITE.QUIT 14230 . 14472) (
+\LAFITE.RESTART 14474 . 14607) (\LAFITE.SUBQUIT 14609 . 15907) (\LAFITE.QUIT.PROC 15909 . 18645) (
+\LAFITEDEFAULTHOST&DIR 18647 . 19457) (LAFITEDEFAULTHOST&DIR 19459 . 19629) (MAKELAFITECOMMANDWINDOW 
+19631 . 21270) (EXTRACTMENUCOMMAND 21272 . 21520) (DOMAINLAFITECOMMAND 21522 . 21671) (
+LAFITE.TOGGLE.SERVER.TRACE 21673 . 22148)) (22225 25193 (LAFITEMODE 22235 . 22715) (\LAFITE.INFER.MODE
+ 22717 . 23070) (\LAFITE.SHOW.MODE 23072 . 23309) (\LAFITE.MODE.TITLE 23311 . 23596) (
+LAFITE.SHOW.MODE.P 23598 . 23839) (LAFITE.ALL.MODES.P 23841 . 24184) (SET.LAFITE.MODE.INTERACTIVELY 
+24186 . 24768) (\LAFITE.COMPUTE.MODE.COMMANDS 24770 . 25191)) (26043 27799 (\LAFITE.LOGIN 26053 . 
+26435) (\LAFITE.LOGIN.NORESTART 26437 . 26543) (LAFITE.PROMPT.FOR.LOGIN 26545 . 27564) (
+\LAFITE.REAUTHENTICATE 27566 . 27797)) (35310 38752 (LAFITE.AROUNDEXIT 35320 . 35858) (
+\LAFITE.MARK.FOLDERS.OBSOLETE 35860 . 36776) (\LAFITE.CHECK.FOLDERS 36778 . 37177) (
+\LAFITE.ASSURE.FOLDER.READY 37179 . 37589) (\LAFITE.AFTERLOGIN 37591 . 38750)) (38784 41722 (
+LA.RESETSHADE 38794 . 39172) (LA.MENU.ITEM 39174 . 39592) (NTHMESSAGE 39594 . 39677) (
+\LAFITE.MAKE.MSGARRAY 39679 . 40109) (\LAFITE.ADDMESSAGES.TO.ARRAY 40111 . 40692) (
+\MAILFOLDER.DEFPRINT 40694 . 40941) (\LAFITEMSG.DEFPRINT 40943 . 41105) (LA.POSITION.FROM.REGION 41107
+ . 41584) (MAILFOLDERBUSY 41586 . 41720)) (41900 58288 (TOCFILENAME 41910 . 42341) (DELETEMAILFOLDER 
+42343 . 42863) (\LAFITE.OPEN.FOLDER 42865 . 47480) (\LAFITE.REPORT.FILE.WONT.OPEN 47482 . 48206) (
+\LAFITE.FOLDER.CHANGED 48208 . 50612) (\LAFITE.REBROWSE.FOLDER 50614 . 53579) (
+\LAFITE.FOLDER.CHANGED.MENU 53581 . 54504) (\LAFITE.SET.FOLDER.STREAM 54506 . 55200) (
+\LAFITE.OPENSTREAM 55202 . 55741) (\LAFITE.CREATE.MENU 55743 . 56096) (\LAFITE.EOF 56098 . 57440) (
+\LAFITE.CLOSE.FOLDER 57442 . 58286)) (58289 58873 (\LAFITE.DESCRIBE.FOLDER 58299 . 58871)) (58934 
+60040 (LOAD-LAFITE 58944 . 60038)) (67751 69028 (\LAFITE.GLOBAL.INIT 67761 . 69026)))))
 STOP

library/lafite/LAFITEFIND

@@ -1,47 +1,45 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 3-Jun-92 10:10:41" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;2
 15951  
+
(FILECREATED "30-Sep-2021 23:01:05" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;2
 14882  
 
-      previous date%: "15-Jun-90 16:06:40" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;1)
+      changes to%:  (FILES LAFITEDECLS)
+
+      previous date%: " 3-Jun-92 10:10:41" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;1)
 
 
 (* ; "
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT LAFITEFINDCOMS)
 
-(RPAQQ LAFITEFINDCOMS
 ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD 
-                                \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST 
-                                \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND 
-                                \LAFITE.FIND.START)
-                           (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
-                                  (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS 
-                                         LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU 
-                                         LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
-                                  (FILES (SOURCE)
-                                         LAFITEDECLS)
-                                  (LOCALVARS . T))
-                           (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
-                           (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
-                           (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND 
-                                                                 "Search mail for something")
-                                           ["Find Related" '\LAFITE.FIND.RELATED 
-                                            "Find all messages from here on in reply to this message"
-                                                  (SUBITEMS ("Find Related Forward" 
-                                                                   '\LAFITE.FIND.RELATED)
-                                                         ("Find Related Backward" 
-                                                                '\LAFITE.FIND.RELATED.BACKWARD]
-                                           ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search"
-                                                  )
-                                           ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
-                                                 "Scroll to and select a specific message by number."
-                                                  (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
-                                                                "Scroll to and select first message."
-                                                                   )
-                                                         ("Go to Last" '\LAFITE.GO.TO.LAST 
-                                                                "Scroll to and select last message."]
-                                  (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
-                           (VARS (\LAFITE.LAST.SEARCH))))
+(RPAQQ LAFITEFINDCOMS

+       ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST 
+             \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT 
+             \LAFITE.DO.FIND \LAFITE.FIND.START)
+        (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
+               (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU 
+                      LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+               (FILES (SOURCE)
+                      LAFITEDECLS)
+               (LOCALVARS . T))
+        (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+        (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
+        (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND "Search mail for something")
+                        ["Find Related" '\LAFITE.FIND.RELATED 
+                               "Find all messages from here on in reply to this message"
+                               (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
+                                      ("Find Related Backward" '\LAFITE.FIND.RELATED.BACKWARD]
+                        ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
+                        ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
+                               "Scroll to and select a specific message by number."
+                               (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
+                                                "Scroll to and select first message.")
+                                      ("Go to Last" '\LAFITE.GO.TO.LAST 
+                                             "Scroll to and select last message."]
+               (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
+        (VARS (\LAFITE.LAST.SEARCH))))
 (DEFINEQ
 
 (\LAFITE.FIND

@@ -147,45 +145,47 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporat
 
 (RPAQ? LAFITEFINDAREAMENU
 NIL)
 
-(RPAQQ LAFITEFINDAREAMENUITEMS
 ((From 'From "Search From: field for string (or To: if from self)"
-                                          )
-                                    (Subject 'Subject "Search Subject: field for string")
-                                    (Body 'Body "Search message bodies for string")
-                                    (Mark 'Mark "Search for messages with specified mark character")
-                                    (Related 'Related 
-                                           "Search for a message with same Subject, modulo Re:")))
+(RPAQQ LAFITEFINDAREAMENUITEMS

+       ((From 'From "Search From: field for string (or To: if from self)")
+        (Subject 'Subject "Search Subject: field for string")
+        (Body 'Body "Search message bodies for string")
+        (Mark 'Mark "Search for messages with specified mark character")
+        (Related 'Related "Search for a message with same Subject, modulo Re:")))
 
-(RPAQQ LAFITEFINDTYPEMENUITEMS
 (("Find Next One" '(FORWARD ONE)
-                                           "Search forward from selected message")
-                                    ("Find Next All" '(FORWARD ALL)
-                                           "Search forward from selected message")
-                                    ("Find Previous One" '(BACKWARD ONE)
-                                           "Search backward from selected message")
-                                    ("Find Previous All" '(BACKWARD ALL)
-                                           "Search backward from selected message")))
+(RPAQQ LAFITEFINDTYPEMENUITEMS

+       (("Find Next One" '(FORWARD ONE)
+               "Search forward from selected message")
+        ("Find Next All" '(FORWARD ALL)
+               "Search forward from selected message")
+        ("Find Previous One" '(BACKWARD ONE)
+               "Search backward from selected message")
+        ("Find Previous All" '(BACKWARD ALL)
+               "Search backward from selected message")))
 
-(ADDTOVAR LAFITEEXTRAMENUITEMS
 ("Find" '\LAFITE.FIND "Search mail for something")
-                                   ["Find Related" '\LAFITE.FIND.RELATED 
-                                          "Find all messages from here on in reply to this message"
-                                          (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
-                                                 ("Find Related Backward" 
-                                                        '\LAFITE.FIND.RELATED.BACKWARD]
-                                   ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
-                                   ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
-                                          "Scroll to and select a specific message by number."
-                                          (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
-                                                           "Scroll to and select first message.")
-                                                 ("Go to Last" '\LAFITE.GO.TO.LAST 
-                                                        "Scroll to and select last message."))))
+(ADDTOVAR LAFITEEXTRAMENUITEMS

+          ("Find" '\LAFITE.FIND "Search mail for something")
+          ["Find Related" '\LAFITE.FIND.RELATED 
+                 "Find all messages from here on in reply to this message" (SUBITEMS
+                                                                            ("Find Related Forward"
+                                                                             '\LAFITE.FIND.RELATED)
+                                                                            ("Find Related Backward"
+                                                                             
+                                                                             '
+                                                                        \LAFITE.FIND.RELATED.BACKWARD
+                                                                             ]
+          ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
+          ("Go to #" '\LAFITE.GO.TO.INTERACTIVE "Scroll to and select a specific message by number."
+                 (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST "Scroll to and select first message.")
+                        ("Go to Last" '\LAFITE.GO.TO.LAST "Scroll to and select last message."))))
 
 (ADDTOVAR LAFITEMENUVARS
 LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
 
 (RPAQQ \LAFITE.LAST.SEARCH
 NIL)
-(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992))
+(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3089 12861 (\LAFITE.FIND 3099 . 4131) (\LAFITE.FIND.RELATED 4133 . 4798) (
-\LAFITE.FIND.RELATED.BACKWARD 4800 . 4936) (\LAFITE.GO.TO.FIRST 4938 . 5105) (
-\LAFITE.GO.TO.INTERACTIVE 5107 . 5719) (\LAFITE.GO.TO.LAST 5721 . 5929) (\LAFITE.FIND.AGAIN 5931 . 
-6513) (\LAFITE.FIND.PROMPT 6515 . 8637) (\LAFITE.DO.FIND 8639 . 11790) (\LAFITE.FIND.START 11792 . 
-12859)))))
+  (FILEMAP (NIL (2309 12081 (\LAFITE.FIND 2319 . 3351) (\LAFITE.FIND.RELATED 3353 . 4018) (
+\LAFITE.FIND.RELATED.BACKWARD 4020 . 4156) (\LAFITE.GO.TO.FIRST 4158 . 4325) (
+\LAFITE.GO.TO.INTERACTIVE 4327 . 4939) (\LAFITE.GO.TO.LAST 4941 . 5149) (\LAFITE.FIND.AGAIN 5151 . 
+5733) (\LAFITE.FIND.PROMPT 5735 . 7857) (\LAFITE.DO.FIND 7859 . 11010) (\LAFITE.FIND.START 11012 . 
+12079)))))
 STOP

library/lafite/LAFITESORT

@@ -1,19 +1,334 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 7-Feb-95 13:10:22" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;2
 12117  
-
-      changes to%:  (VARS LAFITESORTCOMS)
-
-      previous date%: " 7-Oct-89 14:07:49" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;1)
-
-
-(* ; "
-Copyright (c) 1989, 1995 by Xerox Corporation.  All rights reserved.
-")
-
-(PRETTYCOMPRINT LAFITESORTCOMS)
-
-(RPAQQ LAFITESORTCOMS

-       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                LAFITEDECLS))
-        (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY 
-             LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "30-Sep-2021 22:58:58" 
+{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1
 19675  
+
+      previous date%: " 7-Feb-95 13:10:22" 
+{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1)
+
+
+(* ; "
+Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
+")
+
+(PRETTYCOMPRINT LAFITESORTCOMS)
+
+(RPAQQ LAFITESORTCOMS

+       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
+                                                LAFITEDECLS))
+        (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY 
+             LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER 
+             \LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION)
+        [APPENDVARS (LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                                 (SUBITEMS ("Sort Entire Folder" 
+                                                                  '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                                                  )
+                                                        ("Sort Selected Range" 
+                                                               '\LAFITE.SORT.BY.DATE.REGION 
+                               "Sort only the messages between the first and last selected messages."
+                                                               ]
+        (COMS                                                (* ; "Date hax")

+              (FNS GDATE1-6)
+              (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS \4YearsDays)
+                     (GLOBALVARS \TimeZoneComp \DayLightSavings])
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE)
+       LAFITEDECLS)
+)
+(DEFINEQ
+
+(LAFITE.ASSURE.DATE.FIELDS

+  [LAMBDA (FOLDER FIRST# LAST#)
                          (* ; "Edited  5-May-89 15:46 by bvm")

+
+    (* ;; "Assure that messages FIRST# thru LAST# have IDATE fields.  FIRST# & LAST# default.")

+
+    (for
 I from
 (OR FIRST# 1) to
 (OR LAST# (fetch
 (MAILFOLDER %#OFMESSAGES)
+                                                          of
 FOLDER))
+       bind
 (STREAM _ (\LAFITE.OPEN.FOLDER FOLDER 'INPUT :ABORT))
+             (MESSAGES _ (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS) of
 FOLDER))
+             (FAILURECNT _ 0)
+             (MISSING _ 0)
+             MSG ID PREV DATEFAILURE DATEFETCHED BABBLED
+       do
 [if
 (fetch
 (LAFITEMSG DATEFETCHED?) of
 (SETQ MSG (NTHMESSAGE MESSAGES I)))
+                  then
                                   (* ; "Ok")

+                        (if
 (NOT (fetch
 (LAFITEMSG DATEKNOWN?) of
 MSG))
+                            then
 (add
 FAILURECNT 1))
+                else
 (if
 (NOT BABBLED)
+                             then
                        (* ; "Tell user what's taking so long")

+                                   (LAB.PROMPTPRINT FOLDER "Collecting dates... ")
+                                   (SETQ BABBLED T))
+                      (if
 (FIXP (SETQ ID (LAFITE.PARSE.HEADER STREAM \LAPARSE.DATEFIELD
+                                                    (fetch
 (LAFITEMSG START) of
 MSG)
+                                                    (fetch
 (LAFITEMSG END) of
 MSG)
+                                                    T)))
+                          then
 (replace
 (LAFITEMSG IDATE) of
 MSG with
 ID)
+                                (replace
 (LAFITEMSG DATEKNOWN?) of
 MSG with
 T)
+                                (replace
 (LAFITEMSG DATEFETCHED?) of
 MSG with
 T)
+                                (replace
 (LAFITEMSG DATE) of
 MSG with
 NIL) 
+                                                             (* ; 
+
                                                      "So it will be regenerated in canonical form")

+                                (OR DATEFETCHED (SETQ DATEFETCHED I))
+                        else
 (replace
 (LAFITEMSG DATEKNOWN?) of
 MSG with
 NIL)
+                              (if
 LAFITEDEBUGFLG
+                                  then
 (LAB.FORMAT FOLDER 
+                                           " ~:[Date missing for~;Could not parse date of~] msg ~D. "
+                                                  ID I))
+                              (add
 FAILURECNT 1)
+                              (if
 (NULL ID)
+                                  then
 (add
 MISSING 1))
+                              (if
 [AND (> I 1)
+                                           (fetch
 (LAFITEMSG DATEFETCHED?)
+                                              of
 (SETQ PREV (NTHMESSAGE MESSAGES (SUB1 I]
+                                  then
                   (* ; 
+
                                                     "Guess that message i has date just after i-1")

+                                        (replace
 (LAFITEMSG IDATE) of
 MSG
+                                           with
 (ADD1 (fetch
 (LAFITEMSG IDATE) of
 PREV)))
+                                        (replace
 (LAFITEMSG DATEFETCHED?) of
 MSG with

+                                                                                         T)
+                                else
 (SETQ DATEFAILURE I]
+       finally
 (if
 (AND DATEFETCHED (< DATEFETCHED (fetch
 (MAILFOLDER TOCLASTMESSAGE#)
+                                                              of
 FOLDER)))
+                       then
                              (* ; 
+
          "Assure that the toc will be rewritten at least this far back so that we save the dates.")

+                             (replace
 (MAILFOLDER TOCLASTMESSAGE#) of
 FOLDER with
 
+                                                                                          DATEFETCHED
+                                    ))
+             (COND
+                ([AND DATEFAILURE (NOT (for
 I from
 (ADD1 (OR FIRST# 1))
+                                          to
 (fetch
 (MAILFOLDER %#OFMESSAGES) of
 FOLDER)
+                                          when
 (fetch
 (LAFITEMSG DATEFETCHED?)
+                                                      of
 (SETQ MSG (NTHMESSAGE MESSAGES I)))
+                                          do
             (* ; "Got a date later on")

+                                                (SETQ ID (fetch
 (LAFITEMSG IDATE) of
 MSG))
+                                                (for
 J from
 DATEFAILURE
+                                                   to
 (OR FIRST# 1) by
 -1
+                                                   do
    (* ; 
+
                                                           "Store guess dates for first message(s)")

+                                                         (replace
 (LAFITEMSG IDATE)
+                                                            of
 (SETQ MSG (NTHMESSAGE MESSAGES J))
+                                                            with
 (add
 ID -1))
+                                                         (replace
 (LAFITEMSG DATEFETCHED?)
+                                                            of
 MSG with
 T))
+                                                (RETURN T]
+                 (LAB.PROMPTPRINT FOLDER "Could not parse dates of ANY messages in this file."))
+                ((> FAILURECNT 0)
+                 (LAB.FORMAT FOLDER (if
 (< MISSING FAILURECNT)
+                                        then
 
+                                         " Note: Could not parse date field of ~D of these messages."
+                                      else
 " Note: Missing date field for ~D of these messages.")
+                        FAILURECNT])
+
+(LAFITE.PARSE.DATE.FIELD

+  [LAMBDA (STREAM)
                                       (* ; "Edited  5-May-89 12:52 by bvm")

+    (LET* ((DATESTR (LAFITE.READ.TO.EOL STREAM))
+           (ID (IDATE DATESTR)))
+          (if
 [AND ID (> ID (CONSTANT (IDATE "1-jan-70 1200"]
+              then
                                       (* ; "Plausible date.  Test is for those silly senders who didn't get the date set and have messages reading %"31-dec-00 ...%"")

+                    ID
+            else
 (CONCAT (OR (SUBSTRING DATESTR 1 6 DATESTR)
+                                 DATESTR)
+                            "?"])
+
+(LAFITE.PARSE.DATE.FIELD.ONLY

+  [LAMBDA (STREAM)
+    (DECLARE
 (USEDFREE PARSERESULT))
                 (* ; "Edited 26-Apr-89 14:35 by bvm")

+    (SETQ PARSERESULT (LAFITE.PARSE.DATE.FIELD
 STREAM])
+
+(LAFITE.SORT.BY.DATE

+  [LAMBDA (FOLDER FIRST# LAST#)
                          (* ; "Edited 26-Apr-89 15:32 by bvm")

+    (WITH.MONITOR (fetch
 (MAILFOLDER FOLDERLOCK) of
 FOLDER)
+        (LAFITE.ASSURE.DATE.FIELDS
 FOLDER FIRST# LAST#)
+        (LAFITE.SORT.MESSAGES
 FOLDER (FUNCTION LAFITEMSG.DATE.ORDER)
+               FIRST# LAST#))])
+
+(LAFITE.SORT.MESSAGES

+  [LAMBDA (FOLDER COMPAREFN FIRST# LAST#)
                (* ; "Edited  7-Oct-89 14:03 by bvm")

+    (WITH.MONITOR (fetch
 (MAILFOLDER FOLDERLOCK) of
 FOLDER)
+        (OR FIRST# (SETQ FIRST# 1))
+        (OR LAST# (SETQ LAST# (fetch
 (MAILFOLDER %#OFMESSAGES) of
 FOLDER)))
+        (LAB.PROMPTPRINT FOLDER "Sorting... ")
+        (LET* ((MESSAGES (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS) of
 FOLDER))
+               (SORTED (CL:STABLE-SORT (for
 I from
 FIRST# to
 LAST#
+                                          collect
 (NTHMESSAGE MESSAGES I))
+                              COMPAREFN)))
+              (while
 (AND SORTED (EQ (fetch
 (LAFITEMSG %#) of
 (CAR SORTED))
+                                         FIRST#)) do
     (* ; 
+
                                                "Skip over the initial prefix of in-order messages")

+                                                        (add
 FIRST# 1)
+                                                        (SETQ SORTED (CDR SORTED)))
+              (if
 (NULL SORTED)
+                  then
 (LAB.PROMPTPRINT FOLDER "already in order")
+                else
 (replace
 (MAILFOLDER FOLDEROUTOFORDER) of
 FOLDER with
 T)
+                      (if
 (< FIRST# (fetch
 (MAILFOLDER FIRSTCHANGEDMESSAGE) of
 FOLDER))
+                          then
 (replace
 (MAILFOLDER FIRSTCHANGEDMESSAGE) of
 FOLDER
+                                      with
 FIRST#))
+                      (UNINTERRUPTABLY
+                          (for
 MSG in
 SORTED as
 I from
 FIRST#
+                             do
 (replace
 (LAFITEMSG %#) of
 MSG with
 I)
+                                   (SETA MESSAGES I MSG)))
+                      [LET ((FIRSTSEL (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE) of
 FOLDER))
+                            (LASTSEL (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE) of
 FOLDER)))
+                           (if
 (>= LASTSEL FIRSTSEL)
+                               then
 (if
 (AND (>= FIRSTSEL FIRST#)
+                                                     (<= FIRSTSEL LAST#))
+                                            then
         (* ; 
+
                                 "Start of selection was inside here, have to recompute its number")

+                                                  (replace
 (MAILFOLDER FIRSTSELECTEDMESSAGE)
+                                                     of
 FOLDER with
 (LAB.FIND.SELECTED.MSG
+                                                                             FOLDER FIRST# LAST#)))
+                                     (if
 (AND (>= LASTSEL FIRST#)
+                                                  (<= LASTSEL LAST#))
+                                         then
            (* ; 
+
                                   "End of selection was inside here, have to recompute its number")

+                                               (replace
 (MAILFOLDER LASTSELECTEDMESSAGE)
+                                                  of
 FOLDER with
 (LAB.REV.FIND.SELECTED.MSG
+                                                                          FOLDER FIRST# LAST#]
+                      (LAB.DISPLAYLINES FOLDER FIRST# LAST# NIL T)
+                      (LAB.PROMPTPRINT FOLDER "done"))))])
+
+(LAFITEMSG.DATE.ORDER

+  [LAMBDA (X Y)
                                          (* ; "Edited 26-Apr-89 14:53 by bvm")

+
+    (* ;; "True if msg X has older date than msg Y.  Since date field is stored as an unboxed 32-bit integer, we open code %"<%" here to avoid boxing.")

+
+    (LET [(HIDIFF (- (LOGXOR (fetch
 (LAFITEMSG IDATEHI) of
 X)
+                            32768)
+                     (LOGXOR (fetch
 (LAFITEMSG IDATEHI) of
 Y)
+                            32768]
+
+         (* ;; "HIDIFF is unsigned difference of high words")

+
+         (OR (< HIDIFF 0)
+             (AND (EQ HIDIFF 0)
+                  (< (fetch
 (LAFITEMSG IDATELO) of
 X)
+                     (fetch
 (LAFITEMSG IDATELO) of
 Y])
+
+(\LAFITE.SORT.BY.DATE.INTERACTIVE

+  [LAMBDA (FOLDER FIRST# LAST#)
                          (* ; "Edited  3-May-89 18:38 by bvm")

+    (if
 (LAB.MOUSECONFIRM FOLDER "Click LEFT to confirm sorting ~D messages by date"
+                   (if
 LAST#
+                       then
 (ADD1 (- LAST# FIRST#))
+                     else
 (fetch
 (MAILFOLDER %#OFMESSAGES) of
 FOLDER)))
+        then
 (\LAFITE.PROCESS `(,(FUNCTION LAFITE.SORT.BY.DATE)
+                                    ',FOLDER
+                                    ',FIRST#
+                                    ',LAST#)
+                        "LafiteSort"])
+
+(\LAFITE.SORT.BY.DATE.REGION

+  [LAMBDA (FOLDER)
                                       (* ; "Edited 28-Apr-89 16:23 by bvm")

+    (LET ((FIRST# (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE) of
 FOLDER))
+          (LAST# (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE) of
 FOLDER)))
+         (if
 (> LAST# FIRST#)
+             then
 (\LAFITE.SORT.BY.DATE.INTERACTIVE
 FOLDER FIRST# LAST#)
+           else
 (LAB.FORMAT FOLDER "There is ~:[no~;only one~] message selected."
+                           (EQ LAST# FIRST#])
+)
+
+(APPENDTOVAR LAFITEEXTRAMENUITEMS
 ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                             (SUBITEMS ("Sort Entire Folder" 
+                                                              '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                                              )
+                                                    ("Sort Selected Range" 
+                                                           '\LAFITE.SORT.BY.DATE.REGION 
+                               "Sort only the messages between the first and last selected messages."
+                                                           ))))
+
+
+
+(* ; "Date hax")

+
+(DEFINEQ
+
+(GDATE1-6

+  [LAMBDA (D)
                                            (* ; "Edited 26-Apr-89 15:24 by bvm")

+
+    (* ;; "Return a string containing the day and month given in internal date D.")

+
+    (* ;; "This is an optimization by source code simplification of (SUBSTRING (GDATE IDT) 1 6)")

+
+    (PROG ((CHECKDLS \DayLightSavings)
+           [DQ (IQUOTIENT (LRSH (LISP.TO.ALTO.DATE D)
+                                1)
+                      (CONSTANT (IQUOTIENT (TIMES 60 60)
+                                       2]
+           HR DAY4 YDAY WDAY YEAR4 TOTALDAYS DLS)            (* ; 
+
                         "DQ is number of hours since day 0, getting us past the sign bit problem.")

+
+     (* ;; "Now we can adjust to the current time zone.  Since this might cause DQ to go negative, first add in 4 years worth of hours, making the base date be Jan 1, 1897")

+
+          (SETQ HR (IREMAINDER (SETQ DQ (- (+ DQ (CONSTANT (ITIMES 24 \4YearsDays)))
+                                           \TimeZoneComp))
+                          24))
+          (SETQ TOTALDAYS (IQUOTIENT DQ 24))
+      DTLOOP
+          (SETQ DAY4 (IREMAINDER TOTALDAYS \4YearsDays))     (* ; 
+
                                                 "DAY4 = number of days since last leap year day 0")

+          [SETQ DAY4 (+ DAY4 (CDR (\DTSCAN DAY4 '((789 . 3)
+                                                  (424 . 2)
+                                                  (59 . 1)
+                                                  (0 . 0]    (* ; 
+
                              "pretend every year is a leap year, adding one for days after Feb 28")

+          (SETQ YEAR4 (IQUOTIENT TOTALDAYS \4YearsDays))     (* ; 
+
                                              "YEAR4 = number of years til that last leap year / 4")

+          (SETQ YDAY (IREMAINDER DAY4 366))                  (* ; 
+
                                               "YDAY is the ordinal day in the year (jan 1 = zero)")

+          (SETQ WDAY (IREMAINDER (+ TOTALDAYS 3)
+                            7))
+          [COND
+             ((AND CHECKDLS (SETQ DLS (\ISDST? YDAY HR WDAY)))
+
+              (* ;; "This date is during daylight savings, so add 1 hour.  Third arg is day of the week, which we determine by taking days mod 7 plus offset.  Monday = zero in this scheme.  Jan 1 1897 was actually a Friday (not Thursday=3), but we're cheating--1900 was not a leap year")

+
+              (COND
+                 ((> (SETQ HR (ADD1 HR))
+                     23)
+
+                  (* ;; "overflowed into the next day.  This case is too hard (we might have overflowed the month, for example), so just go back and recompute")

+
+                  (SETQ TOTALDAYS (ADD1 TOTALDAYS))
+                  (SETQ HR 0)
+                  (SETQ CHECKDLS NIL)
+                  (GO DTLOOP]
+          (RETURN (LET* [[MONTH (\DTSCAN YDAY '((335 . "Dec")
+                                                (305 . "Nov")
+                                                (274 . "Oct")
+                                                (244 . "Sep")
+                                                (213 . "Aug")
+                                                (182 . "Jul")
+                                                (152 . "Jun")
+                                                (121 . "May")
+                                                (91 . "Apr")
+                                                (60 . "Mar")
+                                                (31 . "Feb")
+                                                (0 . "Jan"]
+                         [DAY (ADD1 (- YDAY (CAR MONTH]
+                         (RESULT (CONCAT "   " (CDR MONTH]
+                        (\RPLRIGHT RESULT 2 DAY 1)
+                        RESULT])
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \4YearsDays
 1461)
+
+
+(CONSTANTS \4YearsDays)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \TimeZoneComp \DayLightSavings)
+)
+)
+(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989 1995 2021))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2020 14676 (LAFITE.ASSURE.DATE.FIELDS 2030 . 8127) (LAFITE.PARSE.DATE.FIELD 8129 . 8766
+) (LAFITE.PARSE.DATE.FIELD.ONLY 8768 . 8983) (LAFITE.SORT.BY.DATE 8985 . 9345) (LAFITE.SORT.MESSAGES 
+9347 . 12737) (LAFITEMSG.DATE.ORDER 12739 . 13487) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13489 . 14133) (
+\LAFITE.SORT.BY.DATE.REGION 14135 . 14674)) (15566 19381 (GDATE1-6 15576 . 19379)))))
+STOP

library/lafite/LAFITETEDIT

@@ -1,14 +1,18 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-May-92 11:28:47" {DSK}<project>medley2.0>library>lafitetedit.;7
 12308  
+
(FILECREATED "30-Sep-2021 23:07:55" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITETEDIT.;3
 12516  
 
-      changes to%:  (FNS TEDIT.ASSURE.NO.BACKING.FILE)
-                    (VARS LAFITETEDITCOMS)
+      changes to%:  (VARS LAFITETEDITCOMS)
+                    (FNS LA.ADJUST.FORMATTING LA.SKIP.LOOKS.LIST LA.DETACH.TEDIT LA.TEDIT.INCLUDE 
+                         LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
+                    (FILES LAFITEDECLS)
 
-      previous date%: "29-Apr-92 13:30:23" {DSK}<project>medley2.0>library>lafitetedit.;5)
+      previous date%: "30-Sep-2021 22:59:28" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITETEDIT.;2)
 
 
 (* ; "
-Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
+Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT LAFITETEDITCOMS)
@@ -21,10 +25,10 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
              LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
         (DECLARE%: EVAL@COMPILE DONTCOPY 
 
-               (* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING.  Can't just do (FILES (SOURCE) TEDITDECLS), because there is a compiled version that is already loaded that isn't enough.")

+               (* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING.  Can't just do (FILES (SOURCE) TEDITDCL), because there is a compiled version that is already loaded that isn't enough.")

 
-               (P (CL:UNLESS (GET 'TEDITDECLS 'FILE)
-                         (FILESLOAD TEDITDECLS)))
+               (P (CL:UNLESS (GET 'TEDITDCL 'FILE)
+                         (FILESLOAD TEDITDCL)))
                (FILES (SOURCE)
                       LAFITEDECLS)
                (GLOBALVARS *TEDIT-FILE-READTABLE*)
@@ -181,8 +185,8 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
-(CL:UNLESS (GET 'TEDITDECLS 'FILE)
-       (FILESLOAD TEDITDECLS))
+(CL:UNLESS (GET 'TEDITDCL 'FILE)
+       (FILESLOAD TEDITDCL))
 
 
 (FILESLOAD (SOURCE)
@@ -198,9 +202,9 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
 (LOCALVARS . T)
 )
 )
-(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992))
+(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1342 11940 (LA.ADJUST.FORMATTING 1352 . 7488) (LA.SKIP.LOOKS.LIST 7490 . 8064) (
-LA.DETACH.TEDIT 8066 . 8431) (LA.TEDIT.INCLUDE 8433 . 8922) (LA.WINDOW.FROM.TEXTSTREAM 8924 . 9370) (
-TEDIT.ASSURE.NO.BACKING.FILE 9372 . 11938)))))
+  (FILEMAP (NIL (1549 12147 (LA.ADJUST.FORMATTING 1559 . 7695) (LA.SKIP.LOOKS.LIST 7697 . 8271) (
+LA.DETACH.TEDIT 8273 . 8638) (LA.TEDIT.INCLUDE 8640 . 9129) (LA.WINDOW.FROM.TEXTSTREAM 9131 . 9577) (
+TEDIT.ASSURE.NO.BACKING.FILE 9579 . 12145)))))
 STOP

lispusers/BACKGROUND-YIELD

@@ -0,0 +1,50 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;3
 1644   
+
+      changes to%:  (FNS BACKGROUND-YIELD)
+                    (VARS BACKGROUND-YIELDCOMS)
+
+      previous date%: "19-Sep-2021 13:37:10" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
+
+
+(PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
+
+(RPAQQ BACKGROUND-YIELDCOMS
 (
+                                 (* ;; 
+
                               " Add a call to BACKGROUNDFNS to yield when not otherwise busy")

+
+                                 (FNS BACKGROUND-YIELD INIT-YIELD)
+                                 (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT-YIELD T)))
+                                 (VARS BACKGROUND-YIELD)))
+
+
+
+(* ;; " Add a call to BACKGROUNDFNS to yield when not otherwise busy")

+
+(DEFINEQ
+
+(BACKGROUND-YIELD

+  [LAMBDA NIL
                                          (* ; "Edited 20-Sep-2021 11:37 by larry")

+    (IF
 (FIXP BACKGROUND-YIELD)
+        THEN
 (SUBRCALL YIELD BACKGROUND-YIELD)
+              (SUBRCALL CAUSE-INTERRUPT])
+
+(INIT-YIELD

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

+    (SETQ BACKGROUNDFNS (REMOVE 'BACKGROUND-YIELD BACKGROUNDFNS))
+    (if
 [AND ONP (CCODEP (GETD 'BACKGROUND-YIELD]
+        then
 
+
+              (* ;; " add to end")

+
+              (SETQ BACKGROUNDFNS (APPEND BACKGROUNDFNS '(BACKGROUND-YIELD
])
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(INIT-YIELD
 T)
+)
+
+(RPAQQ BACKGROUND-YIELD
 8333330)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (879 1528 (BACKGROUND-YIELD 889 . 1144) (INIT-YIELD 1146 . 1526)))))
+STOP

lispusers/MODERNIZE

@@ -1,92 +1,91 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED " 8-Jul-2021 23:33:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;16
 23978  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS MODERNWINDOW)
+
(FILECREATED "12-Oct-2021 14:57:29" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;28
 25303  
 
-      previous date%: " 3-Jul-2021 10:32:03" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;15)
+      changes to%:  (FNS MODERNWINDOW.BUTTONEVENTFN \MODERNIZED.TEDIT.BUTTONEVENTFN)
+
+      previous date%: "12-Oct-2021 08:34:48" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;26)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
 
 (RPAQQ MODERNIZECOMS

        [
-        (* ;; "Externals")

+        (* ;; "Externals")

 
         (COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP)
               (INITVARS (MODERN-WINDOW-MARGIN 25)))
         
-        (* ;; "Internals")

+        (* ;; "Internals")

 
         [COMS (FNS MODERNWINDOW.BUTTONEVENTFN NEARTOP NEARESTCORNER INCORNER.REGION)
               
-              (* ;; "Behavior for some known window creators")

+              (* ;; "Behavior for some known window creators")

 
               (FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN)
               
-              (* ;; "Add some Meta commands")

+              (* ;; "Add some Meta commands")

 
-              (FNS TEDIT.MODERNIZE TEDIT.SELECTALL)
+              (FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN TEDIT.SELECTALL)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P 
-                                                 (* ;; "Tedit")

+                                                 (* ;; "Tedit")

 
-                                                 (MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
                                                  (TEDIT.MODERNIZE)
                                                  
-                                                 (* ;; "Inspector")

+                                                 (* ;; "Inspector")

 
                                                  (MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
                                                  
 
-                                 (* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

+                                 (* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

 
                                                  (* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
                                                  (MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
                                                  
-                                                 (* ;; "Freemenu")

+                                                 (* ;; "Freemenu")

 
                                                  (MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN)
                                                  
-                                                 (* ;; "SEDIT")

+                                                 (* ;; "SEDIT")

 
                                                  (MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
                                                  
-                                                 (* ;; "Debugger")

+                                                 (* ;; "Debugger")

 
                                                  (MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
                                                  
-                                                 (* ;; "Snap")

+                                                 (* ;; "Snap")

 
                                                  (MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW)
                                                  
-                                                 (* ;; "New execs")

+                                                 (* ;; "New execs")

 
                                                  (MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC)
                                                  
-                                                 (* ;; "Existing exec of the load")

+                                                 (* ;; "Existing exec of the load")

 
                                                  (MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
                                                                       'WINDOW))
                                                  
-                                                 (* ;; "Table browser (for filebrowser)")

+                                                 (* ;; "Table browser (for filebrowser)")

 
                                                  (MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN)
                                                  
-                                                 (* ;; "Grapher")

+                                                 (* ;; "Grapher")

 
                                                  (MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE)
                                                  
-                                                 (* ;; "Sketch")

+                                                 (* ;; "Sketch")

 
                                                  (MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)
                                                  
-                                                 (* ;; "Promptwindow")

+                                                 (* ;; "Promptwindow")

 
                                                  (MODERNWINDOW PROMPTWINDOW T)
                                                  
-                                                 (* ;; 
-
                                               "Menus:  Move only and only with title clicks")

+                                                 (* ;; "Menus:  Move only with title clicks")

 
                                                  (MODERNWINDOW.SETUP 'MENUBUTTONFN 
                                                         'MODERN-MENUBUTTONFN]
@@ -202,39 +201,45 @@
 (DEFINEQ
 
 (MODERNWINDOW.BUTTONEVENTFN

-  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION)
(* ; "Edited 24-Jun-2021 14:49 by rmk:")

-    (IF
 (AND (MOUSESTATE (ONLY LEFT))
+  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION)

+                                                            (* ; "Edited 12-Oct-2021 14:56 by rmk:")

+
+    (* ;; "CORNERREGION is the region that determines the identification of corner and title clicks, presumably excludes uninteresting menus and other attachments that would also be part of the moving and reshaping region (the ATTACHEDREGION below).")

+
+    (if
 (AND (MOUSESTATE (ONLY LEFT))
                  (EQ LASTKEYBOARD 0))
-        THEN
 (TOTOPW WINDOW)
-              (LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION))
-                          (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW]
+        then
 (TOTOPW WINDOW)
+              (CL:UNLESS CORNERREGION                        (* ; 
+
                                                         "Could cover a bunch of Tedit split-panes")

+                  (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION)))
+              (LET [CORNER TOPMARGIN (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW]
 
-                   (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window.  The TOPMARGIN should be 0 in that case.")

+                   (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window.  The TOPMARGIN should be 0 in that case.")

 
-                   (* ;; "This is particularly the case of FILEBROWSER windows, where the the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")

+                   (* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")

 
-                   (SETQ TOPMARGIN (IF
 (WINDOWPROP WINDOW 'TOPMARGIN)
-                                     ELSEIF
 (WINDOWPROP WINDOW 'TITLE)
-                                       THEN
 (FONTPROP WindowTitleDisplayStream 'HEIGHT)
-                                     ELSE
 MODERN-WINDOW-MARGIN))
-                   (SETQ CORNER (INCORNER.REGION
 MAINREGION TOPMARGIN))
-                   (IF
 CORNER
-                       THEN
 
+                   (SETQ TOPMARGIN (if
 (WINDOWPROP WINDOW 'TOPMARGIN)
+                                     elseif
 (WINDOWPROP WINDOW 'TITLE)
+                                       then
 (FONTPROP WindowTitleDisplayStream 'HEIGHT)
+                                     else
 MODERN-WINDOW-MARGIN))
+                   (SETQ CORNER (INCORNER.REGION
 CORNERREGION TOPMARGIN))
+                   (if
 CORNER
+                       then
 
 
-                             (* ;; 
-
       "The upper corners may be in the title bar, near the side, so test corners before titlebar.")

+                             (* ;; 
+
       "The upper corners may be in the title bar, near the side, so test corners before titlebar.")

 
-                             (* ;; "We are in the corner of the main window, so we are reshaping.  But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")

+                             (* ;; "We are in the corner of the main window, so we are reshaping.  But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")

 
-                             (* ;; "WINDOWREGION includes the attached windows")

+                             (* ;; "WINDOWREGION includes the attached windows")

 
-                             (LET ((LEFT (FETCH
 LEFT OF
 ATTACHEDREGION))
-                                   (RIGHT (FETCH
 RIGHT OF
 ATTACHEDREGION))
-                                   (TOP (FETCH
 TOP OF
 ATTACHEDREGION))
-                                   (BOTTOM (FETCH
 BOTTOM OF
 ATTACHEDREGION))
+                             (LET ((LEFT (fetch
 (REGION LEFT) of
 ATTACHEDREGION))
+                                   (RIGHT (fetch
 (REGION RIGHT) of
 ATTACHEDREGION))
+                                   (TOP (fetch
 (REGION TOP) of
 ATTACHEDREGION))
+                                   (BOTTOM (fetch
 (REGION BOTTOM) of
 ATTACHEDREGION))
                                    STARTINGREGION)
 
-                                 (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")

+                                 (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")

 
                                   (CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
                                       [SETQ STARTINGREGION
@@ -253,22 +258,22 @@
                                                            (GETMOUSESTATE)
                                                            (LIST RIGHT BOTTOM LEFT TOP))
                                                   (SHOULDNT])
-                                  (SHAPEW (CL:IF (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
-                                              (WINDOWPROP WINDOW 'MAINWINDOW)
-                                              WINDOW)
+                                  (SHAPEW (CENTRALWINDOW WINDOW)
                                          STARTINGREGION))
                              T
-                     ELSEIF
 (OR ANYWHERE (NEARTOP
 MAINREGION TOPMARGIN TITLEPROPORTION))
-                       THEN
 (NEARESTCORNER
 ATTACHEDREGION)
-                             (MOVEW (CL:IF (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
-                                        (WINDOWPROP WINDOW 'MAINWINDOW)
-                                        WINDOW))
+                     elseif
 (OR ANYWHERE (NEARTOP
 CORNERREGION TOPMARGIN TITLEPROPORTION))
+                       then
 
+
+                             (* ;; "")

+
+                             (NEARESTCORNER
 ATTACHEDREGION)
+                             (MOVEW (CENTRALWINDOW WINDOW))
                              T
-                     ELSEIF
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 
+                     elseif
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 
                                                                            'PREMODERN-BUTTONEVENTFN]
-                       THEN
 (APPLY* ORIGFUNCTION WINDOW)))
-      ELSEIF
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
-        THEN
 (APPLY* ORIGFUNCTION WINDOW])
+                       then
 (APPLY* ORIGFUNCTION WINDOW)))
+      elseif
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
+        then
 (APPLY* ORIGFUNCTION WINDOW])
 
 (NEARTOP

   [LAMBDA (MAINREGION TOPMARGIN TITLEPROPORTION)
        (* ; "Edited 24-Jun-2021 14:51 by rmk:")

@@ -391,10 +396,12 @@
 (DEFINEQ
 
 (TEDIT.MODERNIZE

-  [LAMBDA NIL
                                           (* ; "Edited 24-Jun-2021 20:54 by rmk:")

+  [LAMBDA NIL
                                           (* ; "Edited 11-Oct-2021 15:02 by rmk:")

+    (MODERNWINDOW.SETUP
 (FUNCTION \TEDIT.BUTTONEVENTFN)
+           (FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN))
     (CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN)
 
-        (* ;; "All")

+        (* ;; "All")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,a")
                (FUNCTION TEDIT.SELECTALL)
@@ -403,7 +410,7 @@
                (FUNCTION TEDIT.SELECTALL)
                TEDIT.READTABLE)
 
-        (* ;; "Quit")

+        (* ;; "Quit")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,q")
                (FUNCTION TEDIT.QUIT)
@@ -412,6 +419,19 @@
                (FUNCTION TEDIT.QUIT)
                TEDIT.READTABLE))])
 
+(\MODERNIZED.TEDIT.BUTTONEVENTFN

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 12-Oct-2021 14:27 by rmk:")

+
+    (* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window.  Clicks near the split lines must be ignored.  Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")

+
+    (* ;; "We pass the pain that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")

+
+    (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
+           NIL NIL (APPLY (FUNCTION UNIONREGIONS)
+                          (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE
+                                                                                'REGION)
+                             repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN])
+
 (TEDIT.SELECTALL

   [LAMBDA (STREAM TEXTOBJ SEL)
                          (* ; "Edited  3-May-2020 17:29 by rmk:")

     (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
@@ -422,91 +442,89 @@
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 
-(* ;; "Tedit")

+(* ;; "Tedit")

 
 
-(MODERNWINDOW.SETUP
 '\TEDIT.BUTTONEVENTFN)
-
 (TEDIT.MODERNIZE
)
 
 
-(* ;; "Inspector")

+(* ;; "Inspector")

 
 
 (MODERNWINDOW.SETUP
 '\ITEM.WINDOW.BUTTON.HANDLER)
 
 
-(* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

+(* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

 
 
-                                                             (* (MODERNWINDOW.SETUP
-
                                                           (QUOTE ONEDINSPECT.BUTTONEVENTFN)))

+                                                             (* (MODERNWINDOW.SETUP
+
                                                           (QUOTE ONEDINSPECT.BUTTONEVENTFN)))

 
 (MODERNWINDOW.SETUP
 'ICMLARRAY.TITLECOMMANDFN)
 
 
-(* ;; "Freemenu")

+(* ;; "Freemenu")

 
 
 (MODERNWINDOW.SETUP
 '\FM.BUTTONEVENTFN)
 
 
-(* ;; "SEDIT")

+(* ;; "SEDIT")

 
 
 (MODERNWINDOW.SETUP
 'SEDIT::BUTTONEVENTFN)
 
 
-(* ;; "Debugger")

+(* ;; "Debugger")

 
 
 (MODERNWINDOW.SETUP
 'DBG::DEBUGGER-BUTTON-EVENT)
 
 
-(* ;; "Snap")

+(* ;; "Snap")

 
 
 (MODERNWINDOW.SETUP
 'SNAPW 'MODERN-SNAPW)
 
 
-(* ;; "New execs")

+(* ;; "New execs")

 
 
 (MODERNWINDOW.SETUP
 'ADD-EXEC 'MODERN-ADD-EXEC)
 
 
-(* ;; "Existing exec of the load")

+(* ;; "Existing exec of the load")

 
 
 (MODERNWINDOW
 (PROCESSPROP (TTY.PROCESS)
                          'WINDOW))
 
 
-(* ;; "Table browser (for filebrowser)")

+(* ;; "Table browser (for filebrowser)")

 
 
 (MODERNWINDOW.SETUP
 'TB.BUTTONEVENTFN)
 
 
-(* ;; "Grapher")

+(* ;; "Grapher")

 
 
 (MODERNWINDOW.SETUP
 'APPLYTOSELECTEDNODE)
 
 
-(* ;; "Sketch")

+(* ;; "Sketch")

 
 
 (MODERNWINDOW.SETUP
 'WB.BUTTON.HANDLER)
 
 
-(* ;; "Promptwindow")

+(* ;; "Promptwindow")

 
 
 (MODERNWINDOW
 PROMPTWINDOW T)
 
 
-(* ;; "Menus:  Move only and only with title clicks")

+(* ;; "Menus:  Move only with title clicks")

 
 
 (MODERNWINDOW.SETUP
 'MENUBUTTONFN 'MODERN-MENUBUTTONFN)
@@ -520,10 +538,10 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4933 10561 (MODERNWINDOW 4943 . 6398) (MODERNWINDOW.SETUP 6400 . 9349) (UNMODERNWINDOW 
-9351 . 9745) (MODERNWINDOW.UNSETUP 9747 . 10559)) (10626 18766 (MODERNWINDOW.BUTTONEVENTFN 10636 . 
-15663) (NEARTOP 15665 . 16585) (NEARESTCORNER 16587 . 17466) (INCORNER.REGION 17468 . 18764)) (18824 
-21146 (MODERN-ADD-EXEC 18834 . 19265) (MODERN-SNAPW 19267 . 19810) (TOTOPW.MODERNIZE 19812 . 20240) (
-MODERN-MENUBUTTONFN 20242 . 21144)) (21187 22227 (TEDIT.MODERNIZE 21197 . 21896) (TEDIT.SELECTALL 
-21898 . 22225)))))
+  (FILEMAP (NIL (4845 10473 (MODERNWINDOW 4855 . 6310) (MODERNWINDOW.SETUP 6312 . 9261) (UNMODERNWINDOW 
+9263 . 9657) (MODERNWINDOW.UNSETUP 9659 . 10471)) (10538 18976 (MODERNWINDOW.BUTTONEVENTFN 10548 . 
+15873) (NEARTOP 15875 . 16795) (NEARESTCORNER 16797 . 17676) (INCORNER.REGION 17678 . 18974)) (19034 
+21356 (MODERN-ADD-EXEC 19044 . 19475) (MODERN-SNAPW 19477 . 20020) (TOTOPW.MODERNIZE 20022 . 20450) (
+MODERN-MENUBUTTONFN 20452 . 21354)) (21397 23609 (TEDIT.MODERNIZE 21407 . 22221) (
+\MODERNIZED.TEDIT.BUTTONEVENTFN 22223 . 23278) (TEDIT.SELECTALL 23280 . 23607)))))
 STOP

lispusers/MODERNIZE.TXT

@@ -30,7 +30,7 @@ When the package is loaded, this behavior is installed for the following kinds o
 
 The function MODERNWINDOW.SETUP establishes the new behavior for classes of windows:
 
-(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE)
+(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE TITLEPROPORTION)
 
 ORIGFN is either the name of the BUTTONEVENTFN for a class of windows (e.g. \TEDIT.BUTTONEVENTFN for Tedit windows) or it is a function that creates windows of a particulate kind (e.g. SNAPW or ADD-EXEC).
 
@@ -60,7 +60,7 @@ Provided these capabilities are already loaded, the following window classes are
 
 If it is not known or it is inconvenient to systematically upgrade a button function or a window-creation function, the new behavior can be provided after a particular window has been created, by invoking
 
-(MODERNWINDOW WINDOW ANYWHERE)
+(MODERNWINDOW WINDOW ANYWHERE TITLEPROPORTION)
 
 This saves the windows existing BUTTONEVENTFN as a window property PREMODERN-BUTTONEVENTFN, and installs a simple stub function in its place.
 
@@ -70,7 +70,9 @@ If things go awry:
 
 (UNMODERNWINDOW WINDOW) restores a modernized window (via MACWINDOW) to its original state.
 
-Known issue:  Clicking at the bottom-right corner of Tedit windows sometimes doesn't catch the new behavior--there seems to be a conflict with Tedit's window-splitting conventions. Clicking a little further into the window seems more reliable.
+Known issues:  
+
+Clicking at the bottom of an EXEC window running TTYIN is effective only when the input line is empty.
 
 
 

lispusers/TEDIT-PF-SEE

@@ -0,0 +1,148 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "12-Oct-2021 22:31:01" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;30
 6975   
+
+      changes to%:  (FNS CLOSE-TYPED-WINDOW)
+
+      previous date%: "12-Oct-2021 15:22:43" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;29)
+
+
+(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
+
+(RPAQQ TEDIT-PF-SEECOMS

+       [(FNS SEE-TEDIT PF-TEDIT)
+        (COMS (FNS GET-TYPED-WINDOW CLOSE-TYPED-WINDOW)
+              (INITVARS (TYPED-WINDOWS)))
+        (COMMANDS ts tpf)
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
+                                                                             (NLAML)
+                                                                             (LAMA])
+(DEFINEQ
+
+(SEE-TEDIT

+  [LAMBDA (FILE WINDOW FORMAT)
                          (* ; "Edited 11-Oct-2021 08:51 by rmk:")

+    (SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
+                   (ERROR "FILE NOT FOUND" FILE)))
+    (TEDIT-SEE FILE (GET-TYPED-WINDOW
 (OR WINDOW 'SEE-TEDIT)
+                           (CONCAT "SEE window for " FILE))
+           FORMAT)
+    FILE])
+
+(PF-TEDIT

+  [LAMBDA (FN IFILES)
                                   (* ; "Edited 12-Oct-2021 15:22 by rmk:")

+
+    (* ;; "PF* to a read-only TEDIT window.  First argument is the function name, second if given is the input file.")

+
+    (CL:WHEN (LISTP FN)
+        (SETQ FN (CAR FN)))
+    (IF
 FN
+        THEN
                                             (* ; "FN name specified; use it.")

+              (SETQ LASTWORD FN)
+      ELSE
                                               (* ; "Not specified, use LASTWORD")

+            (SETQ FN LASTWORD))
+    (IF
 [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
+                                           (WHEREIS FN 'FUNCTIONS T]
+        THEN
                                             (* ; "skip compiled files")

+              (FOR
 IFILE LOC TSTREAM ENV INSIDE
 IFILES
+                 UNLESS
 (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
+                                  *COMPILED-EXTENSIONS*)
+                 DO
 (SETQ LOC (FINDFNDEF FN IFILE))
+                       (IF
 (LISTP LOC)
+                           THEN
 [CL:WITH-OPEN-FILE (ISTREAM (POP
 LOC)
+                                                              :DIRECTION :INPUT)
+                                           (SETQ ENV (LISPSOURCEFILEP ISTREAM))
+                                           (SETFILEINFO ISTREAM 'FORMAT ENV)
+                                           (SETQ TSTREAM (OPENTEXTSTREAM))
+                                           (DSPFONT DEFAULTFONT TSTREAM)
+                                           (PRINT-READER-ENVIRONMENT ENV TSTREAM)
+                                           (PFCOPYBYTES ISTREAM TSTREAM (POP
 LOC)
+                                                  (POP
 LOC))
+                                           (TERPRI TSTREAM)
+                                           (SETQ TSTREAM (TEDIT TSTREAM (GET-TYPED-WINDOW

+                                                                         'PF-TEDIT
+                                                                         (CONCAT FN "  from "
+                                                                                (FULLNAME ISTREAM)))
+                                                                NIL
+                                                                '(READONLY T]
+                         ELSEIF
 (EQ LOC 'FILE.NOT.FOUND)
+                           THEN
 (printout T "file " IFILE " not found." T)
+                         ELSE
 (printout T FN " not found on " LOC "." T)))
+      ELSE
 (PRINTOUT T FN " has no function definition" T])
+)
+(DEFINEQ
+
+(GET-TYPED-WINDOW

+  [LAMBDA (WINDOWTYPE TITLE NOOPENFLG)
                  (* ; "Edited 11-Oct-2021 10:06 by rmk:")

+
+    (* ;; "WINDOWTYPE=T means always create a new window.  If a WINDOW, then reuse it.")

+
+    (* ;; "Otherwise, create a window of type WINDOWTYPE, using a previously specified region if one is available.")

+
+    (LET (WINDOW REGION WLIST)
+         [IF
 (OR (EQ WINDOWTYPE T)
+                     (SETQ WINDOW (WINDOWP WINDOWTYPE)))
+             THEN
 (SETQ WINDOWTYPE NIL)
+           ELSE
 [SETQ WLIST (OR (ASSOC WINDOWTYPE TYPED-WINDOWS)
+                                    (CAR (PUSH
 TYPED-WINDOWS (CONS WINDOWTYPE]
+                 (SETQ REGION (FIND
 X IN
 (CDR WLIST) SUCHTHAT
 (TYPE?
 REGION X]
+         (CL:UNLESS WINDOW
+
+             (* ;; "Make sure we have a titlebar and promptwindow")

+
+             (SETQ WINDOW (CREATEW REGION "" NIL NOOPENFLG))
+             (GETPROMPTWINDOW WINDOW)
+
+             (* ;; 
+
        "Replace the region on WLIST with the window, so we can maintan a likely preference order.")

+
+             (IF
 REGION
+                 THEN
 (DSUBST WINDOW REGION WLIST)
+               ELSE
 (NCONC1 WLIST WINDOW)))
+         (CL:WHEN TITLE
+             (WINDOWPROP WINDOW 'TITLE TITLE))
+         (CL:WHEN WINDOWTYPE
+             (WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE)
+             (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CLOSE-TYPED-WINDOW)))
+         WINDOW])
+
+(CLOSE-TYPED-WINDOW

+  [LAMBDA (WINDOW ALL)
                                  (* ; "Edited 12-Oct-2021 22:30 by rmk:")

+
+    (* ;; "Puts the region of WINDOW back on the region list for its type, for later reuse.  If ALL, closes all windows of the type of WINDOW (and recursively puts their regions also on the list).")

+
+    (CL:WHEN (OPENWP WINDOW)
+        [LET [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE]
+             (CL:WHEN WINDOWTYPE
+                 (IF
 ALL
+                     THEN
 (FOR
 W IN
 (OPENWINDOWS) WHEN
 (EQ WINDOWTYPE
+                                                                           (WINDOWPROP W 'WINDOWTYPE)
+                                                                           )
+                                 UNLESS
 (EQ W WINDOW) DO
 (CLOSEW W))
+                   ELSE
 (CL:WHEN (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS))
+                                                             (* ; 
+
                                            "Otherwise, the window pops up if you don't click away")

+                                (TTY.PROCESS T))
+                         (DSUBST (WINDOWPROP WINDOW 'REGION)
+                                WINDOW TYPED-WINDOWS)))])
+    WINDOW])
+)
+
+(RPAQ? TYPED-WINDOWS
 )
+
+(DEFCOMMAND ts (FILE WINDOW FORMAT) (SEE-TEDIT
 FILE WINDOW FORMAT))
+
+(DEFCOMMAND tpf (FN IFILES) (PF-TEDIT
 FN IFILES))
+(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
+
+(ADDTOVAR NLAMA
 )
+
+(ADDTOVAR NLAML
 )
+
+(ADDTOVAR LAMA
 )
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (843 3913 (SEE-TEDIT 853 . 1263) (PF-TEDIT 1265 . 3911)) (3914 6663 (GET-TYPED-WINDOW 
+3924 . 5397) (CLOSE-TYPED-WINDOW 5399 . 6661)))))
+STOP

lispusers/THINFILES

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "18-Aug-2021 20:46:55" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;5
 8653   
 
-      changes to%:  (FNS FB.THINCOMMAND)
+
(FILECREATED " 9-Oct-2021 00:35:17" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;11
 8621   
 
-      previous date%: " 8-Aug-2021 15:05:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;4)
+      changes to%:  (FNS FB.THINP)
+
+      previous date%: " 7-Oct-2021 12:40:24" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;8)
 
 
 (* ; "
@@ -14,16 +15,16 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
 
 (PRETTYCOMPRINT THINFILESCOMS)
 
-(RPAQQ THINFILESCOMS
 [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
-                                                                  FILEBROWSER))
-                          (FNS FB.THINCOMMAND FB.THINP)
-                          (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
-                                                           '(SYSOUT DCOM DATABASE LCOM DFASL MCOM 
-                                                                   MFASL DRIBBLE]
-                                 (THINNAMES NIL))
-                          (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND 
+(RPAQQ THINFILESCOMS

+       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
+                                                FILEBROWSER))
+        (FNS FB.THINCOMMAND FB.THINP)
+        (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
+                                         '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE]
+               (THINNAMES NIL))
+        (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND 
                      "Delvers non-source files and removes all but the last source file of each day."
-                                                           ])
+                                         ])
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (LOADCOMP)
@@ -116,29 +117,33 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
          (FB.PROMPTWPRINT FBROWSER T "Done, " NDELETED " files marked for deletion."])
 
 (FB.THINP

-  [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)

-                                                            (* ; "Edited  8-Aug-2021 15:05 by rmk:")

+  [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)

+                                                            (* ; "Edited  9-Oct-2021 00:35 by rmk:")

+    (SETQ FILENAME (U-CASE FILENAME))
     (COND
-       ((FMEMB (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION))
-               THINEXTENSIONS)                               (* ; 
-
                                   "always delver files that can be reconstructed from the source.")

-        T)
-       ((AND THINNAMES (EQMEMB (U-CASE (FILENAMEFIELD FILENAME 'NAME))
-                              THINNAMES))
-        T)
-       (OLDESTVERSION?                                       (* ; 
-
                                                 "don't delete the oldest version of source files.")

+       [(OR (EQMEMB (FILENAMEFIELD FILENAME 'EXTENSION)
+                   THINEXTENSIONS)
+            (FIND
 TN (FN _ (FILENAMEFIELD FILENAME 'NAME))
+                   (FE _ (FILENAMEFIELD FILENAME 'EXTENSION)) INSIDE
 THINNAMES
+               SUCHTHAT
 
+
+                     (* ;; "Separate extractions because period for null extension is confusing")

+
+                     (AND (EQ FN (FILENAMEFIELD TN 'NAME))
+                          (EQ FE (FILENAMEFIELD TN 'EXTENSION]
+       (OLDESTVERSION?                                       (* ; 
+
                                                 "don't delete the oldest version of source files.")

               NIL)
-       ((ILESSP AGE ONEDAY)                                  (* ; 
-
                                                   "don't delete anything written within 24 hours.")

+       ((ILESSP AGE ONEDAY)                                  (* ; 
+
                                                   "don't delete anything written within 24 hours.")

         NIL)
        ((ILESSP (ITIMES DELTATIMESTAMP 3)
-               ONEDAY)                                       (* ; 
-
         "delete anything that occurs on the same day as something else (except for the first day)")

+               ONEDAY)                                       (* ; 
+
         "delete anything that occurs on the same day as something else (except for the first day)")

         T)
        ((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30))
 
-        (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")

+        (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")

 
         T])
 )
@@ -153,5 +158,5 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
                                      ))
 (PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1297 8184 (FB.THINCOMMAND 1307 . 6808) (FB.THINP 6810 . 8182)))))
+  (FILEMAP (NIL (1106 8152 (FB.THINCOMMAND 1116 . 6617) (FB.THINP 6619 . 8150)))))
 STOP

release-notes.md

@@ -5,18 +5,30 @@ Alternatively, you can pick up the medley release, and build your own maiko.
 
 Get the Maiko release [here](https://github.com/Interlisp/maiko/releases).
 
+The medley release comes in two parts:
+1. The "loadups" (download `$tag-loadups.tgz` below)
+2. The "runtime" (download `$tag-runtime.tgz` below)
+
+You won't need the "runtime" if you clone medley; it's just a subset. 
+   
+To download both using 'gh' GitHub command line:
+```
+   gh release download -R Interlisp/medley -p "*"
+```
+
 To use (from a shell/terminal window):
 
-1. Unpack the medley tar file
-  ```
-  tar -xvfz $tag.tgz
-  ```
-
-2. Unpack the maiko file for your operating system and CPU type,e.g.,
-
+1. Unpack the medley tar file(s)
 ```
+  tar -xvfz $tag-loadups.tgz
+  tar -xvfz $tag-runtime.tgz
+```
+
+2. Unpack the maiko file for your operating system and CPU type, e.g.,
+
+   ```
      tar -xvfz maiko-210823.linux.x86_64.tgz
-```
+   ```
 
 3. This should leave you with two directories, `medley` and `maiko`.
   Then you can 

run-medley

@@ -1,16 +1,19 @@
 #!/bin/sh
 #               Run Medley
 #
-# Syntax: run-medley [--dimensions WIDTHxHEIGHT] \  sets both -g -sc
-#                    [-g WIDTHxHEIGHT]           \
-#                    [-sc WIDTHxHEIGHT]          \
-#                    [--display X_DISPLAY]       \
-#                    [--vmem | --vmfile FILE]    \
-#                    [--nogreet | --greet FILE]  \
-#                    [-n | -nl | 
-#                    [URL_OR_FILE]
+# Syntax: run-medley [-noscroll]                 #turn off scrollbars
+#                    [--dimensions WIDTHxHEIGHT] #  sets both -g -sc
+#                    [-g WIDTHxHEIGHT]
+#                    [-sc WIDTHxHEIGHT]
+#                    [--display X_DISPLAY]       # defaults to $DISPLAY or :0
+#                    [-prog LDEFILE]
+#                    [--vmem | --vmfile FILE]
+#                    [--nogreet | --greet FILE |
+#                           --loadup FILE ]      # will separate from GREET
+#                    [-n | -nl | -full | -lisp |  
+#                    [SYSOUTFILE]
 
-# Directory variables are accessible from Lisp via UNIX-GETENV
+# Variables accessible from Lisp via UNIX-GETENV
 # LDESRCESYSOUT         SYSOUT full-file name you want to run
 # LDEDESTSYSOUT         name for destination of SaveVM/LOGOUT
 # MEDLEYDIR             used by init file to set other path variables
@@ -36,6 +39,8 @@ fi
 prog="lde"
 passthrough_args=""
 mem="-m 256"
+scroll=22
+noscroll=""
 
 if [ -z "$LDEDESTSYSOUT" ] ; then
     if [ -z "$LOGINDIR" ] ; then
@@ -53,20 +58,34 @@ export LDEKBDTYPE=x
 
 while [ "$#" -ne 0 ]; do
     case "$1" in
+	"-loadup")
+	    export MEDLEYLOADUP="$2"
+	    export LDEINIT="$2"
+	    shift
+	    ;;
         "-nogreet" | "--nogreet")
-            export LDEINIT=""
+	    # Keep (GREET) from finding an init file
+	    mkdir -p $MEDLEYDIR/tmp/logindir
+	    export HOME=$MEDLEYDIR/tmp/logindir
+	    export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
+            export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
             ;;
         "-greet" | "--greet")
             export LDEINIT="$2"
             shift
             ;;
+        "-noscroll")
+	    scroll=0
+	    noscroll="-noscroll"
+	    ;;
         "--dimensions" | "-dimensions")
             sw=`expr "$2" : "\([0-9]*\)x[0-9]*$"`
             sh=`expr "$2" : "[0-9]*x\([0-9]*\)$"`
             if [ -n "$sw" -a -n "$sh" ] ; then
                  sw=$(( (31+$sw)/32*32 ))
-                 gw=$(( 22+$sw ))
-                 gh=$(( 22+$sh ))
+                 gw=$(( $scroll+$sw ))
+                 gh=$(( $scroll+$sh ))
                  geometry="-g ${gw}x${gh}"
                  screensize="-sc ${sw}x${sh}"
             fi
@@ -120,8 +139,6 @@ while [ "$#" -ne 0 ]; do
     shift
 done
 
-# not set on command line
-
 if [ -z "$LDESRCESYSOUT" ] ; then
     if [ -f "$LDEDESTSYSOUT" ] ; then
         export LDESRCESYSOUT="$LDEDESTSYSOUT"
@@ -136,52 +153,46 @@ if [ -z "$geometry" ] ; then
     screensize="-sc 1440x900"
 fi
 
-case "$LDESRCSYSOUT" in
-    "http:*" | "https:*")
-    echo URL not supported yet
-    exit 1
-esac
-
-inferred_maikodir=false
-
-if [ -z "$MAIKODIR" ] ; then
-    # here we try two options relative to MEDLEYDIR: ./maiko and ../maiko
-    # this is highly imperfect, but the user can always set the env variables
-    export MAIKODIR="$MEDLEYDIR/../maiko"
-    if [ ! -d "$MAIKODIR" ] ; then
-        export MAIKODIR="$MEDLEYDIR/maiko"
-    fi
-    inferred_maikodir=true
-fi
-
-if [ ! -d "$MAIKODIR/bin" ] ; then
-    echo "MAIKODIR has no bin: $MAIKODIR"
-    if [ inferred_maikodir = true ] ; then
-        echo "I tried to infer it based on your working directory, but that didn't work."
-        echo "Try setting the MAIKODIR environment variable to the right location."
-    fi
-    exit 1
-fi
-
-
-oldpath="$PATH"
-
-export PATH=.:"$PATH"
-cd "$MAIKODIR"/bin
-export PATH="$MAIKODIR"/`osversion`.`machinetype`:"$oldpath"
-
-cd "$OLDPWD"
-
 if ! command -v "$prog" > /dev/null 2>&1; then
-    echo "$prog" not found
-    exit 1
+    # if lde is already on path, don't reset it
+    # otherwise check for MAIKODIR
+
+    if [ -z "$MAIKODIR" ] ; then
+	# try two options relative to MEDLEYDIR: ./maiko and ../maiko
+	MAIKODIR="$MEDLEYDIR/../maiko"
+	if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
+            MAIKODIR="$MEDLEYDIR/maiko"
+	fi
+    fi
+
+    if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
+	echo "Could not find 'lde' on PATH"
+	echo "nor MAIKODIR with 'bin/osversion' (to look for it)"
+	exit 1
+    fi
+
+    oldpath="$PATH"
+    oldpwd=`pwd`
+    PATH=.:"$PATH"
+    cd "$MAIKODIR"/bin
+    osv=`osversion`
+    mct=`machinetype`
+    newpath="$MAIKODIR"/"$osv.$mct"
+    PATH="$newpath":"$oldpath"
+    cd "$oldpwd"
+    if ! command -v $prog > /dev/null 2>&1; then
+	echo $prog not found in $newpath
+	echo osversion = $osv
+	echo machinetype = $mct
+	exit 1
+    fi
 fi
 
-echo "running: $prog $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
+echo "running: $prog $noscroll $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
 echo "greet: $LDEINIT"
 
 export INMEDLEY=1
 
-"$prog" $geometry $screensize $mem -t "Medley Interlisp" $passthrough_args "$LDESRCESYSOUT"
+"$prog" $noscroll $geometry $screensize $mem -t "Medley Interlisp" $passthrough_args "$LDESRCESYSOUT"
 
 

scripts/loadup-all.sh

@@ -7,10 +7,6 @@ if [ ! -x run-medley ] ; then
     exit 1
 fi
 
-# set timestamp
-mkdir -p ./tmp
-touch ./tmp/loadup.timestamp
-
 ./scripts/loadup-init.sh && \
     ./scripts/loadup-mid-from-init.sh && \
     ./scripts/loadup-lisp-from-mid.sh && \

scripts/loadup-aux.sh

@@ -9,10 +9,15 @@ fi
 
 touch tmp/loadup.timestamp
 
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
 scr="-sc 1024x768 -g 1042x790"
 
 echo '" (IL:MEDLEY-INIT-VARS)(IL:LOAD(QUOTE MEDLEY-UTILS))(IL:MAKE-EXPORTS-ALL)(IL:MAKE-WHEREIS-HASH)(IL:LOGOUT T)"' > tmp/loadup-aux.cm
-./run-medley $scr -greet "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
+./run-medley $scr -loadup "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
 
 if [ tmp/whereis.hash -nt tmp/loadup.timestamp ]; then
     

scripts/loadup-full-from-lisp.sh

@@ -10,7 +10,12 @@ scr="-sc 1024x768 -g 1042x790"
 
 touch tmp/loadup.timestamp
 
-./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
+./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
 
 if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
     

scripts/loadup-full.sh

@@ -6,11 +6,17 @@ if [ ! -x run-medley ] ; then
     echo must run from MEDLEYDIR ;
     exit 1 ;
 fi
+
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
 scr="-sc 1024x768 -g 1042x790"
 
 touch tmp/loadup.timestamp
 
-./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
+./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
 
 if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
     

scripts/loadup-init.sh

@@ -9,10 +9,14 @@ fi
 
 scr="-sc 1024x768 -g 1042x790"
 
-mkdir -p "$MEDLEYDIR/tmp"
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
 touch tmp/loadup.timestamp
 
-./run-medley $scr -greet "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
+./run-medley $scr -loadup "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
 
 if [ tmp/init.dlinit -nt tmp/loadup.timestamp ]; then
     

scripts/loadup-lisp-from-mid.sh

@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
 scr="-sc 1024x768 -g 1042x790"
 
 
-./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
+./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
 
 if [ tmp/lisp.sysout -nt tmp/loadup.timestamp ]; then
     

scripts/loadup-mid-from-init.sh

@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
 
 scr="-sc 1024x768 -g 1042x790"
 
-./run-medley -prog ldeinit -greet $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
+./run-medley -prog ldeinit -loadup $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
 
 
 echo 

scripts/lsee

@@ -17,4 +17,4 @@ tr '\r' '\n' < $1 | \
 	-e 's///g'\
 	-e 's///g'\
 	-e 's//:/g' \
-    | less -R
+    | less -r

scripts/release-medley.sh

@@ -1,4 +1,5 @@
 #!/bin/sh
+
 export MEDLEYDIR=`pwd`
 if [ ! -x run-medley ] ; then
     echo run from MEDLEYDIR
@@ -13,18 +14,24 @@ fi
 
 cd ..
 
-echo making medley zip $tag 
+echo making $tag-loadups.tgz
 
-tar cfz medley/tmp/$tag.tgz                               \
+tar cfz medley/tmp/$tag-loadups.tgz                       \
+    medley/loadups/lisp.sysout                            \
+    medley/loadups/full.sysout                            \
+    medley/loadups/whereis.hash                           \
+    medley/library/exports.all                            \
+    medley/library/RDSYS medley/library/RDSYS.LCOM
+	
+echo making $tag-runtime.tgz
+
+tar cfz medley/tmp/$tag-runtime.tgz                       \
     --exclude "*~" --exclude "*#*"                        \
     medley/docs/dinfo                                     \
     medley/docs/Documentation\ Tools                      \
     medley/greetfiles/SIMPLE-INIT                         \
     medley/run-medley                                     \
     medley/scripts                                        \
-    medley/loadups/lisp.sysout                            \
-    medley/loadups/full.sysout                            \
-    medley/loadups/whereis.hash                           \
     medley/fonts/displayfonts  medley/fonts/altofonts     \
     medley/fonts/postscriptfonts                          \
     medley/library/                                       \
@@ -33,12 +40,13 @@ tar cfz medley/tmp/$tag.tgz                               \
     medley/sources/                                       \
     medley/internal/library                               \
 
+    
 cd medley
 
 echo making release
 sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md
 gh release create $tag -F tmp/release-notes.md -p -t $tag
 
-echo uploaded $tag.tgz
-gh release upload $tag tmp/$tag.tgz --clobber
+echo uploading
+gh release upload $tag tmp/$tag-loadups.tgz tmp/$tag-runtime.tgz --clobber
 

sources/AOFD

@@ -1,10 +1,11 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-Sep-2021 08:26:16" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;7
 38270  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
+
(FILECREATED " 9-Aug-2021 23:30:19" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;5
 38301  
 
-      changes to%:  (FNS \BASEBYTES.IO.INIT \STRINGSTREAM.INIT)
+      changes to%:  (VARS AOFDCOMS)
+                    (FNS \STRINGSTREAM.INIT)
 
-      previous date%: " 9-Aug-2021 23:30:19" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;6)
+      previous date%: " 8-Aug-2021 00:11:00" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;4)
 
 
 (* ; "
@@ -803,16 +804,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 )
 (PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2584 3691 (\ADD-OPEN-STREAM 2594 . 2871) (\GENERIC-UNREGISTER-STREAM 2873 . 3689)) (
-3732 10989 (CLOSEALL 3742 . 4447) (CLOSEF 4449 . 5645) (EOFCLOSEF 5647 . 5943) (INPUT 5945 . 6717) (
-OPENP 6719 . 7118) (OUTPUT 7120 . 7894) (POSITION 7896 . 8708) (RANDACCESSP 8710 . 9185) (\IOMODEP 
-9187 . 9824) (WHENCLOSE 9826 . 10987)) (10990 11112 (STREAMADDPROP 11000 . 11110)) (12276 25157 (
-\BASEBYTES.IO.INIT 12286 . 15482) (\MAKEBASEBYTESTREAM 15484 . 18796) (\MBS.OUTCHARFN 18798 . 19186) (
-\BASEBYTES.NAME.FROM.STREAM 19188 . 19651) (\BASEBYTES.BOUT 19653 . 20370) (\BASEBYTES.SETFILEPTR 
-20372 . 20993) (\BASEBYTES.READP 20995 . 21631) (\BASEBYTES.BIN 21633 . 22164) (\BASEBYTES.PEEKBIN 
-22166 . 22997) (\BASEBYTES.TRUNCATEFN 22999 . 23503) (\BASEBYTES.OPENFN 23505 . 23995) (
-\BASEBYTES.BLOCKIO 23997 . 25155)) (25280 28589 (OPENSTRINGSTREAM 25290 . 27007) (MAKE-STRING-FORMAT 
-27009 . 28587)) (28861 33522 (\STRINGSTREAM.INIT 28871 . 33520)) (33599 37171 (GETSTREAM 33609 . 33832
-) (\ADDOFD 33834 . 34121) (\CLEAROFD 34123 . 34404) (\DELETEOFD 34406 . 34557) (\GETSTREAM 34559 . 
-36723) (\SEARCHOPENFILES 36725 . 37169)))))
+  (FILEMAP (NIL (2615 3722 (\ADD-OPEN-STREAM 2625 . 2902) (\GENERIC-UNREGISTER-STREAM 2904 . 3720)) (
+3763 11020 (CLOSEALL 3773 . 4478) (CLOSEF 4480 . 5676) (EOFCLOSEF 5678 . 5974) (INPUT 5976 . 6748) (
+OPENP 6750 . 7149) (OUTPUT 7151 . 7925) (POSITION 7927 . 8739) (RANDACCESSP 8741 . 9216) (\IOMODEP 
+9218 . 9855) (WHENCLOSE 9857 . 11018)) (11021 11143 (STREAMADDPROP 11031 . 11141)) (12307 25188 (
+\BASEBYTES.IO.INIT 12317 . 15513) (\MAKEBASEBYTESTREAM 15515 . 18827) (\MBS.OUTCHARFN 18829 . 19217) (
+\BASEBYTES.NAME.FROM.STREAM 19219 . 19682) (\BASEBYTES.BOUT 19684 . 20401) (\BASEBYTES.SETFILEPTR 
+20403 . 21024) (\BASEBYTES.READP 21026 . 21662) (\BASEBYTES.BIN 21664 . 22195) (\BASEBYTES.PEEKBIN 
+22197 . 23028) (\BASEBYTES.TRUNCATEFN 23030 . 23534) (\BASEBYTES.OPENFN 23536 . 24026) (
+\BASEBYTES.BLOCKIO 24028 . 25186)) (25311 28620 (OPENSTRINGSTREAM 25321 . 27038) (MAKE-STRING-FORMAT 
+27040 . 28618)) (28892 33553 (\STRINGSTREAM.INIT 28902 . 33551)) (33630 37202 (GETSTREAM 33640 . 33863
+) (\ADDOFD 33865 . 34152) (\CLEAROFD 34154 . 34435) (\DELETEOFD 34437 . 34588) (\GETSTREAM 34590 . 
+36754) (\SEARCHOPENFILES 36756 . 37200)))))
 STOP

sources/ASTACK

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "23-May-91 14:25:00" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;4|
 43099  
+
(FILECREATED "11-Sep-2021 12:54:19" {DSK}<home>larry>medley>sources>ASTACK.;2
 43098  
 
-      changes to%:  (FNS \STKARG)
+      changes to%:  (FNS STKARGNAME)
 
-      previous date%: "20-Feb-91 13:47:06" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;3|)
+      previous date%: "23-May-91 14:25:00" {DSK}<home>larry>medley>sources>ASTACK.;1)
 
 
 (* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1982-1987, 1990-1991 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT ASTACKCOMS)
@@ -501,7 +501,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
                      (T (LISPERROR "ILLEGAL STACK ARG" N])
 
 (STKARGNAME

-  [LAMBDA (N POS)
                                        (* ; "Edited 18-Feb-91 16:55 by jds")

+  [LAMBDA (N POS NOERROR)
                              (* ; "Edited 11-Sep-2021 12:51 by larry")

 
     (* ;; "Given an interpreted frame and an argument number, return the name of that argument (actually, just the n-th NameTable entry)")

 
@@ -552,6 +552,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
                                                                            WORDSPERCELL]
                                 (RETURN)))
                             (MAKE-NTENTRY PVARCODE (SUB1 NTENTRY)))
+                           (NOERROR (RETURN))
                            (T (LISPERROR "ILLEGAL STACK ARG" N]
           (RETURN (for
 NT1 from
 (fetch
 (FNHEADER OVERHEADWORDS) of
 T)
                      by
 (CONSTANT (WORDSPERNAMEENTRY)) as
 NT2
@@ -789,13 +790,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
 )
 (PUTPROPS ASTACK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1519 4724 (ARG 1529 . 1688) (SETARG 1690 . 1874) (\ARG 1876 . 2111) (\ARGPTR 2113 . 
-4455) (\SETARG 4457 . 4722)) (4725 8940 (\RETURN 4735 . 5093) (\STACKARGPTR 5095 . 8938)) (8985 12362 
-(STKNTH 8995 . 9893) (STKNTHNAME 9895 . 10782) (STKNAME 10784 . 10929) (SETSTKNAME 10931 . 12360)) (
-12363 16138 (STKPOS 12373 . 13294) (STKSCAN 13296 . 13942) (RETFROM 13944 . 14298) (RETTO 14300 . 
-14575) (RESUME 14577 . 15950) (\RESUME 15952 . 16136)) (16139 42186 (STKARG 16149 . 16484) (\STKARG 
-16486 . 21189) (SETSTKARG 21191 . 25374) (STKARGNAME 25376 . 29599) (\SPREADFRAMEP 29601 . 30142) (
-SETSTKARGNAME 30144 . 33435) (STKNARGS 33437 . 35846) (FRAMESCAN 35848 . 36298) (\INTERPFRAMENT 36300
- . 36700) (\FRAMESCAN 36702 . 39755) (\VAROFFSET 39757 . 42184)) (42228 42781 (\RECLAIMSTACKP 42238 . 
-42779)))))
+  (FILEMAP (NIL (1470 4675 (ARG 1480 . 1639) (SETARG 1641 . 1825) (\ARG 1827 . 2062) (\ARGPTR 2064 . 
+4406) (\SETARG 4408 . 4673)) (4676 8891 (\RETURN 4686 . 5044) (\STACKARGPTR 5046 . 8889)) (8936 12313 
+(STKNTH 8946 . 9844) (STKNTHNAME 9846 . 10733) (STKNAME 10735 . 10880) (SETSTKNAME 10882 . 12311)) (
+12314 16089 (STKPOS 12324 . 13245) (STKSCAN 13247 . 13893) (RETFROM 13895 . 14249) (RETTO 14251 . 
+14526) (RESUME 14528 . 15901) (\RESUME 15903 . 16087)) (16090 42185 (STKARG 16100 . 16435) (\STKARG 
+16437 . 21140) (SETSTKARG 21142 . 25325) (STKARGNAME 25327 . 29598) (\SPREADFRAMEP 29600 . 30141) (
+SETSTKARGNAME 30143 . 33434) (STKNARGS 33436 . 35845) (FRAMESCAN 35847 . 36297) (\INTERPFRAMENT 36299
+ . 36699) (\FRAMESCAN 36701 . 39754) (\VAROFFSET 39756 . 42183)) (42227 42780 (\RECLAIMSTACKP 42237 . 
+42778)))))
 STOP

sources/ATERM

@@ -1,10 +1,10 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-Sep-2021 08:25:38" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;5
 57504  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
+
(FILECREATED " 7-Aug-2021 12:47:09" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;3
 57513  
 
-      changes to%:  (FNS \INITBCPLDISPLAY)
+      changes to%:  (FNS \FILLBUFFER)
 
-      previous date%: " 7-Aug-2021 12:47:09" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;4)
+      previous date%: "23-Jun-2021 12:31:16" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;2)
 
 
 (* ; "
@@ -1142,18 +1142,18 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
 )
 (PUTPROPS ATERM COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2983 31940 (BKLINBUF 2993 . 3468) (CLEARBUF 3470 . 4802) (LINBUF 4804 . 4990) (
-PAGEFULLFN 4992 . 6473) (SETLINELENGTH 6475 . 6671) (SYSBUF 6673 . 6859) (TERMCHARWIDTH 6861 . 7278) (
-TERMINAL-INPUT 7280 . 7848) (TERMINAL-OUTPUT 7850 . 8436) (\CHDEL1 8438 . 8707) (\CLOSELINE 8709 . 
-8998) (\DECPARENCOUNT 9000 . 10583) (\ECHOCHAR 10585 . 11277) (\FILLBUFFER 11279 . 24270) (
-\FILLBUFFER.WORDSEPRP 24272 . 24517) (\FILLBUFFER.BACKUP 24519 . 24698) (\GETCHAR 24700 . 25089) (
-\INCPARENCOUNT 25091 . 27703) (\RESETLINE 27705 . 28029) (\RESETTERMINAL 28031 . 28795) (\SAVELINEBUF 
-28797 . 30768) (\STOPSCROLL? 30770 . 31938)) (32151 36007 (\DSCCOUT 32161 . 35301) (\INITBCPLDISPLAY 
-35303 . 36005)) (36200 37450 (VIDEOCOLOR 36210 . 37448)) (38282 44136 (\PEEKREFILL 38292 . 42403) (
-\READREFILL 42405 . 42999) (\RATOM/RSTRING-REFILL 43001 . 43579) (\READCREFILL 43581 . 44134)) (44137 
-45966 (DRIBBLE 44147 . 45748) (DRIBBLEFILE 45750 . 45964)) (45967 52642 (\SETUP.DEFAULT.LINEBUF 45977
- . 48434) (\CREATELINEBUFFER 48436 . 50858) (\LINEBUF.READP 50860 . 51209) (\LINEBUF.EOFP 51211 . 
-51550) (\LINEBUF.PEEKBIN 51552 . 51759) (\OPENLINEBUF 51761 . 52640)) (52717 53956 (LINEBUFFER-EOFP 
-52727 . 53185) (LINEBUFFER-SKIPSEPRS 53187 . 53954)) (54313 54587 (\INTERMP 54323 . 54454) (\OUTTERMP 
-54456 . 54585)))))
+  (FILEMAP (NIL (2992 31949 (BKLINBUF 3002 . 3477) (CLEARBUF 3479 . 4811) (LINBUF 4813 . 4999) (
+PAGEFULLFN 5001 . 6482) (SETLINELENGTH 6484 . 6680) (SYSBUF 6682 . 6868) (TERMCHARWIDTH 6870 . 7287) (
+TERMINAL-INPUT 7289 . 7857) (TERMINAL-OUTPUT 7859 . 8445) (\CHDEL1 8447 . 8716) (\CLOSELINE 8718 . 
+9007) (\DECPARENCOUNT 9009 . 10592) (\ECHOCHAR 10594 . 11286) (\FILLBUFFER 11288 . 24279) (
+\FILLBUFFER.WORDSEPRP 24281 . 24526) (\FILLBUFFER.BACKUP 24528 . 24707) (\GETCHAR 24709 . 25098) (
+\INCPARENCOUNT 25100 . 27712) (\RESETLINE 27714 . 28038) (\RESETTERMINAL 28040 . 28804) (\SAVELINEBUF 
+28806 . 30777) (\STOPSCROLL? 30779 . 31947)) (32160 36016 (\DSCCOUT 32170 . 35310) (\INITBCPLDISPLAY 
+35312 . 36014)) (36209 37459 (VIDEOCOLOR 36219 . 37457)) (38291 44145 (\PEEKREFILL 38301 . 42412) (
+\READREFILL 42414 . 43008) (\RATOM/RSTRING-REFILL 43010 . 43588) (\READCREFILL 43590 . 44143)) (44146 
+45975 (DRIBBLE 44156 . 45757) (DRIBBLEFILE 45759 . 45973)) (45976 52651 (\SETUP.DEFAULT.LINEBUF 45986
+ . 48443) (\CREATELINEBUFFER 48445 . 50867) (\LINEBUF.READP 50869 . 51218) (\LINEBUF.EOFP 51220 . 
+51559) (\LINEBUF.PEEKBIN 51561 . 51768) (\OPENLINEBUF 51770 . 52649)) (52726 53965 (LINEBUFFER-EOFP 
+52736 . 53194) (LINEBUFFER-SKIPSEPRS 53196 . 53963)) (54322 54596 (\INTERMP 54332 . 54463) (\OUTTERMP 
+54465 . 54594)))))
 STOP

sources/BOOTSTRAP

@@ -1,11 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "17-Aug-2021 00:08:39" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58
 47657  
+
(FILECREATED "27-Sep-2021 10:25:31" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;60
 47698  
 
-      changes to%:  (FNS \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT)
+      changes to%:  (FNS PRINT-READER-ENVIRONMENT READ-READER-ENVIRONMENT)
 
-      previous date%: "15-Aug-2021 21:21:35" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;57)
+      previous date%: "17-Aug-2021 00:08:39" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58)
 
 
 (* ; "
@@ -15,14 +15,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
 (PRETTYCOMPRINT BOOTSTRAPCOMS)
 
 (RPAQQ BOOTSTRAPCOMS

-       [(COMS                                                (* ; "Some basic fns.  Note that several are redefined later.  E.g., RPAQQ et al real definitions are on UNDO")

+       [(COMS                                                (* ; "Some basic fns.  Note that several are redefined later.  E.g., RPAQQ et al real definitions are on UNDO")

               (FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? SELECTQ SELECTQ1 NCONC1 PUTPROP 
                    PROPNAMES ADDPROP REMPROP MEMB CLOSEF?))
-        (COMS                                                (* ; 
-
                                          "Need these in order to load even compiled files SYSLOAD")

+        (COMS                                                (* ; 
+
                                          "Need these in order to load even compiled files SYSLOAD")

               (FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD 
                    PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME))
-        [COMS                                                (* ; "For DEFINE-FILE-INFO")

+        [COMS                                                (* ; "For DEFINE-FILE-INFO")

               (FNS DEFINE-FILE-INFO \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT 
                    READ-READER-ENVIRONMENT MAKE-DEFINE-FILE-INFO-ENV)
               (INITVARS (*DEFINE-FILE-INFO-ENV* (MAKE-DEFINE-FILE-INFO-ENV]
@@ -76,7 +76,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
                                            (AND (CCODEP 'BOOTSTRAP-NAMEFIELD)
                                                 (PUTD 'BOOTSTRAP-NAMEFIELD]
                (P (RADIX 10)))
-        (DECLARE%: DOEVAL@COMPILE DONTCOPY                   (* ; "eventually imported from FASL")

+        (DECLARE%: DOEVAL@COMPILE DONTCOPY                   (* ; "eventually imported from FASL")

                (CONSTANTS FASL:SIGNATURE))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                (ADDVARS (NLAMA DEFINE-FILE-INFO DECLARE%: PUTPROPS FILECREATED SELECTQ)
@@ -784,9 +784,9 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
                 REREADTABLEFORM _ READTABLEFORM])
 
 (PRINT-READER-ENVIRONMENT

-  [LAMBDA (ENV STREAM)
                                  (* ; "Edited 16-Aug-2021 23:51 by rmk:")

+  [LAMBDA (ENV STREAM)
                                  (* ; "Edited 27-Sep-2021 10:24 by rmk:")

 
-(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")

+(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")

 
     (CL:UNLESS (EQUAL-READER-ENVIRONMENT ENV *OLD-INTERLISP-READ-ENVIRONMENT*)
         (LET ((*PACKAGE* *INTERLISP-PACKAGE*)
@@ -807,14 +807,15 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
                             ,@(CL:UNLESS (EQ :XCCS (FETCH
 REFORMAT OF
 ENV))
                                   `(:FORMAT ,(FETCH
 REFORMAT OF
 ENV)))]
                     STREAM
-                    (FETCH
 (READER-ENVIRONMENT REREADTABLE) OF
 *DEFINE-FILE-INFO-ENV*))))])
+                    (FETCH
 (READER-ENVIRONMENT REREADTABLE) OF
 *DEFINE-FILE-INFO-ENV*))
+             (TERPRI STREAM)))])
 
 (READ-READER-ENVIRONMENT

-  [LAMBDA (STREAM DEFAULTENV RETURNFORM)
                (* ; "Edited 30-Jul-2021 09:58 by rmk:")

+  [LAMBDA (STREAM DEFAULTENV RETURNFORM)
                (* ; "Edited 26-Sep-2021 23:31 by rmk:")

 
-    (* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")

+    (* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")

 
-    (* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")

+    (* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")

 
     (CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
     (LET ((START (GETFILEPTR STREAM))
@@ -825,32 +826,32 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
                               )))
          (DECLARE
 (SPECVARS *READTABLE*))
          (SELCHARQ (SKIPSEPRCODES STREAM)
-              (";"                                           (* ; "Assume it's a common lisp file")

+              (";"                                           (* ; "Assume it's a common lisp file")

                    (\EXTERNALFORMAT STREAM (FETCH
 (READER-ENVIRONMENT REFORMAT) OF
 
                                                                        *COMMON-LISP-READ-ENVIRONMENT*
                                                   ))
                    *COMMON-LISP-READ-ENVIRONMENT*)
               ("(" (\EXTERNALFORMAT STREAM (FETCH
 (READER-ENVIRONMENT REFORMAT) OF
 
                                                                                *DEFINE-FILE-INFO-ENV*
-                                                  ))         (* ; 
-
                                                           "Should we reset the format if we fail?")

+                                                  ))         (* ; 
+
                                                           "Should we reset the format if we fail?")

                    (READCCODE STREAM)
                    (WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
-                       (IF
 (EQ 'DEFINE-FILE-INFO (RATOM STREAM))
+                       (IF
 (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
                            THEN
 
 
-                                 (* ;; 
-
      "After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")

+                                 (* ;; 
+
      "After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")

 
                                  [SETQ ENV (\DO-DEFINE-FILE-INFO
 STREAM (SETQ ARGS
                                                                              (CL:READ-DELIMITED-LIST
                                                                               (CHARCODE ")")
                                                                               STREAM]
-                         ELSE
                            (* ; "Hope we are RANDACCESSP")

+                         ELSE
                            (* ; "Hope we are RANDACCESSP")

                                (SETFILEPTR STREAM START))
 
-                       (* ;; 
-
                 "If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")

+                       (* ;; 
+
                 "If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")

 
                        (CL:IF (AND RETURNFORM ARGS)
                            (CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
@@ -981,13 +982,13 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
 (PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4748 14420 (GETPROP 4758 . 5330) (SETATOMVAL 5332 . 5461) (RPAQQ 5463 . 5516) (RPAQ 
-5518 . 5830) (RPAQ? 5832 . 6202) (MOVD 6204 . 8068) (MOVD? 8070 . 8500) (SELECTQ 8502 . 8689) (
-SELECTQ1 8691 . 9033) (NCONC1 9035 . 9231) (PUTPROP 9233 . 10717) (PROPNAMES 10719 . 10910) (ADDPROP 
-10912 . 12975) (REMPROP 12977 . 13831) (MEMB 13833 . 14092) (CLOSEF? 14094 . 14418)) (14493 35057 (
-LOAD 14503 . 15672) (\LOAD-STREAM 15674 . 28748) (FILECREATED 28750 . 30168) (FILECREATED1 30170 . 
-31278) (PRETTYCOMPRINT 31280 . 31765) (BOOTSTRAP-NAMEFIELD 31767 . 32727) (PUTPROPS 32729 . 33097) (
-DECLARE%: 33099 . 33231) (DECLARE%:1 33233 . 34105) (ROOTFILENAME 34107 . 35055)) (35095 45489 (
-DEFINE-FILE-INFO 35105 . 35540) (\DO-DEFINE-FILE-INFO 35542 . 39888) (PRINT-READER-ENVIRONMENT 39890
- . 41443) (READ-READER-ENVIRONMENT 41445 . 44211) (MAKE-DEFINE-FILE-INFO-ENV 44213 . 45487)))))
+  (FILEMAP (NIL (4751 14423 (GETPROP 4761 . 5333) (SETATOMVAL 5335 . 5464) (RPAQQ 5466 . 5519) (RPAQ 
+5521 . 5833) (RPAQ? 5835 . 6205) (MOVD 6207 . 8071) (MOVD? 8073 . 8503) (SELECTQ 8505 . 8692) (
+SELECTQ1 8694 . 9036) (NCONC1 9038 . 9234) (PUTPROP 9236 . 10720) (PROPNAMES 10722 . 10913) (ADDPROP 
+10915 . 12978) (REMPROP 12980 . 13834) (MEMB 13836 . 14095) (CLOSEF? 14097 . 14421)) (14496 35060 (
+LOAD 14506 . 15675) (\LOAD-STREAM 15677 . 28751) (FILECREATED 28753 . 30171) (FILECREATED1 30173 . 
+31281) (PRETTYCOMPRINT 31283 . 31768) (BOOTSTRAP-NAMEFIELD 31770 . 32730) (PUTPROPS 32732 . 33100) (
+DECLARE%: 33102 . 33234) (DECLARE%:1 33236 . 34108) (ROOTFILENAME 34110 . 35058)) (35098 45530 (
+DEFINE-FILE-INFO 35108 . 35543) (\DO-DEFINE-FILE-INFO 35545 . 39891) (PRINT-READER-ENVIRONMENT 39893
+ . 41475) (READ-READER-ENVIRONMENT 41477 . 44252) (MAKE-DEFINE-FILE-INFO-ENV 44254 . 45528)))))
 STOP

sources/BSP

@@ -1,59 +1,58 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-Sep-2021 08:26:22" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BSP.;2
 149423 
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED "19-Jan-93 10:23:19" {DSK}<python>lde>lispcore>sources>BSP.;3
 149048 
 
-      changes to%:  (FNS \BSPINIT)
+      changes to%:  (RECORDS BSPSOC ACKPUP BSPSTREAM)
 
-      previous date%: "19-Jan-93 10:23:19" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BSP.;1)
+      previous date%: " 4-Jan-93 17:24:25" {DSK}<python>lde>lispcore>sources>BSP.;2)
 
 
 (* ; "
-Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
+Copyright (c) 1982, 1983, 1900, 1984, 1985, 1986, 1987, 1990, 1993 by Venue & Xerox Corporation.  All rights reserved.
 ")
 
 (PRETTYCOMPRINT BSPCOMS)
 
-(RPAQQ BSPCOMS

-       ((DECLARE%: EVAL@COMPILE DONTCOPY                     (* ; 
-
                                               "This socket record has both RTP and BSP state info")

+(RPAQQ BSPCOMS
 
+       ((DECLARE%: EVAL@COMPILE DONTCOPY                     (* ; 
+
                                               "This socket record has both RTP and BSP state info")

                (RECORDS BSPSOC ACKPUP BSPSTREAM)
                (CONSTANTS * RTPSTATES)
                (CONSTANTS * RTPEVENTS)
                (CONSTANTS (WORDSPERPORT 3))
                (MACROS RTP.OTHERFN BSP.OTHERFN BSP.INPUT.ERROR BSP.OUTPUT.ERROR \BSPINCFILEPTR))
-        (COMS                                                (* ; 
-
                                                           "User-level RTP socket manipulation")

+        (COMS                                                (* ; 
+
                                                           "User-level RTP socket manipulation")

               (FNS OPENRTPSOCKET CLOSERTPSOCKET \INIT.RTPPROCESS))
-        (COMS                                                (* ; "RTP process")

+        (COMS                                                (* ; "RTP process")

               (FNS \RTP.SOCKET.PROCESS \RTP.HANDLE.INPUT \RTP.HANDLE.PUP \RTP.HANDLE.RFC \RTP.CLEANUP
                    \RTP.ACTION \RTP.ERROR \RTP.SHOW.FAILURE \RTP.FILTER \SEND.ABORT 
                    \SEND.ANSWERING.RFC \SEND.END \SEND.ENDREPLY \SEND.RFC \FILLRTPPUP \SETRTPPORTS)
               (FNS \BSPINIT \BSPEVENTFN \BSP.CLOSE.OPEN.SOCKETS))
-        (COMS                                                (* ; "Creating BSP stream")

+        (COMS                                                (* ; "Creating BSP stream")

               (FNS OPENBSPSTREAM \SMASHBSPSTREAM BSPOUTPUTSTREAM BSPINPUTSTREAM BSPFRNADDRESS 
                    CLOSEBSPSTREAM \BSP.FLUSHINPUT BSPOPENP GETBSPUSERINFO SETBSPUSERINFO)
               (FNS CREATEBSPSTREAM ENDBSPSTREAM))
-        (COMS                                                (* ; "BSP stream functions")

+        (COMS                                                (* ; "BSP stream functions")

               (FNS BSPBIN \BSP.GETNEXTBUFFER BSPPEEKBIN BSPREADP BSPEOFP \BSPBACKFILEPTR 
                    \BSP.PREPARE.INPUT \BSP.GETFILEPTR \BSP.DECLARE.FILEPTR \BSP.SETFILEPTR 
                    \BSP.SKIPBYTES \BSP.CLEANUP.INPUT BSPBOUT \BSP.OTHERBOUT \BSPWRITEBLOCK 
                    BSPFORCEOUTPUT \BSP.SENDBUFFER \BSP.PREPARE.OUTPUT BSPGETMARK BSPPUTMARK 
                    BSP.PUTINTERRUPT))
-        (COMS                                                (* ; "BSP pup handler")

+        (COMS                                                (* ; "BSP pup handler")

               (FNS \BSP.HANDLE.INPUT \BSP.HANDLE.ACK \BSP.HANDLE.DATA \BSP.HANDLE.ERROR 
                    \BSP.HANDLE.INTERRUPT \BSP.HANDLE.INTERRUPTREPLY \SEND.ACK \SEARCH.OUTPUTQ 
                    \SETBSPTIMEOUT \TRANSMIT.STRATEGY))
-        (COMS                                                (* ; "BSP utilities")

+        (COMS                                                (* ; "BSP utilities")

               (FNS \BSP.DEFAULT.ERROR.HANDLER \BSP.TIMERFN \BSP.FLUSH.SOCKET.QUEUES \FILLBSPPUP 
                    BSPHELP))
-        [COMS                                                (* ; "debugging")

+        [COMS                                                (* ; "debugging")

               (FNS PPSOC PPSOC.CURRENT PRINTTIMER PRINTPUPQUEUE BSPPRINTPUP \RTP.INFO.HOOK)
               (DECLARE%: DONTCOPY (ALISTS (PUPPRINTMACROS 8 9 16 17 18 20]
         (INITRECORDS BSPSOC)
         (SYSRECORDS BSPSOC)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\BSPINIT)))
-        (COMS                                                (* ; 
-
                                                           "Some of these may want to be constants")

+        (COMS                                                (* ; 
+
                                                           "Some of these may want to be constants")

               (INITVARS (\BSPSOCKETS)
                      (\RFC.TIMEOUT 2000)
                      (\RTP.DALLY.TIMEOUT 5000)
@@ -79,84 +78,84 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
 (DECLARE%: EVAL@COMPILE
 
 (DATATYPE BSPSOC
 ((FRNPORT WORD)
-                      (FRNSOCKET FIXP)                       (* ; "Net,host,socket of partner")

+                      (FRNSOCKET FIXP)                       (* ; "Net,host,socket of partner")

                       (LCLPORT WORD)
-                      (LCLSOCKET FIXP)                       (* ; "Net,host,socket of us")

-                      (RTPSTATE BYTE)                        (* ; 
-
                                           "The current state of the RTP connection, see RTPSTATES")

-                      (RTPPROCESS POINTER)                   (* ; "Process handle for RTP demon")

-                      (RTPEVENT POINTER)                     (* ; "Notified when RTPSTATE changes")

-                      (PUPSOC POINTER)                       (* ; 
-
                                                           "The packet-level socket used by us")

-                      (CONNID POINTER)                       (* ; 
-
                                                           "A large integer, the connection ID")

-                      (RTPTIMER POINTER)                     (* ; 
-
                                                         "Timer used for timing out some RTP steps")

-                      (RTPTIMEOUT WORD)                      (* ; 
-
                                                      "Timeout for current RTP op, or zero if none")

-                      (BSPINPUTHANDLER POINTER)              (* ; 
-
                                       "Function that is the top-level loop of the watcher process")

+                      (LCLSOCKET FIXP)                       (* ; "Net,host,socket of us")

+                      (RTPSTATE BYTE)                        (* ; 
+
                                           "The current state of the RTP connection, see RTPSTATES")

+                      (RTPPROCESS POINTER)                   (* ; "Process handle for RTP demon")

+                      (RTPEVENT POINTER)                     (* ; "Notified when RTPSTATE changes")

+                      (PUPSOC POINTER)                       (* ; 
+
                                                           "The packet-level socket used by us")

+                      (CONNID POINTER)                       (* ; 
+
                                                           "A large integer, the connection ID")

+                      (RTPTIMER POINTER)                     (* ; 
+
                                                         "Timer used for timing out some RTP steps")

+                      (RTPTIMEOUT WORD)                      (* ; 
+
                                                      "Timeout for current RTP op, or zero if none")

+                      (BSPINPUTHANDLER POINTER)              (* ; 
+
                                       "Function that is the top-level loop of the watcher process")

 
-                      (* ;; "The rest of this structure is dedicated to handling the BSP")

+                      (* ;; "The rest of this structure is dedicated to handling the BSP")

 
-                      (BSPINPUTSTREAM POINTER)               (* ; "Pointer back to STREAM object")

-                      (BSPTIMER POINTER)                     (* ; "Timer for BSP use")

+                      (BSPINPUTSTREAM POINTER)               (* ; "Pointer back to STREAM object")

+                      (BSPTIMER POINTER)                     (* ; "Timer for BSP use")

                       (BSPTIMEOUT WORD)
-                      (BSPFAILUREREASON POINTER)             (* ; 
-
                                                          "Why connection was broken or not opened")

-                      (BSPOTHERPUPFN POINTER)                (* ; 
-
                                                      "Called on error, interrupt and non-bsp pups")

-                      (BSPERRORHANDLER POINTER)              (* ; "Called for bsp errors")

-                      (BSPIOTIMEOUT POINTER)                 (* ; 
-
                               "if non-zero will cause prepare.output and prepare.input to timeout")

-                      (RCVBYTEID POINTER)                    (* ; "ID of as far as we have acked")

-                      (RCVINTERRUPTID POINTER)               (* ; "ID of next incoming interrupt")

-                      (BSPINPUTQ POINTER)                    (* ; 
-
                                                           "Queue of all pups we have received")

-                      (%#UNREADPUPS WORD)                    (* ; 
-
                                              "How many pups do we have before first hole in input")

-                      (XMITBYTEID POINTER)                   (* ; "Id of next outgoing pup")

-                      (XMITINTERRUPTID POINTER)              (* ; "id of next outgoing interrupt")

-                      (LASTACKID POINTER)                    (* ; 
-
                                            "Id of last ack, i.e.  how far our partner has read us")

+                      (BSPFAILUREREASON POINTER)             (* ; 
+
                                                          "Why connection was broken or not opened")

+                      (BSPOTHERPUPFN POINTER)                (* ; 
+
                                                      "Called on error, interrupt and non-bsp pups")

+                      (BSPERRORHANDLER POINTER)              (* ; "Called for bsp errors")

+                      (BSPIOTIMEOUT POINTER)                 (* ; 
+
                               "if non-zero will cause prepare.output and prepare.input to timeout")

+                      (RCVBYTEID POINTER)                    (* ; "ID of as far as we have acked")

+                      (RCVINTERRUPTID POINTER)               (* ; "ID of next incoming interrupt")

+                      (BSPINPUTQ POINTER)                    (* ; 
+
                                                           "Queue of all pups we have received")

+                      (%#UNREADPUPS WORD)                    (* ; 
+
                                              "How many pups do we have before first hole in input")

+                      (XMITBYTEID POINTER)                   (* ; "Id of next outgoing pup")

+                      (XMITINTERRUPTID POINTER)              (* ; "id of next outgoing interrupt")

+                      (LASTACKID POINTER)                    (* ; 
+
                                            "Id of last ack, i.e.  how far our partner has read us")

                       (%#UNACKEDPUPS WORD)
-                      (%#UNACKEDBYTES WORD)                  (* ; 
-
                                         "how many pups/bytes have we sent that haven't been acked")

-                      (BSPOUTPUTQ POINTER)                   (* ; 
-
                                                           "Queue of sent but not acked pups")

-                      (BYTESPERPUP WORD)                     (* ; 
-
                                                         "Maximum size we are allowed to grow pups")

-                      (PUPALLOC WORD)                        (* ; 
-
                  "Remaining outgoing pup allocation, i.e.  partner's allocation less #UNACKEDPUPS")

-                      (BYTEALLOC WORD)                       (* ; 
-
                                                           "Remaining outgoing byte allocation")

+                      (%#UNACKEDBYTES WORD)                  (* ; 
+
                                         "how many pups/bytes have we sent that haven't been acked")

+                      (BSPOUTPUTQ POINTER)                   (* ; 
+
                                                           "Queue of sent but not acked pups")

+                      (BYTESPERPUP WORD)                     (* ; 
+
                                                         "Maximum size we are allowed to grow pups")

+                      (PUPALLOC WORD)                        (* ; 
+
                  "Remaining outgoing pup allocation, i.e.  partner's allocation less #UNACKEDPUPS")

+                      (BYTEALLOC WORD)                       (* ; 
+
                                                           "Remaining outgoing byte allocation")

                       (MAXPUPALLOC WORD)
                       (PUPALLOCCOUNT WORD)
-                      (ADATACOUNT WORD)                      (* ; "incremented once per AData sent")

-                      (LASTADATATIME POINTER)                (* ; "Time last ADATA was sent")

-                      (ADATATIMEOUT WORD)                    (* ; 
-
                                                           "Timeout currently in use for AData")

-                      (INACTIVITYTIMER POINTER)              (* ; 
-
                                                     "Time of last incoming pup on this connection")

-                      (LISTENING FLAG)                       (* ; 
-
                                                "if socket was opened as a server rather than user")

-                      (INTERRUPTOUT FLAG)                    (* ; 
-
                                                           "an unacked interrupt is outstanding")

-                      (INTERRUPTIN FLAG)                     (* ; "an interrupt has been received")

-                      (ACKPENDING FLAG)                      (* ; 
-
                                                           "Adata was received, we need to ack")

-                      (ACKREQUESTED FLAG)                    (* ; 
-
                                                       "We have sent an Adata, are waiting for ack")

-                      (SENTZEROALLOC FLAG)                   (* ; "Need to send gratuitous ack")

-                      (BSPNOACTIVITY FLAG)                   (* ; 
-
                     "True if BSPINACTIVITYTIMEOUT has passed with no sign of life from other side")

-                      (BSPUSERSTATE POINTER)                 (* ; 
-
                                                         "For applications use to do as it pleases")

-                      (NIL WORD)                             (* ; "No longer used")

-                      (IOTIMEOUTFN POINTER)                  (* ; 
-
                                                     "function to be called when prepare.* timeout")

-                      (BSPWHENCLOSEDFN POINTER)              (* ; 
-
                                                           "Called when connection is closed")

+                      (ADATACOUNT WORD)                      (* ; "incremented once per AData sent")

+                      (LASTADATATIME POINTER)                (* ; "Time last ADATA was sent")

+                      (ADATATIMEOUT WORD)                    (* ; 
+
                                                           "Timeout currently in use for AData")

+                      (INACTIVITYTIMER POINTER)              (* ; 
+
                                                     "Time of last incoming pup on this connection")

+                      (LISTENING FLAG)                       (* ; 
+
                                                "if socket was opened as a server rather than user")

+                      (INTERRUPTOUT FLAG)                    (* ; 
+
                                                           "an unacked interrupt is outstanding")

+                      (INTERRUPTIN FLAG)                     (* ; "an interrupt has been received")

+                      (ACKPENDING FLAG)                      (* ; 
+
                                                           "Adata was received, we need to ack")

+                      (ACKREQUESTED FLAG)                    (* ; 
+
                                                       "We have sent an Adata, are waiting for ack")

+                      (SENTZEROALLOC FLAG)                   (* ; "Need to send gratuitous ack")

+                      (BSPNOACTIVITY FLAG)                   (* ; 
+
                     "True if BSPINACTIVITYTIMEOUT has passed with no sign of life from other side")

+                      (BSPUSERSTATE POINTER)                 (* ; 
+
                                                         "For applications use to do as it pleases")

+                      (NIL WORD)                             (* ; "No longer used")

+                      (IOTIMEOUTFN POINTER)                  (* ; 
+
                                                     "function to be called when prepare.* timeout")

+                      (BSPWHENCLOSEDFN POINTER)              (* ; 
+
                                                           "Called when connection is closed")

                       (BSPINPUTEVENT POINTER)
                       (BSPLOCK POINTER)
                       (BSPINITTIMER POINTER)
@@ -175,7 +174,7 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
                                         (LCLPUPADDRESS (CONS (fetch
 LCLPORT of
 DATUM)
                                                              (fetch
 LCLSOCKET of
 DATUM]
 
-                     (* ;; "Note: I assume record pkg does not break up the first six words (the two ports).  I hope I don't have to force it")

+                     (* ;; "Note: I assume record pkg does not break up the first six words (the two ports).  I hope I don't have to force it")

 
                      RTPTIMER _ (CREATECELL \FIXP)
                      BSPTIMER _ (CREATECELL \FIXP)
@@ -186,25 +185,25 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
 
 (BLOCKRECORD ACKPUP
 ((ACKBYTESPERPUP WORD)
                          (ACKPUPS WORD)
-                         (ACKBYTES WORD))                    (* ; 
-
                                                     "body of ACK pup, giving partner's allocation")

+                         (ACKBYTES WORD))                    (* ; 
+
                                                     "body of ACK pup, giving partner's allocation")

                         )
 
 (ACCESSFNS BSPSTREAM
 [(BSPSOC (fetch
 F1 of
 DATUM)
                                  (replace
 F1 of
 DATUM with
 NEWVALUE))
-                                                             (* ; "BSPSOC object")

+                                                             (* ; "BSPSOC object")

                           (BSPOUTPUTSTREAM (fetch
 F2 of
 DATUM)
                                  (replace
 F2 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                              "If this stream is the input side, gives output side")

+                                                             (* ; 
+
                                              "If this stream is the input side, gives output side")

                           (BSPCURRENTPUP (fetch
 F3 of
 DATUM)
                                  (replace
 F3 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                        "PUP whose body is the current buffer.  Could be redundant")

+                                                             (* ; 
+
                                        "PUP whose body is the current buffer.  Could be redundant")

                           (MARKPENDING (fetch
 F4 of
 DATUM)
                                  (replace
 F4 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                                           "On input, true if next byte is a mark")

+                                                             (* ; 
+
                                                           "On input, true if next byte is a mark")

                           (BSPFILEPTRHI (fetch
 FW6 of
 DATUM)
                                  (replace
 FW6 of
 DATUM with
 NEWVALUE))
                           (BSPFILEPTRLO (fetch
 FW7 of
 DATUM)
@@ -318,17 +317,16 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
 )
 
 
-(RPAQQ RTPEVENTS

-       ((\EVENT.OPEN 0)
-        (\EVENT.OPENLISTENING 1)
-        (\EVENT.OPENIMMEDIATE 2)
-        (\EVENT.CLOSE 3)
-        (\EVENT.FORCECLOSE 4)
-        (\EVENT.RFC 5)
-        (\EVENT.ABORT 6)
-        (\EVENT.END 7)
-        (\EVENT.ENDREPLY 8)
-        (\EVENT.TIMEOUT 9)))
+(RPAQQ RTPEVENTS
 ((\EVENT.OPEN 0)
+                      (\EVENT.OPENLISTENING 1)
+                      (\EVENT.OPENIMMEDIATE 2)
+                      (\EVENT.CLOSE 3)
+                      (\EVENT.FORCECLOSE 4)
+                      (\EVENT.RFC 5)
+                      (\EVENT.ABORT 6)
+                      (\EVENT.END 7)
+                      (\EVENT.ENDREPLY 8)
+                      (\EVENT.TIMEOUT 9)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \EVENT.OPEN
 0)
@@ -374,47 +372,44 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS RTP.OTHERFN
 MACRO
 ((PUP SOCKET)
-                                     (SELECTQ (fetch
 OTHERPUPFN of
 SOCKET)
-                                         (RELEASE.PUP (RELEASE.PUP PUP))
-                                         (\BSP.PUPHANDLER 
-                                              (\BSP.PUPHANDLER PUP SOCKET))
-                                         (APPLY* (fetch
 OTHERPUPFN of
 SOCKET)
-                                                PUP SOCKET))))
+[PUTPROPS RTP.OTHERFN MACRO ((PUP SOCKET)
+                             (SELECTQ (fetch
 OTHERPUPFN of
 SOCKET)
+                                 (RELEASE.PUP (RELEASE.PUP PUP))
+                                 (\BSP.PUPHANDLER 
+                                      (\BSP.PUPHANDLER PUP SOCKET))
+                                 (APPLY* (fetch
 OTHERPUPFN of
 SOCKET)
+                                        PUP SOCKET]
 
-(PUTPROPS BSP.OTHERFN
 MACRO
 [(PUP SOCKET)
-                                     (SELECTQ (fetch
 BSPOTHERPUPFN of
 SOCKET)
-                                         (RELEASE.PUP (RELEASE.PUP PUP))
-                                         (APPLY* (fetch
 BSPOTHERPUPFN of
 SOCKET)
-                                                PUP
-                                                (fetch
 BSPINPUTSTREAM of
 SOCKET])
+[PUTPROPS BSP.OTHERFN MACRO ((PUP SOCKET)
+                             (SELECTQ (fetch
 BSPOTHERPUPFN of
 SOCKET)
+                                 (RELEASE.PUP (RELEASE.PUP PUP))
+                                 (APPLY* (fetch
 BSPOTHERPUPFN of
 SOCKET)
+                                        PUP
+                                        (fetch
 BSPINPUTSTREAM of
 SOCKET]
 
-(PUTPROPS BSP.INPUT.ERROR
 MACRO
 (OPENLAMBDA (STREAM ERRCODE)
-                                          (APPLY* (fetch
 BSPERRORHANDLER
-                                                     of
 (fetch
 BSPSOC of
 STREAM))
-                                                 STREAM ERRCODE)))
+(PUTPROPS BSP.INPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
+                                       (APPLY* (fetch
 BSPERRORHANDLER
+                                                  of
 (fetch
 BSPSOC of
 STREAM))
+                                              STREAM ERRCODE)))
 
-(PUTPROPS BSP.OUTPUT.ERROR
 MACRO
 (OPENLAMBDA (STREAM ERRCODE)
-                                           (APPLY* (fetch
 BSPERRORHANDLER
-                                                      of
 (fetch
 BSPSOC of
 STREAM))
-                                                  STREAM ERRCODE)))
+(PUTPROPS BSP.OUTPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
+                                        (APPLY* (fetch
 BSPERRORHANDLER
+                                                   of
 (fetch
 BSPSOC of
 STREAM))
+                                               STREAM ERRCODE)))
 
-(PUTPROPS \BSPINCFILEPTR
 MACRO
 [(STREAM N)
-                                        (PROG (NEWLO)
-                                              (replace
 BSPFILEPTRLO of
 STREAM
-                                                 with
 (COND
-                                                             ((IGREATERP (SETQ NEWLO
-                                                                          (IPLUS (fetch
 
-                                                                                        BSPFILEPTRLO
-                                                                                    of
 STREAM)
-                                                                                 N))
-                                                                     MAX.SMALL.INTEGER)
-                                                              (add
 (fetch
 BSPFILEPTRHI
-                                                                          of
 STREAM)
-                                                                     1)
-                                                              (SUB1 (IDIFFERENCE NEWLO 
-                                                                           MAX.SMALL.INTEGER)))
-                                                             (T NEWLO])
+[PUTPROPS \BSPINCFILEPTR MACRO ((STREAM N)
+                                (PROG (NEWLO)
+                                      (replace
 BSPFILEPTRLO of
 STREAM
+                                         with
 (COND
+                                                     ((IGREATERP (SETQ NEWLO
+                                                                  (IPLUS (fetch
 BSPFILEPTRLO
+                                                                            of
 STREAM)
+                                                                         N))
+                                                             MAX.SMALL.INTEGER)
+                                                      (add
 (fetch
 BSPFILEPTRHI of
 STREAM)
+                                                             1)
+                                                      (SUB1 (IDIFFERENCE NEWLO MAX.SMALL.INTEGER)))
+                                                     (T NEWLO]
 )
 )
 
@@ -2667,34 +2662,33 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
        \BSP.MIN.ADATA.TIMEOUT \BSP.MAX.ADATA.TIMEOUT \BSP.INACTIVITY.TIMEOUT 
        \BSP.NO.INACTIVITY.TIMEOUT)
 )
-(PUTPROPS BSP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1900 1984 1985 1986 1987 1990 1993 2021
-))
+(PUTPROPS BSP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1900 1984 1985 1986 1987 1990 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22186 30354 (OPENRTPSOCKET 22196 . 27464) (CLOSERTPSOCKET 27466 . 29656) (
-\INIT.RTPPROCESS 29658 . 30352)) (30383 56738 (\RTP.SOCKET.PROCESS 30393 . 31244) (\RTP.HANDLE.INPUT 
-31246 . 32231) (\RTP.HANDLE.PUP 32233 . 33765) (\RTP.HANDLE.RFC 33767 . 36259) (\RTP.CLEANUP 36261 . 
-37305) (\RTP.ACTION 37307 . 47779) (\RTP.ERROR 47781 . 48247) (\RTP.SHOW.FAILURE 48249 . 49686) (
-\RTP.FILTER 49688 . 51153) (\SEND.ABORT 51155 . 52073) (\SEND.ANSWERING.RFC 52075 . 53820) (\SEND.END 
-53822 . 54034) (\SEND.ENDREPLY 54036 . 54258) (\SEND.RFC 54260 . 55632) (\FILLRTPPUP 55634 . 56317) (
-\SETRTPPORTS 56319 . 56736)) (56739 59996 (\BSPINIT 56749 . 58588) (\BSPEVENTFN 58590 . 58929) (
-\BSP.CLOSE.OPEN.SOCKETS 58931 . 59994)) (60033 74318 (OPENBSPSTREAM 60043 . 67019) (\SMASHBSPSTREAM 
-67021 . 68392) (BSPOUTPUTSTREAM 68394 . 68750) (BSPINPUTSTREAM 68752 . 68986) (BSPFRNADDRESS 68988 . 
-69205) (CLOSEBSPSTREAM 69207 . 71911) (\BSP.FLUSHINPUT 71913 . 72464) (BSPOPENP 72466 . 73745) (
-GETBSPUSERINFO 73747 . 74007) (SETBSPUSERINFO 74009 . 74316)) (74319 74780 (CREATEBSPSTREAM 74329 . 
-74625) (ENDBSPSTREAM 74627 . 74778)) (74818 99611 (BSPBIN 74828 . 74960) (\BSP.GETNEXTBUFFER 74962 . 
-76639) (BSPPEEKBIN 76641 . 76792) (BSPREADP 76794 . 77994) (BSPEOFP 77996 . 78776) (\BSPBACKFILEPTR 
-78778 . 79212) (\BSP.PREPARE.INPUT 79214 . 83634) (\BSP.GETFILEPTR 83636 . 83932) (
-\BSP.DECLARE.FILEPTR 83934 . 84109) (\BSP.SETFILEPTR 84111 . 84728) (\BSP.SKIPBYTES 84730 . 85518) (
-\BSP.CLEANUP.INPUT 85520 . 86554) (BSPBOUT 86556 . 86777) (\BSP.OTHERBOUT 86779 . 87035) (
-\BSPWRITEBLOCK 87037 . 87296) (BSPFORCEOUTPUT 87298 . 88335) (\BSP.SENDBUFFER 88337 . 91173) (
-\BSP.PREPARE.OUTPUT 91175 . 95052) (BSPGETMARK 95054 . 95531) (BSPPUTMARK 95533 . 97142) (
-BSP.PUTINTERRUPT 97144 . 99609)) (99644 129131 (\BSP.HANDLE.INPUT 99654 . 102515) (\BSP.HANDLE.ACK 
-102517 . 111645) (\BSP.HANDLE.DATA 111647 . 116579) (\BSP.HANDLE.ERROR 116581 . 117781) (
-\BSP.HANDLE.INTERRUPT 117783 . 119293) (\BSP.HANDLE.INTERRUPTREPLY 119295 . 120756) (\SEND.ACK 120758
- . 122678) (\SEARCH.OUTPUTQ 122680 . 124159) (\SETBSPTIMEOUT 124161 . 126045) (\TRANSMIT.STRATEGY 
-126047 . 129129)) (129162 133566 (\BSP.DEFAULT.ERROR.HANDLER 129172 . 129586) (\BSP.TIMERFN 129588 . 
-132024) (\BSP.FLUSH.SOCKET.QUEUES 132026 . 132905) (\FILLBSPPUP 132907 . 133428) (BSPHELP 133430 . 
-133564)) (133593 143408 (PPSOC 133603 . 138899) (PPSOC.CURRENT 138901 . 139240) (PRINTTIMER 139242 . 
-139724) (PRINTPUPQUEUE 139726 . 142001) (BSPPRINTPUP 142003 . 142675) (\RTP.INFO.HOOK 142677 . 143406)
+  (FILEMAP (NIL (21817 29985 (OPENRTPSOCKET 21827 . 27095) (CLOSERTPSOCKET 27097 . 29287) (
+\INIT.RTPPROCESS 29289 . 29983)) (30014 56369 (\RTP.SOCKET.PROCESS 30024 . 30875) (\RTP.HANDLE.INPUT 
+30877 . 31862) (\RTP.HANDLE.PUP 31864 . 33396) (\RTP.HANDLE.RFC 33398 . 35890) (\RTP.CLEANUP 35892 . 
+36936) (\RTP.ACTION 36938 . 47410) (\RTP.ERROR 47412 . 47878) (\RTP.SHOW.FAILURE 47880 . 49317) (
+\RTP.FILTER 49319 . 50784) (\SEND.ABORT 50786 . 51704) (\SEND.ANSWERING.RFC 51706 . 53451) (\SEND.END 
+53453 . 53665) (\SEND.ENDREPLY 53667 . 53889) (\SEND.RFC 53891 . 55263) (\FILLRTPPUP 55265 . 55948) (
+\SETRTPPORTS 55950 . 56367)) (56370 59627 (\BSPINIT 56380 . 58219) (\BSPEVENTFN 58221 . 58560) (
+\BSP.CLOSE.OPEN.SOCKETS 58562 . 59625)) (59664 73949 (OPENBSPSTREAM 59674 . 66650) (\SMASHBSPSTREAM 
+66652 . 68023) (BSPOUTPUTSTREAM 68025 . 68381) (BSPINPUTSTREAM 68383 . 68617) (BSPFRNADDRESS 68619 . 
+68836) (CLOSEBSPSTREAM 68838 . 71542) (\BSP.FLUSHINPUT 71544 . 72095) (BSPOPENP 72097 . 73376) (
+GETBSPUSERINFO 73378 . 73638) (SETBSPUSERINFO 73640 . 73947)) (73950 74411 (CREATEBSPSTREAM 73960 . 
+74256) (ENDBSPSTREAM 74258 . 74409)) (74449 99242 (BSPBIN 74459 . 74591) (\BSP.GETNEXTBUFFER 74593 . 
+76270) (BSPPEEKBIN 76272 . 76423) (BSPREADP 76425 . 77625) (BSPEOFP 77627 . 78407) (\BSPBACKFILEPTR 
+78409 . 78843) (\BSP.PREPARE.INPUT 78845 . 83265) (\BSP.GETFILEPTR 83267 . 83563) (
+\BSP.DECLARE.FILEPTR 83565 . 83740) (\BSP.SETFILEPTR 83742 . 84359) (\BSP.SKIPBYTES 84361 . 85149) (
+\BSP.CLEANUP.INPUT 85151 . 86185) (BSPBOUT 86187 . 86408) (\BSP.OTHERBOUT 86410 . 86666) (
+\BSPWRITEBLOCK 86668 . 86927) (BSPFORCEOUTPUT 86929 . 87966) (\BSP.SENDBUFFER 87968 . 90804) (
+\BSP.PREPARE.OUTPUT 90806 . 94683) (BSPGETMARK 94685 . 95162) (BSPPUTMARK 95164 . 96773) (
+BSP.PUTINTERRUPT 96775 . 99240)) (99275 128762 (\BSP.HANDLE.INPUT 99285 . 102146) (\BSP.HANDLE.ACK 
+102148 . 111276) (\BSP.HANDLE.DATA 111278 . 116210) (\BSP.HANDLE.ERROR 116212 . 117412) (
+\BSP.HANDLE.INTERRUPT 117414 . 118924) (\BSP.HANDLE.INTERRUPTREPLY 118926 . 120387) (\SEND.ACK 120389
+ . 122309) (\SEARCH.OUTPUTQ 122311 . 123790) (\SETBSPTIMEOUT 123792 . 125676) (\TRANSMIT.STRATEGY 
+125678 . 128760)) (128793 133197 (\BSP.DEFAULT.ERROR.HANDLER 128803 . 129217) (\BSP.TIMERFN 129219 . 
+131655) (\BSP.FLUSH.SOCKET.QUEUES 131657 . 132536) (\FILLBSPPUP 132538 . 133059) (BSPHELP 133061 . 
+133195)) (133224 143039 (PPSOC 133234 . 138530) (PPSOC.CURRENT 138532 . 138871) (PRINTTIMER 138873 . 
+139355) (PRINTPUPQUEUE 139357 . 141632) (BSPPRINTPUP 141634 . 142306) (\RTP.INFO.HOOK 142308 . 143037)
 ))))
 STOP

sources/CLSTREAMS

@@ -1,95 +1,104 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 5-Sep-2021 08:24:05" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CLSTREAMS.;2|
 52344  
+
(FILECREATED " 3-Apr-91 15:11:53" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CLSTREAMS.;4|
 54013  
 
-      |changes| |to:|  (FNS %INITIALIZE-CLSTREAM-TYPES)
+      |changes| |to:|  (FUNCTIONS CL:WITH-INPUT-FROM-STRING)
 
-      |previous| |date:| " 3-Apr-91 15:11:53" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CLSTREAMS.;1|)
+      |previous| |date:| "27-Feb-91 20:05:55" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CLSTREAMS.;3|)
 
 
-; Copyright (c) 1985-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
+; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
 
 (PRETTYCOMPRINT CLSTREAMSCOMS)
 
-(RPAQQ CLSTREAMSCOMS

-       (
+(RPAQQ CLSTREAMSCOMS
 (
 
-(* |;;;| "Implements a number of stream functions from CommonLisp.  See CLtL chapter 21")

+(* |;;;| "Implements a number of stream functions from CommonLisp.  See CLtL chapter 21")

 
-        (COMS 
-              (* |;;| "documented functions and macros")

+                          (COMS 
+                                (* |;;| "documented functions and macros")

 
-              (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT)
-              (FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P 
-                     XCL:OPEN-STREAM-P)
-              (COMS (FUNCTIONS FILE-STREAM-POSITION)
-                    (SETFS FILE-STREAM-POSITION))
-              (FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL 
-                     XCL:FOLLOW-SYNONYM-STREAMS)
-              (FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P XCL:BROADCAST-STREAM-STREAMS
-                     )
-              (FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P 
-                     XCL:CONCATENATED-STREAM-STREAMS)
-              (FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM
-                     XCL:TWO-WAY-STREAM-INPUT-STREAM)
-              (FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P XCL:ECHO-STREAM-INPUT-STREAM 
-                     XCL:ECHO-STREAM-OUTPUT-STREAM)
-              (FUNCTIONS CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM)
-              (FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS)
-              (FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING 
-                     CL:WITH-OPEN-FILE)
-              (FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM 
-                     CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN 
-                     \\ADJUSTABLE-STRING-STREAM-OUTCHARFN))
-        (COMS 
-              (* |;;| "helpers")

+                                (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT)
+                                (FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P 
+                                       CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P)
+                                (COMS (FUNCTIONS FILE-STREAM-POSITION)
+                                      (SETFS FILE-STREAM-POSITION))
+                                (FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P 
+                                       XCL:SYNONYM-STREAM-SYMBOL XCL:FOLLOW-SYNONYM-STREAMS)
+                                (FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P 
+                                       XCL:BROADCAST-STREAM-STREAMS)
+                                (FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P 
+                                       XCL:CONCATENATED-STREAM-STREAMS)
+                                (FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P 
+                                       XCL:TWO-WAY-STREAM-OUTPUT-STREAM 
+                                       XCL:TWO-WAY-STREAM-INPUT-STREAM)
+                                (FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P 
+                                       XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM)
+                                (FUNCTIONS CL:MAKE-STRING-INPUT-STREAM 
+                                       MAKE-CONCATENATED-STRING-INPUT-STREAM)
+                                (FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS)
+                                (FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING 
+                                       CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE)
+                                (FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM 
+                                       MAKE-FILL-POINTER-OUTPUT-STREAM CL:GET-OUTPUT-STREAM-STRING 
+                                       \\STRING-STREAM-OUTCHARFN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN
+                                       ))
+                          (COMS 
+                                (* |;;| "helpers")

 
-              (FUNCTIONS %NEW-FILE PREDICT-NAME)
-              (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS)))
-        (COMS 
-              (* |;;| "methods for the special devices")

+                                (FUNCTIONS %NEW-FILE PREDICT-NAME)
+                                (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS)))
+                          (COMS 
+                                (* |;;| "methods for the special devices")

 
-              (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN 
-                   %BROADCAST-STREAM-DEVICE-CLOSEFILE %BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
-              (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN)
-              (FNS %CONCATENATED-STREAM-DEVICE-BIN %CONCATENATED-STREAM-DEVICE-CLOSEFILE 
-                   %CONCATENATED-STREAM-DEVICE-EOFP %CONCATENATED-STREAM-DEVICE-PEEKBIN 
-                   %CONCATENATED-STREAM-DEVICE-BACKFILEPTR)
-              (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)
-              (FNS %ECHO-STREAM-DEVICE-BIN)
-              (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
-              (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT 
-                   %SYNONYM-STREAM-DEVICE-OUTCHARFN %SYNONYM-STREAM-DEVICE-CLOSEFILE 
-                   %SYNONYM-STREAM-DEVICE-EOFP %SYNONYM-STREAM-DEVICE-FORCEOUTPUT 
-                   %SYNONYM-STREAM-DEVICE-GETFILEINFO %SYNONYM-STREAM-DEVICE-PEEKBIN 
-                   %SYNONYM-STREAM-DEVICE-READP %SYNONYM-STREAM-DEVICE-BACKFILEPTR 
-                   %SYNONYM-STREAM-DEVICE-SETFILEINFO %SYNONYM-STREAM-DEVICE-CHARSETFN)
-              (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM 
-                   %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 
-                   %TWO-WAY-STREAM-DEVICE-OUTCHARFN %TWO-WAY-STREAM-DEVICE-CLOSEFILE 
-                   %TWO-WAY-STREAM-DEVICE-EOFP %TWO-WAY-STREAM-DEVICE-READP 
-                   %TWO-WAY-STREAM-DEVICE-BACKFILEPTR %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 
-                   %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)
-              (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE %FILL-POINTER-STREAM-DEVICE-GETFILEPTR
-                     )
-              (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE
-                     %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE))
-        (COMS 
-              (* |;;| "helper stuff")

+                                (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN
+                                     %BROADCAST-STREAM-DEVICE-CLOSEFILE 
+                                     %BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
+                                (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN)
+                                (FNS %CONCATENATED-STREAM-DEVICE-BIN 
+                                     %CONCATENATED-STREAM-DEVICE-CLOSEFILE 
+                                     %CONCATENATED-STREAM-DEVICE-EOFP 
+                                     %CONCATENATED-STREAM-DEVICE-PEEKBIN 
+                                     %CONCATENATED-STREAM-DEVICE-BACKFILEPTR)
+                                (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)
+                                (FNS %ECHO-STREAM-DEVICE-BIN)
+                                (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
+                                (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT 
+                                     %SYNONYM-STREAM-DEVICE-OUTCHARFN 
+                                     %SYNONYM-STREAM-DEVICE-CLOSEFILE %SYNONYM-STREAM-DEVICE-EOFP 
+                                     %SYNONYM-STREAM-DEVICE-FORCEOUTPUT 
+                                     %SYNONYM-STREAM-DEVICE-GETFILEINFO 
+                                     %SYNONYM-STREAM-DEVICE-PEEKBIN %SYNONYM-STREAM-DEVICE-READP 
+                                     %SYNONYM-STREAM-DEVICE-BACKFILEPTR 
+                                     %SYNONYM-STREAM-DEVICE-SETFILEINFO 
+                                     %SYNONYM-STREAM-DEVICE-CHARSETFN)
+                                (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM 
+                                     %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM
+                                     %TWO-WAY-STREAM-DEVICE-OUTCHARFN 
+                                     %TWO-WAY-STREAM-DEVICE-CLOSEFILE %TWO-WAY-STREAM-DEVICE-EOFP 
+                                     %TWO-WAY-STREAM-DEVICE-READP %TWO-WAY-STREAM-DEVICE-BACKFILEPTR
+                                     %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 
+                                     %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)
+                                (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE 
+                                       %FILL-POINTER-STREAM-DEVICE-GETFILEPTR)
+                                (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE 
+                                       %CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE 
+                                       %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE))
+                          (COMS 
+                                (* |;;| "helper stuff")

 
-              (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM))
-        (COMS 
-              (* |;;| "module initialization")

+                                (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM))
+                          (COMS 
+                                (* |;;| "module initialization")

 
-              (VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* *STANDARD-OUTPUT* 
-                     *STANDARD-INPUT*)
-              (FUNCTIONS %INITIALIZE-STANDARD-STREAMS)
-              (FNS %INITIALIZE-CLSTREAM-TYPES)
-              (DECLARE\: DONTEVAL@LOAD DOCOPY                (* \; "initialization")

-                     (P (%INITIALIZE-CLSTREAM-TYPES)
-                        (%INITIALIZE-STANDARD-STREAMS))))
-        (PROP FILETYPE CLSTREAMS)))
+                                (VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* 
+                                       *STANDARD-OUTPUT* *STANDARD-INPUT*)
+                                (FUNCTIONS %INITIALIZE-STANDARD-STREAMS)
+                                (FNS %INITIALIZE-CLSTREAM-TYPES)
+                                (DECLARE\: DONTEVAL@LOAD DOCOPY 
+                                                             (* \; "initialization")

+                                       (P (%INITIALIZE-CLSTREAM-TYPES)
+                                          (%INITIALIZE-STANDARD-STREAMS))))
+                          (PROP FILETYPE CLSTREAMS)))
 
 
 
@@ -107,7 +116,7 @@
                           (IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P)
                           (EXTERNAL-FORMAT :DEFAULT))
 
-(* |;;;| "Return a stream which reads from or writes to Filename.  Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS).  The specification of :external-format is based on the JEIDA proposal.  See the manual for details.")

+(* |;;;| "Return a stream which reads from or writes to Filename.  Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS).  The specification of :external-format is based on the JEIDA proposal.  See the manual for details.")

 
    (CL:UNLESS (MEMQ DIRECTION '(:INPUT :OUTPUT :IO :PROBE))
           (CL:ERROR "~S isn't a valid direction for open." DIRECTION))
@@ -133,14 +142,14 @@
                   ELSE
 'TEXT))
      (STREAM NIL))
 
-(* |;;;| "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.")

+(* |;;;| "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.")

 
     (CL:UNLESS EXISTS-P
         (SETQ IF-EXISTS (CL:IF (EQ (CL:PATHNAME-VERSION PATHNAME)
                                    :NEWEST)
                             :NEW-VERSION
-                            :ERROR)))                        (* \; 
-
                            "If the file does not exist, it is OK to have :if-exists :overwrite.  ")

+                            :ERROR)))                        (* \; 
+
                            "If the file does not exist, it is OK to have :if-exists :overwrite.  ")

     (CL:UNLESS DOES-NOT-EXIST-P
         (SETQ IF-DOES-NOT-EXIST (COND
                                    ((OR (EQ IF-EXISTS :APPEND)
@@ -149,16 +158,16 @@
                                    ((EQ DIRECTION :PROBE)
                                     NIL)
                                    (T :CREATE))))
-    (CL:LOOP                                                 (* \; 
-
                                      "See if the file exists and handle the existential keywords.")

+    (CL:LOOP                                                 (* \; 
+
                                      "See if the file exists and handle the existential keywords.")

      (LET* ((NAME (PREDICT-NAME
 PATHNAME))
             (CL:NAMESTRING (MKSTRING NAME)))
            (IF
 NAME
-               THEN
                                      (* \; "file exists")

+               THEN
                                      (* \; "file exists")

                      (IF
 FOR-OUTPUT
                          THEN
 
 
-                               (* |;;| "open for output/both")

+                               (* |;;| "open for output/both")

 
                                (CASE IF-EXISTS
                                    (:ERROR 
@@ -180,15 +189,15 @@
                                       (RETURN NIL))
                                    (:APPEND 
                                       (IF
 (EQ DIRECTION :OUTPUT)
-                                          THEN
           (* \; 
-
                                    "if the direction is output it is the same as interlisp append")

+                                          THEN
           (* \; 
+
                                    "if the direction is output it is the same as interlisp append")

                                                 (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'APPEND
                                                                     'OLD
                                                                     `((TYPE ,FILE-TYPE)
                                                                       (EXTERNALFORMAT 
                                                                              ,EXTERNAL-FORMAT))))
-                                        ELSE
             (* \; 
-
                    "if direction is io it opens the file for both and goes to the end of the file")

+                                        ELSE
             (* \; 
+
                    "if direction is io it opens the file for both and goes to the end of the file")

                                               (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH
                                                                   'OLD
                                                                   `((TYPE ,FILE-TYPE)
@@ -201,7 +210,7 @@
                        |elseif|
 FOR-INPUT
                          |then|
 
 
-                               (* |;;| "open for input/both")

+                               (* |;;| "open for input/both")

 
                                (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD
                                                    `((TYPE ,FILE-TYPE)
@@ -209,14 +218,14 @@
                                (RETURN NIL)
                        |else|
 
 
-                             (* |;;| "open for probe")

+                             (* |;;| "open for probe")

 
                              (SETQ STREAM (|create|
 STREAM
                                                  FULLFILENAME _ (FULLNAME CL:NAMESTRING)))
                              (RETURN NIL))
              |else|
 
 
-                   (* |;;| "file does not exist")

+                   (* |;;| "file does not exist")

 
                    (|if|
 FOR-OUTPUT
                        |then|
 (CASE IF-DOES-NOT-EXIST
@@ -244,28 +253,28 @@
                                       ((NIL) (CL:RETURN-FROM OPEN NIL))
                                       (T (CL:ERROR "~S is not a valid value for :if-does-not-exist."
                                                 IF-DOES-NOT-EXIST)))
-                     |else|
                              (* \; "Open for probe.")

+                     |else|
                              (* \; "Open for probe.")

                            (RETURN NIL)))))
     (STREAMPROP STREAM :FILE-STREAM-P T)
     STREAM))
 
 (CL:DEFUN CL:CLOSE
 (STREAM &KEY ABORT)
 
-(* |;;;| "Close a stream.  If ABORT, then don't keep the file")

+(* |;;;| "Close a stream.  If ABORT, then don't keep the file")

 
    (|if|
 (STREAMP STREAM)
        |then|
 (|if|
 (OPENP STREAM)
                       |then|
 
 
-                            (* |;;| 
-
               "determine 'deletability' of stream's file before closing, as that trashes the info")

+                            (* |;;| 
+
               "determine 'deletability' of stream's file before closing, as that trashes the info")

 
                             (LET ((ABORTABLE (AND (DIRTYABLE STREAM)
                                                   (NOT (APPENDONLY STREAM)))))
                                  (CLOSEF STREAM)
                                  (|if|
 (AND ABORT ABORTABLE)
-                                     |then|
              (* \; 
-
     "eventually we will change device CLOSEF methods to take an ABORT arg.  For now, simulate it.")

+                                     |then|
              (* \; 
+
     "eventually we will change device CLOSEF methods to take an ABORT arg.  For now, simulate it.")

                                            (DELFILE (CL:NAMESTRING STREAM)))))
      |else|
 (ERROR "Closing a non-stream" STREAM))
    T)
@@ -280,7 +289,7 @@
    (CL:WHEN (NOT (STREAMP STREAM))
           (\\ILLEGAL.ARG STREAM))
 
-   (* |;;| "we return T instead of the stream because Symbolics does")

+   (* |;;| "we return T instead of the stream because Symbolics does")

 
    (AND (\\IOMODEP STREAM 'INPUT T)
         T))
@@ -289,14 +298,14 @@
    (CL:WHEN (NOT (STREAMP STREAM))
           (\\ILLEGAL.ARG STREAM))
 
-   (* |;;| "we return T instead of the stream because Symbolics does")

+   (* |;;| "we return T instead of the stream because Symbolics does")

 
    (AND (\\IOMODEP STREAM 'OUTPUT T)
         T))
 
 (CL:DEFUN XCL:OPEN-STREAM-P
 (STREAM)
 
-   (* |;;| "is stream an open stream?")

+   (* |;;| "is stream an open stream?")

 
    (AND (STREAMP STREAM)
         (OPENED STREAM)))
@@ -308,7 +317,7 @@
 
 (CL:DEFUN CL:MAKE-SYNONYM-STREAM
 (CL:SYMBOL)
 
-   (* |;;| "A CommonLisp function for shadowing a stream.  See CLtL p.  329")

+   (* |;;| "A CommonLisp function for shadowing a stream.  See CLtL p.  329")

 
    (LET ((STREAM (|create|
 STREAM
                         DEVICE _ %SYNONYM-STREAM-DEVICE
@@ -319,7 +328,7 @@
                         OUTCHARFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-OUTCHARFN))))
         (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P T)
 
-        (* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE")

+        (* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE")

 
         (|replace|
 (FDEV OPENFILELST) |of|
 %SYNONYM-STREAM-DEVICE
            |with|
 (CONS STREAM (|fetch|
 (FDEV OPENFILELST) |of|
 %SYNONYM-STREAM-DEVICE)))
@@ -334,7 +343,7 @@
 
 (CL:DEFUN XCL:FOLLOW-SYNONYM-STREAMS
 (STREAM)
 
-(* |;;;| "Return the non-synonym stream at the heart of STREAM.")

+(* |;;;| "Return the non-synonym stream at the heart of STREAM.")

 
    (CL:IF (XCL:SYNONYM-STREAM-P
 STREAM)
        (XCL:FOLLOW-SYNONYM-STREAMS
 (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL
 STREAM)))
@@ -342,7 +351,7 @@
 
 (CL:DEFUN CL:MAKE-BROADCAST-STREAM
 (&REST STREAMS)
 
-   (* |;;| "CommonLisp function that makes a broadcast stream.  See CLtL p329")

+   (* |;;| "CommonLisp function that makes a broadcast stream.  See CLtL p329")

 
    (IF
 (FOR
 STREAM? IN
 STREAMS ALWAYS
 (STREAMP STREAM?))
        THEN
 (LET ((STREAM (|create|
 STREAM
@@ -357,20 +366,20 @@
 
 (CL:DEFUN XCL:BROADCAST-STREAM-P
 (STREAM)
 
-   (* |;;| "is stream a broadcast stream?")

+   (* |;;| "is stream a broadcast stream?")

 
    (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P))
 
 (CL:DEFUN XCL:BROADCAST-STREAM-STREAMS
 (STREAM)
 
-   (* |;;| "return all of the streams that STREAM broadcasts to")

+   (* |;;| "return all of the streams that STREAM broadcasts to")

 
    (AND (XCL:BROADCAST-STREAM-P
 STREAM)
         (FETCH
 (STREAM F1) OF
 STREAM)))
 
 (CL:DEFUN CL:MAKE-CONCATENATED-STREAM
 (&REST STREAMS)
 
-   (* |;;| "CommonLisp function that creates a  concatenated stream.  See CLtL p.  329")

+   (* |;;| "CommonLisp function that creates a  concatenated stream.  See CLtL p.  329")

 
    (IF
 (FOR
 STREAM? IN
 STREAMS ALWAYS
 (STREAMP STREAM?))
        THEN
 (LET ((STREAM (|create|
 STREAM
@@ -387,14 +396,14 @@
 
 (CL:DEFUN XCL:CONCATENATED-STREAM-STREAMS
 (STREAM)
 
-   (* |;;| "return all of STREAM's concatenated streams")

+   (* |;;| "return all of STREAM's concatenated streams")

 
    (AND (XCL:CONCATENATED-STREAM-P
 STREAM)
         (FETCH
 (STREAM F1) OF
 STREAM)))
 
 (CL:DEFUN CL:MAKE-TWO-WAY-STREAM
 (CL::INPUT-STREAM CL::OUTPUT-STREAM)
 
-   (* |;;| "A CommonLisp function for splicing together two streams.  See CLtL p.  329")

+   (* |;;| "A CommonLisp function for splicing together two streams.  See CLtL p.  329")

 
    (CL:UNLESS (STREAMP CL::INPUT-STREAM)
           (\\ILLEGAL.ARG CL::INPUT-STREAM))
@@ -409,7 +418,7 @@
                         OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN))))
         (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P T)
 
-        (* |;;| "save STREAM  in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE")

+        (* |;;| "save STREAM  in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE")

 
         (|replace|
 (FDEV OPENFILELST) |of|
 %TWO-WAY-STREAM-DEVICE
            |with|
 (CONS STREAM (|fetch|
 (FDEV OPENFILELST) |of|
 %TWO-WAY-STREAM-DEVICE)))
@@ -417,7 +426,7 @@
 
 (CL:DEFUN XCL:TWO-WAY-STREAM-P
 (STREAM)
 
-   (* |;;| "is STREAM a two-way stream?")

+   (* |;;| "is STREAM a two-way stream?")

 
    (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P))
 
@@ -431,7 +440,7 @@
 
 (CL:DEFUN CL:MAKE-ECHO-STREAM
 (CL::INPUT-STREAM CL::OUTPUT-STREAM)
 
-   (* |;;| "A CommonLisp function for making an echo  stream.  See CLtL p.  329")

+   (* |;;| "A CommonLisp function for making an echo  stream.  See CLtL p.  329")

 
    (CL:UNLESS (STREAMP CL::INPUT-STREAM)
           (\\ILLEGAL.ARG CL::INPUT-STREAM))
@@ -446,7 +455,7 @@
                         OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN))))
         (STREAMPROP STREAM 'XCL:ECHO-STREAM-P T)
 
-        (* |;;| "save STREAM  in the OPENFILELST field of %ECHO-STREAM-DEVICE")

+        (* |;;| "save STREAM  in the OPENFILELST field of %ECHO-STREAM-DEVICE")

 
         (|replace|
 (FDEV OPENFILELST) |of|
 %ECHO-STREAM-DEVICE
            |with|
 (CONS STREAM (|fetch|
 (FDEV OPENFILELST) |of|
 %ECHO-STREAM-DEVICE)))
@@ -454,7 +463,7 @@
 
 (CL:DEFUN XCL:ECHO-STREAM-P
 (STREAM)
 
-   (* |;;| "is stream an echo stream?")

+   (* |;;| "is stream an echo stream?")

 
    (STREAMPROP STREAM 'XCL:ECHO-STREAM-P))
 
@@ -469,13 +478,13 @@
 (CL:DEFUN CL:MAKE-STRING-INPUT-STREAM
 (STRING &OPTIONAL (CL::START 0)
                                                  (CL::END NIL))
 
-(* |;;;| "A CommonLisp function for producing a stream from a string.  See CLtL p.  330")

+(* |;;;| "A CommonLisp function for producing a stream from a string.  See CLtL p.  330")

 
    (OPENSTRINGSTREAM (|if|
 (OR (NOT (CL:ZEROP CL::START))
                                    (NOT (NULL CL::END)))
                          |then|
 
 
-                               (* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ")

+                               (* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ")

 
                                (SUBSTRING STRING (CL:1+ CL::START)
                                       CL::END)
@@ -522,11 +531,11 @@
                  ,@CL::DECLS
                  ,@(CL:IF CL::INDEXP
 
-                       (* |;;| "This exists as a fudge for the fat string problem.  It WILL GO AWAY when STRINGSTREAMS HAVE THEIR OWN DEVICE.")

+                       (* |;;| "This exists as a fudge for the fat string problem.  It WILL GO AWAY when STRINGSTREAMS HAVE THEIR OWN DEVICE.")

 
                        `((CL:MULTIPLE-VALUE-PROG1 (PROGN ,@CL::BODY)
 
-                                (* |;;| "(IF (FASL::FAT-STRING-P $STRING$) (SETF ,INDEX (+ $START$ (IL:IQUOTIENT (IL:GETFILEPTR ,VAR) 2))) (SETF ,INDEX (+ $START$ (IL:GETFILEPTR ,VAR))))")

+                                (* |;;| "(IF (FASL::FAT-STRING-P $STRING$) (SETF ,INDEX (+ $START$ (IL:IQUOTIENT (IL:GETFILEPTR ,VAR) 2))) (SETF ,INDEX (+ $START$ (IL:GETFILEPTR ,VAR))))")

 
                                 (CL:SETF ,CL::INDEX (+ CL::$START$ (GETFILEPTR ,CL::VAR)))))
                        CL::BODY))))
@@ -546,7 +555,7 @@
                                  &BODY
                                  (FORMS DECLS))
 
-(* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.")

+(* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.")

 
    (LET ((ABORTP (GENSYM)))
         `(LET ((,VAR (OPEN
 ,@OPEN-ARGS))
@@ -559,7 +568,7 @@
 
 (DEFINLINE CL:MAKE-STRING-OUTPUT-STREAM
 ()
 
-(* |;;;| "A function for producing a string stream. See also the function get-output-stream-string.  Also, see CLtL p.  330")

+(* |;;;| "A function for producing a string stream. See also the function get-output-stream-string.  Also, see CLtL p.  330")

 
    (MAKE-FILL-POINTER-OUTPUT-STREAM
))
 
@@ -574,8 +583,8 @@
                                      F1 _ STRING
                                      ACCESS _ 'OUTPUT
                                      OTHERPROPS _ '(STRING-OUTPUT-STREAM T))))
-                                                             (* \; 
-
                                             "give it a canned property list to save some consing.")

+                                                             (* \; 
+
                                             "give it a canned property list to save some consing.")

                      (|replace|
 (STREAM OUTCHARFN) |of|
 STREAM
                         |with|
 (|if|
 (EXTENDABLE-ARRAY-P STRING)
                                        |then|
 (FUNCTION \\ADJUSTABLE-STRING-STREAM-OUTCHARFN)
@@ -586,7 +595,7 @@
 
 (CL:DEFUN CL:GET-OUTPUT-STREAM-STRING
 (STRING-OUTPUT-STREAM)
 
-(* |;;;| "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream.  See CLtL p.  330")

+(* |;;;| "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream.  See CLtL p.  330")

 
    (|if|
 (NOT (STREAMPROP STRING-OUTPUT-STREAM 'STRING-OUTPUT-STREAM))
        |then|
 (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM)
@@ -615,7 +624,7 @@
           ELSE
 (ADD
 (FETCH
 (STREAM CHARPOSITION) OF
 STREAM)
                           1))
 
-        (* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.")

+        (* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.")

 
         (CL:UNLESS (CL:VECTOR-PUSH CH STRING)
             (LET ((CURRENT-LENGTH (CL:ARRAY-TOTAL-SIZE STRING)))
@@ -680,7 +689,7 @@
 
 (CL:DEFUN %BROADCAST-STREAM-DEVICE-CHARSETFN
 (STREAM NEWVALUE)
 
-   (* |;;| "charset function for broadcast streams.  Not clear what the value should be, so we arbitrarily return the value of the last stream.")

+   (* |;;| "charset function for broadcast streams.  Not clear what the value should be, so we arbitrarily return the value of the last stream.")

 
    (FOR
 S IN
 (FETCH
 (STREAM F1) OF
 STREAM) DO
 (SETQ $$VAL (ACCESS-CHARSET S 
                                                                                      NEWVALUE))))
@@ -709,7 +718,7 @@
 
 (CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN
 (STREAM NEWVALUE)
 
-   (* |;;| "the charset method for concatenated stream devices")

+   (* |;;| "the charset method for concatenated stream devices")

 
    (LET ((STREAMS (FETCH
 (STREAM F1) OF
 STREAM)))
         (IF
 STREAMS
@@ -725,7 +734,7 @@
 
 (CL:DEFUN %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM
 (SYNONYM-STREAM)
 
-   (* |;;| "given a synonym-stream, find out what it is currently tracking")

+   (* |;;| "given a synonym-stream, find out what it is currently tracking")

 
    (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL
 SYNONYM-STREAM)))
 (DEFINEQ
@@ -880,7 +889,7 @@
 
 (CL:DEFUN %FILL-POINTER-STREAM-DEVICE-CLOSEFILE
 (STREAM &OPTIONAL ABORTFLAG)
 
-(* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device")

+(* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device")

 
    (|replace|
 F1 |of|
 STREAM |with|
 NIL)
    STREAM)
@@ -923,8 +932,8 @@
 
 (CL:DEFUN %INITIALIZE-STANDARD-STREAMS
 ()
 
-   (* |;;| 
-
 "Called when CLSTREAMS is loaded.  Almost everything is same as *TERMINAL-IO* to start with.")

+   (* |;;| 
+
 "Called when CLSTREAMS is loaded.  Almost everything is same as *TERMINAL-IO* to start with.")

 
    (CL:SETQ *QUERY-IO* (CL:MAKE-TWO-WAY-STREAM
 (CL:MAKE-SYNONYM-STREAM
 '\\LINEBUF.OFD)
                               (CL:MAKE-SYNONYM-STREAM
 '\\TERM.OFD)))
@@ -944,51 +953,27 @@
 (%INITIALIZE-STANDARD-STREAMS
)
 )
 
-(PUTPROPS CLSTREAMS
 FILETYPE
 CL:COMPILE-FILE)
-(PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 2021))
+(PUTPROPS CLSTREAMS FILETYPE
 CL:COMPILE-FILE)
+(PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (5231 14534 (OPEN 5231 . 14534)) (14536 15482 (CL:CLOSE 14536 . 15482)) (15484 15562 (
-CL:STREAM-EXTERNAL-FORMAT 15484 . 15562)) (15564 15631 (CL:STREAM-ELEMENT-TYPE 15564 . 15631)) (15633 
-15867 (CL:INPUT-STREAM-P 15633 . 15867)) (15869 16105 (CL:OUTPUT-STREAM-P 15869 . 16105)) (16107 16244
- (XCL:OPEN-STREAM-P 16107 . 16244)) (16246 16313 (FILE-STREAM-POSITION 16246 . 16313)) (16365 17285 (
-CL:MAKE-SYNONYM-STREAM 16365 . 17285)) (17287 17376 (XCL:SYNONYM-STREAM-P 17287 . 17376)) (17378 17516
- (XCL:SYNONYM-STREAM-SYMBOL 17378 . 17516)) (17518 17796 (XCL:FOLLOW-SYNONYM-STREAMS 17518 . 17796)) (
-17798 18585 (CL:MAKE-BROADCAST-STREAM 17798 . 18585)) (18587 18730 (XCL:BROADCAST-STREAM-P 18587 . 
-18730)) (18732 18947 (XCL:BROADCAST-STREAM-STREAMS 18732 . 18947)) (18949 19658 (
-CL:MAKE-CONCATENATED-STREAM 18949 . 19658)) (19660 19759 (XCL:CONCATENATED-STREAM-P 19660 . 19759)) (
-19761 19974 (XCL:CONCATENATED-STREAM-STREAMS 19761 . 19974)) (19976 21057 (CL:MAKE-TWO-WAY-STREAM 
-19976 . 21057)) (21059 21196 (XCL:TWO-WAY-STREAM-P 21059 . 21196)) (21198 21343 (
-XCL:TWO-WAY-STREAM-OUTPUT-STREAM 21198 . 21343)) (21345 21489 (XCL:TWO-WAY-STREAM-INPUT-STREAM 21345
- . 21489)) (21491 22547 (CL:MAKE-ECHO-STREAM 21491 . 22547)) (22549 22678 (XCL:ECHO-STREAM-P 22549 . 
-22678)) (22680 22818 (XCL:ECHO-STREAM-INPUT-STREAM 22680 . 22818)) (22820 22959 (
-XCL:ECHO-STREAM-OUTPUT-STREAM 22820 . 22959)) (22961 23696 (CL:MAKE-STRING-INPUT-STREAM 22961 . 23696)
-) (23698 24147 (MAKE-CONCATENATED-STRING-INPUT-STREAM 23698 . 24147)) (24149 24309 (
-%MAKE-INITIAL-STRING-STREAM-CONTENTS 24149 . 24309)) (27401 28823 (MAKE-FILL-POINTER-OUTPUT-STREAM 
-27401 . 28823)) (28825 29564 (CL:GET-OUTPUT-STREAM-STRING 28825 . 29564)) (29566 30059 (
-\\STRING-STREAM-OUTCHARFN 29566 . 30059)) (30061 31951 (\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 30061 . 
-31951)) (31980 32062 (%NEW-FILE 31980 . 32062)) (32064 32209 (PREDICT-NAME 32064 . 32209)) (32450 
-33638 (%BROADCAST-STREAM-DEVICE-BOUT 32460 . 32683) (%BROADCAST-STREAM-DEVICE-OUTCHARFN 32685 . 33136)
- (%BROADCAST-STREAM-DEVICE-CLOSEFILE 33138 . 33377) (%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 33379 . 
-33636)) (33640 34053 (%BROADCAST-STREAM-DEVICE-CHARSETFN 33640 . 34053)) (34054 36113 (
-%CONCATENATED-STREAM-DEVICE-BIN 34064 . 34469) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 34471 . 34784) (
-%CONCATENATED-STREAM-DEVICE-EOFP 34786 . 35150) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 35152 . 35627) (
-%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 35629 . 36111)) (36115 36450 (
-%CONCATENATED-STREAM-DEVICE-CHARSETFN 36115 . 36450)) (36451 36670 (%ECHO-STREAM-DEVICE-BIN 36461 . 
-36668)) (36672 36897 (%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 36672 . 36897)) (36898 40243 (
-%SYNONYM-STREAM-DEVICE-BIN 36908 . 37096) (%SYNONYM-STREAM-DEVICE-BOUT 37098 . 37299) (
-%SYNONYM-STREAM-DEVICE-OUTCHARFN 37301 . 38008) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 38010 . 38594) (
-%SYNONYM-STREAM-DEVICE-EOFP 38596 . 38787) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 38789 . 39027) (
-%SYNONYM-STREAM-DEVICE-GETFILEINFO 39029 . 39266) (%SYNONYM-STREAM-DEVICE-PEEKBIN 39268 . 39491) (
-%SYNONYM-STREAM-DEVICE-READP 39493 . 39604) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 39606 . 39752) (
-%SYNONYM-STREAM-DEVICE-SETFILEINFO 39754 . 40003) (%SYNONYM-STREAM-DEVICE-CHARSETFN 40005 . 40241)) (
-40244 44569 (%TWO-WAY-STREAM-DEVICE-BIN 40254 . 40427) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 40429 . 
-40620) (%TWO-WAY-STREAM-DEVICE-BOUT 40622 . 40794) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 40796 . 40986)
- (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 40988 . 41850) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 41852 . 43275) (
-%TWO-WAY-STREAM-DEVICE-EOFP 43277 . 43453) (%TWO-WAY-STREAM-DEVICE-READP 43455 . 43648) (
-%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 43650 . 43786) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 43788 . 44017) (
-%TWO-WAY-STREAM-DEVICE-PEEKBIN 44019 . 44232) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 44234 . 44567)) (44571
- 44796 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE 44571 . 44796)) (44798 44917 (
-%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 44798 . 44917)) (45157 45396 (%SYNONYM-STREAM-DEVICE-GET-STREAM
- 45167 . 45394)) (45627 46101 (%INITIALIZE-STANDARD-STREAMS 45627 . 46101)) (46102 52065 (
-%INITIALIZE-CLSTREAM-TYPES 46112 . 52063)))))
+  (FILEMAP (NIL (34128 35316 (%BROADCAST-STREAM-DEVICE-BOUT 34138 . 34361) (
+%BROADCAST-STREAM-DEVICE-OUTCHARFN 34363 . 34814) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34816 . 35055) (
+%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 35057 . 35314)) (35732 37791 (%CONCATENATED-STREAM-DEVICE-BIN 
+35742 . 36147) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36149 . 36462) (%CONCATENATED-STREAM-DEVICE-EOFP
+ 36464 . 36828) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36830 . 37305) (
+%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 37307 . 37789)) (38129 38348 (%ECHO-STREAM-DEVICE-BIN 38139 . 
+38346)) (38576 41921 (%SYNONYM-STREAM-DEVICE-BIN 38586 . 38774) (%SYNONYM-STREAM-DEVICE-BOUT 38776 . 
+38977) (%SYNONYM-STREAM-DEVICE-OUTCHARFN 38979 . 39686) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 39688 . 
+40272) (%SYNONYM-STREAM-DEVICE-EOFP 40274 . 40465) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 40467 . 40705) 
+(%SYNONYM-STREAM-DEVICE-GETFILEINFO 40707 . 40944) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40946 . 41169) (
+%SYNONYM-STREAM-DEVICE-READP 41171 . 41282) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 41284 . 41430) (
+%SYNONYM-STREAM-DEVICE-SETFILEINFO 41432 . 41681) (%SYNONYM-STREAM-DEVICE-CHARSETFN 41683 . 41919)) (
+41922 46247 (%TWO-WAY-STREAM-DEVICE-BIN 41932 . 42105) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 42107 . 
+42298) (%TWO-WAY-STREAM-DEVICE-BOUT 42300 . 42472) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 42474 . 42664)
+ (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 42666 . 43528) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 43530 . 44953) (
+%TWO-WAY-STREAM-DEVICE-EOFP 44955 . 45131) (%TWO-WAY-STREAM-DEVICE-READP 45133 . 45326) (
+%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 45328 . 45464) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 45466 . 45695) (
+%TWO-WAY-STREAM-DEVICE-PEEKBIN 45697 . 45910) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45912 . 46245)) (46835
+ 47074 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46845 . 47072)) (47780 53743 (%INITIALIZE-CLSTREAM-TYPES 
+47790 . 53741)))))
 STOP

sources/COREIO

@@ -1,15 +1,14 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-Sep-2021 08:25:40" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COREIO.;2
 55065  
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED " 4-Oct-2018 14:13:06" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.;4
 55097  
 
-      changes to%:  (FNS \CREATECOREDEVICE)
+      changes to%:  (FNS \CORE.GETFILEINFO)
 
-      previous date%: " 4-Oct-2018 14:13:06" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COREIO.;1)
+      previous date%: "28-Jun-99 16:15:28" 
+{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.;3)
 
 
 (* ; "
-Copyright (c) 1981-1988, 1990, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
+Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.  All rights reserved.
 ")
 
 (PRETTYCOMPRINT COREIOCOMS)
@@ -953,18 +952,18 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018, 2021 by Venue & Xerox Corporati
 )
 )
 (PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
-1993 1999 2018 2021))
+1993 1999 2018))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1718 43242 (\CORE.CLOSEFILE 1728 . 2501) (\CORE.DELETEFILE 2503 . 4489) (
-\CORE.DIRECTORYNAMEP 4491 . 4752) (\CORE.FINDPAGE 4754 . 7983) (\CORE.GENERATEFILES 7985 . 10572) (
-\CORE.NEXTFILEFN 10574 . 11073) (\CORE.FILEINFOFN 11075 . 11304) (\CORE.GETFILEHANDLE 11306 . 13460) (
-\CORE.GETFILEINFO 13462 . 14425) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14427 . 15964) (\CORE.GETFILENAME 
-15966 . 18255) (\CORE.GETINFOBLOCK 18257 . 20880) (\CORE.NAMESCAN 20882 . 22649) (\CORE.NAMESEGMENT 
-22651 . 23088) (\CORE.OPENFILE 23090 . 26209) (\COREFILE.SETPARAMETERS 26211 . 28392) (
-\CORE.PACKFILENAME 28394 . 28789) (\CORE.RELEASEPAGES 28791 . 29392) (\CORE.SETFILEPTR 29394 . 30493) 
-(\CORE.UPDATEOF 30495 . 32124) (\CORE.BACKFILEPTR 32126 . 34334) (\CORE.SETEOFPTR 34336 . 36205) (
-\CORE.SETACCESSTIME 36207 . 36832) (\CORE.SETFILEINFO 36834 . 38025) (\CORE.GETNEXTBUFFER 38027 . 
-41983) (\CORE.UNPACKFILENAME 41985 . 43240)) (43243 46876 (COREDEVICE 43253 . 43424) (
-\CREATECOREDEVICE 43426 . 46874)) (46877 49178 (\NODIRCOREFDEV 46887 . 47484) (\NODIRCORE.OPENFILE 
-47486 . 49176)))))
+  (FILEMAP (NIL (1755 43279 (\CORE.CLOSEFILE 1765 . 2538) (\CORE.DELETEFILE 2540 . 4526) (
+\CORE.DIRECTORYNAMEP 4528 . 4789) (\CORE.FINDPAGE 4791 . 8020) (\CORE.GENERATEFILES 8022 . 10609) (
+\CORE.NEXTFILEFN 10611 . 11110) (\CORE.FILEINFOFN 11112 . 11341) (\CORE.GETFILEHANDLE 11343 . 13497) (
+\CORE.GETFILEINFO 13499 . 14462) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14464 . 16001) (\CORE.GETFILENAME 
+16003 . 18292) (\CORE.GETINFOBLOCK 18294 . 20917) (\CORE.NAMESCAN 20919 . 22686) (\CORE.NAMESEGMENT 
+22688 . 23125) (\CORE.OPENFILE 23127 . 26246) (\COREFILE.SETPARAMETERS 26248 . 28429) (
+\CORE.PACKFILENAME 28431 . 28826) (\CORE.RELEASEPAGES 28828 . 29429) (\CORE.SETFILEPTR 29431 . 30530) 
+(\CORE.UPDATEOF 30532 . 32161) (\CORE.BACKFILEPTR 32163 . 34371) (\CORE.SETEOFPTR 34373 . 36242) (
+\CORE.SETACCESSTIME 36244 . 36869) (\CORE.SETFILEINFO 36871 . 38062) (\CORE.GETNEXTBUFFER 38064 . 
+42020) (\CORE.UNPACKFILENAME 42022 . 43277)) (43280 46913 (COREDEVICE 43290 . 43461) (
+\CREATECOREDEVICE 43463 . 46911)) (46914 49215 (\NODIRCOREFDEV 46924 . 47521) (\NODIRCORE.OPENFILE 
+47523 . 49213)))))
 STOP

sources/DEBUGGER

@@ -1,14 +1,14 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES 
-"DBG")))
-
(IL:FILECREATED "16-Aug-91 17:38:56" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;3|
 84381  
+(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES "DBG")) READTABLE 
+"XCL" BASE 10)
+
(IL:FILECREATED "12-Sep-2021 15:59:37" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2|
 84797  
 
-      IL:|changes| IL:|to:|  (IL:FUNCTIONS DEBUGGER-EVAL)
+      IL:|changes| IL:|to:|  (IL:FUNCTIONS STACK-FRAME-PROPERTIES)
 
-      IL:|previous| IL:|date:| "16-May-90 15:26:02" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;2|
+      IL:|previous| IL:|date:| "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
 )
 
 
-; Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1986-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
 
 (IL:PRETTYCOMPRINT IL:DEBUGGERCOMS)
 
@@ -520,14 +520,13 @@
 
 (DEFVAR IL:LASTPOS
)
 
-(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) 
+(XCL:DEFCOMMAND ("@"
 :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
    "Set debugger stack pointer to location specified by PLACE (or default)"
    (FORMAT T "@ = ~S~%" (IL:STKNAME (FIND-DEBUGGER-STACK-FRAME
 IL:PLACE IL:ENV)))
    (VALUES))
 
-(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) (DECLARE
 (SPECIAL
-                                                                                        IL:BRKVALUES)
-                                                                                 )
+(XCL:DEFCOMMAND ("REVERT"
 :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
+   (DECLARE
 (SPECIAL IL:BRKVALUES))
    "Unwind to specified frame (or LASTPOS) and enter breakpoint"
 
    (IL:* IL:|;;| "Find the stack frame that the user asked to unwind to , if any:")

@@ -561,7 +560,8 @@
                                          (IL:RELSTK IL:POS))))))))
     (THROW 'DEBUGGER-EXIT NIL)))
 
-(XCL:DEFCOMMAND ("?=" :DEBUGGER) NIL "Show arguments"
+(XCL:DEFCOMMAND ("?="
 :DEBUGGER) ()
+   "Show arguments"
    (MULTIPLE-VALUE-BIND (IL:NAME IL:DEFN)
           (FIND-ORIGINAL-NAME-AND-DEFINITION
 IL:LASTPOS)
           (MULTIPLE-VALUE-BIND (IL:LAMBDA-CAR IL:ARGLIST)
@@ -589,7 +589,7 @@
                                            0 T))))))
    (VALUES))
 
-(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?)) 
+(XCL:DEFCOMMAND ("EVAL"
 :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
    (DECLARE
 (SPECIAL IL:BRKENV IL:BRKVALUES))
    "Evaluate expression in debugged context"
    (XCL:CONDITION-CASE (IF IL:EXPRESSION-PROVIDED?
@@ -600,14 +600,15 @@
           (SI::DEBUGGER-EVAL-ABORTED (IL:C)
                  (VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
 
-(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) NIL 
+(XCL:DEFCOMMAND ("VALUE"
 :DEBUGGER :QUIET) ()
    "Show value from previous evaluation of debug expression"
    (IF IL:BRKVALUES
        (VALUES-LIST (CDR IL:BRKVALUES))
        (PROGN (FORMAT T "Not yet evaluated~&")
               (VALUES))))
 
-(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN)) "Unbreak function with breakpoint"
+(XCL:DEFCOMMAND ("UB"
 :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN))
+   "Unbreak function with breakpoint"
    (DECLARE
 (SPECIAL IL:BRKFN))
    (IL:EVAL (LIST 'XCL:UNBREAK IL:FN)))
 
@@ -882,26 +883,32 @@
               (return
 nil))))
 )
 
-(XCL:DEFCOMMAND ("BT" :DEBUGGER) NIL "Print backtrace of external frames"
+(XCL:DEFCOMMAND ("BT"
 :DEBUGGER) ()
+   "Print backtrace of external frames"
    (PRINT-BACKTRACE
 :FROM IL:LASTPOS :TEST 'XCL::INTERESTING-FRAME-P)
    (VALUES))
 
-(XCL:DEFCOMMAND ("BT!" :DEBUGGER) NIL "Print backtrace of all frames"
+(XCL:DEFCOMMAND ("BT!"
 :DEBUGGER) ()
+   "Print backtrace of all frames"
    (PRINT-BACKTRACE
 :FROM IL:LASTPOS :TEST NIL)
    (VALUES))
 
-(XCL:DEFCOMMAND ("BTV" :DEBUGGER) NIL "Print backtrace of frames and special bindings"
+(XCL:DEFCOMMAND ("BTV"
 :DEBUGGER) ()
+   "Print backtrace of frames and special bindings"
    (PRINT-BACKTRACE
 :FROM IL:LASTPOS :PRINT-VARIABLES T)
    (VALUES))
 
-(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) NIL "Print backtrace of all frame information"
+(XCL:DEFCOMMAND ("BTV!"
 :DEBUGGER) ()
+   "Print backtrace of all frame information"
    (PRINT-BACKTRACE
 :FROM IL:LASTPOS :PRINT-VARIABLES T :PRINT-JUNK T)
    (VALUES))
 
-(XCL:DEFCOMMAND ("DBT" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU
 NIL T)
+(XCL:DEFCOMMAND ("DBT"
 :DEBUGGER) ()
+   (ATTACH-BACKTRACE-MENU
 NIL T)
    (VALUES))
 
-(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU
)
+(XCL:DEFCOMMAND ("DBT!"
 :DEBUGGER) ()
+   (ATTACH-BACKTRACE-MENU
)
    (VALUES))
 
 (DEFUN ATTACH-BACKTRACE-MENU
 (&OPTIONAL IL:TTYWINDOW IL:SKIP)
@@ -1197,19 +1204,29 @@
                IL:COLLECT
 (PROGN (IL:|while|
 (IL:FMEMB (SETF ARGNAME (POP ARGLIST))
                                                             LAMBDA-LIST-KEYWORDS)
                                         IL:|do|
 (SETF MODE ARGNAME))
+
+                                     (IL:* IL:|;;| " STKARGNAME returns symbol if bound special")

+
                                      (LIST (OR (IL:STKARGNAME I POS)
-                                                             (IL:* IL:\; "special")

-                                               (IF (CASE MODE
+                                               (COND
+                                                  ((CHARACTERP ARGNAME)
+
+                                                   (IL:* IL:|;;| 
+
                                                 "for special forms might start with #\\( or #\\{")

+
+                                                   (SETQ ARGLIST NIL)
+                                                   (FORMAT NIL "arg ~D" (- I 1)))
+                                                  ((CASE MODE
                                                        ((NIL &OPTIONAL) ARGNAME)
                                                        (T NIL))
-                                                   (STRING ARGNAME)
-                                                   (FORMAT NIL "arg ~D" (- I 1))))
+                                                   (STRING ARGNAME))
+                                                  (T (FORMAT NIL "arg ~D" (- I 1)))))
                                            I))))
       ,@(LET ((SLOTS (IL:BIND
 ARGNAME (NOVALUE IL:_ "no such value") IL:FOR
 PVAR IL:FROM

                                                                                          0
                         IL:AS
 I IL:|from|
 (1+ NUM-ARGS) IL:|to|
 TOTAL-SLOTS
                         IL:|when|
 (AND (IL:NEQ NOVALUE (IL:STKARG I POS NOVALUE))
-                                           (OR (SETF ARGNAME (IL:STKARGNAME I POS))
+                                           (OR (SETF ARGNAME (IL:STKARGNAME I POS T))
                                                (AND LOTS? (SETQ ARGNAME (FORMAT NIL "local ~D" PVAR))
                                                     ))) IL:|collect|
 (LIST ARGNAME I))))
              (AND SLOTS (CONS '("locals")
@@ -1345,16 +1362,19 @@
                  (T 0)))
           OUTPUT))
 
-(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) NIL "Exit this debugger level"
+(XCL:DEFCOMMAND ("STOP"
 :DEBUGGER :QUIET) ()
+   "Exit this debugger level"
    (IL:SETQ IL:BRKVALUES '(IL:ERROR!))
    (THROW 'DEBUGGER-EXIT NIL))
 
-(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) NIL "Abort out of debugger"
+(XCL:DEFCOMMAND ("^"
 :DEBUGGER :QUIET) ()
+   "Abort out of debugger"
    (IL:SETQ IL:BRKVALUES '(IL:ERROR!))
    (THROW 'DEBUGGER-EXIT NIL))
 
-(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
-                                            &ENVIRONMENT IL:ENV) "Return value from debugger"
+(XCL:DEFCOMMAND ("RETURN"
 :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
+                                                &ENVIRONMENT IL:ENV)
+   "Return value from debugger"
    (XCL:CONDITION-CASE (PROGN (IL:SETQ IL:BRKVALUES (LIST 'RETURN (MULTIPLE-VALUE-LIST (
 
                                                                                      DEBUGGER-EVAL

                                                                                         IL:EXPRESSION
@@ -1364,20 +1384,23 @@
           (SI::DEBUGGER-EVAL-ABORTED (IL:C)
                  (VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
 
-(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
-   (ESCAPE-FROM-DEBUGGER
 T IL:NAME-OR-NUMBER)
-   (VALUES))
-
-(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
-   (ESCAPE-FROM-DEBUGGER
 NIL IL:NAME-OR-NUMBER)
-   (VALUES))
-
-(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) 
+(XCL:DEFCOMMAND ("PR"
 :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
    "Select and invoke a proceed case."
    (ESCAPE-FROM-DEBUGGER
 T IL:NAME-OR-NUMBER)
    (VALUES))
 
-(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) NIL (DECLARE
 (SPECIAL IL:BRKENV))
+(XCL:DEFCOMMAND ("PR!"
 :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
+   "Select and invoke a proceed case."
+   (ESCAPE-FROM-DEBUGGER
 NIL IL:NAME-OR-NUMBER)
+   (VALUES))
+
+(XCL:DEFCOMMAND ("PROCEED"
 :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
+   "Select and invoke a proceed case."
+   (ESCAPE-FROM-DEBUGGER
 T IL:NAME-OR-NUMBER)
+   (VALUES))
+
+(XCL:DEFCOMMAND ("OK"
 :DEBUGGER :QUIET) ()
+   (DECLARE
 (SPECIAL IL:BRKENV))
    "Exit/proceed from debugger"
    (XCL:CONDITION-CASE (PROGN (WHEN (TYPEP IL:BRKCOND 'SI::BREAKPOINT)
 
@@ -1528,8 +1551,29 @@
 
 (IL:ADDTOVAR IL:LAMA
 IL:WBREAK)
 )
-(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
+(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2021))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (18680 18967 (IL:WBREAK 18693 . 18965)) (42297 47159 (IL:BAKTRACE 42310 . 45094) (
-IL:BAKTRACE1 45096 . 47157)) (81689 83655 (IL:FIND-STACK-FRAME 81702 . 83653)))))
+  (IL:FILEMAP (NIL (4647 6458 (XCL:ENTER-DEBUGGER-P 4647 . 6458)) (6460 13582 (XCL:DEBUGGER 6460 . 13582
+)) (13584 13898 (EMERGENCY-PANIC-LOOP 13584 . 13898)) (13900 15355 (IL:FIND-DEBUGGER-ENTRY-FRAME 13900
+ . 15355)) (15357 16046 (PRINT-ENTRY-MESSAGE 15357 . 16046)) (16048 16349 (SIMPLE-REPORT-CONDITION 
+16048 . 16349)) (16351 18091 (XCL::INTERESTING-FRAME-P 16351 . 18091)) (18676 18963 (IL:WBREAK 18689
+ . 18961)) (19076 20185 (REUSE-CURRENT-WINDOW 19076 . 20185)) (20187 21491 (CREATE-DEBUGGER-WINDOW 
+20187 . 21491)) (21493 22445 (SET-UP-DEBUGGER-WINDOW 21493 . 22445)) (22447 23462 (
+CLOSE-DEBUGGER-WINDOW 22447 . 23462)) (23464 23950 (RELEASE-DEBUGGER-WINDOW 23464 . 23950)) (23952 
+24889 (NEAR-BY-REGION 23952 . 24889)) (24891 26001 (DEBUGGER-BUTTON-EVENT 24891 . 26001)) (26003 26940
+ (DEBUGGER-MENU-HELP 26003 . 26940)) (31880 33698 (DEBUGGER-EVAL 31880 . 33698)) (33700 38049 (
+FIND-DEBUGGER-STACK-FRAME 33700 . 38049)) (38051 38790 (FIND-NAMED-STACK-POSITION 38051 . 38790)) (
+38792 39424 (FIND-ORIGINAL-NAME-AND-DEFINITION 38792 . 39424)) (39426 39560 (STKPTR-CCODE 39426 . 
+39560)) (42151 47013 (IL:BAKTRACE 42164 . 44948) (IL:BAKTRACE1 44950 . 47011)) (47849 54778 (
+ATTACH-BACKTRACE-MENU 47849 . 54778)) (54780 57991 (REGION-NEXT-TO 54780 . 57991)) (57993 59436 (
+BACKTRACE-MENU-BUTTONEVENTFN 57993 . 59436)) (59438 63712 (BACKTRACE-ITEM-SELECTED 59438 . 63712)) (
+63714 68024 (STACK-FRAME-PROPERTIES 63714 . 68024)) (68026 69036 (STACK-FRAME-FETCHFN 68026 . 69036)) 
+(69038 70225 (STACK-FRAME-STOREFN 69038 . 70225)) (70227 70802 (STACK-FRAME-VALUE-COMMAND 70227 . 
+70802)) (70804 71214 (STACK-FRAME-PROPERTY 70804 . 71214)) (71216 73201 (MAKE-FRAME-INSPECT-WINDOW 
+71216 . 73201)) (73203 73400 (%RELEASE-STACK-DATUM 73203 . 73400)) (73402 74108 (PRINT-BACKTRACE 73402
+ . 74108)) (77337 77431 (EXIT-DEBUGGER 77337 . 77431)) (77433 77752 (INVOKE-ESCAPE-FROM-MENU 77433 . 
+77752)) (77754 79177 (ESCAPE-FROM-DEBUGGER 77754 . 79177)) (79179 79557 (MENU-FROM-ESCAPE-LIST 79179
+ . 79557)) (79559 80718 (KEYLIST-FROM-ESCAPE-LIST 79559 . 80718)) (80720 81728 (COLLECT-ACTIVE-ESCAPES
+ 80720 . 81728)) (81730 82099 (IL:FIND-LEXICAL-ENVIRONMENT 81730 . 82099)) (82100 84066 (
+IL:FIND-STACK-FRAME 82113 . 84064)))))
 IL:STOP

sources/EXTERNALFORMAT

@@ -0,0 +1,604 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "19-Sep-2021 08:59:42" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;16
 31868  
+
+      changes to%:  (VARS EXTERNALFORMATCOMS)
+
+      previous date%: "11-Sep-2021 09:44:04" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;15)
+
+
+(PRETTYCOMPRINT EXTERNALFORMATCOMS)
+
+(RPAQQ EXTERNALFORMATCOMS

+       [(COMS                                                (* ; 
+
                          "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")

+              (DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
+              (INITRECORDS EXTERNALFORMAT)
+              (SYSRECORDS EXTERNALFORMAT)
+              (FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT)
+              (FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
+              (GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
+              (INITVARS (*EXTERNALFORMATS* NIL)
+                     [*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
+                     (*DEFAULT-EXTERNALFORMAT* :XCCS)))
+        [COMS 
+              (* ;; "Generic functions not compiled open (originally on LLREAD)")

+
+              (FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC 
+                   \INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
+              (DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC]
+        (COMS 
+              (* ;; "Also from FILEIO, but not clear that this is or ever has been used.")

+
+              (FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE \THROUGHOUTCHARFN)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT])
+
+
+
+(* ; "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")

+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY 
+(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
+
+(DATATYPE EXTERNALFORMAT
 ((EOLVALID FLAG)                (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")

+                              (EOL BITS 2)
+                              (UNSTABLE FLAG)                (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")

+                              (INCCODEFN POINTER)            (* ; 
+
                       "Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")

+                              (PEEKCCODEFN POINTER)          (* ; 
+
                                          "Called with three arguments -- STREAM, NOERROR, and EOL")

+                              (BACKCCODEFN POINTER)          (* ; 
+
                                    "Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")

+                              (OUTCHARFN POINTER)            (* ; 
+
                                                 "Called with two arguments -- STREAM and CHARCODE")

+                              (NAME POINTER)                 (* ; 
+
                                 "keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")

+                              (FORMATBYTESTREAMFN POINTER)   (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")

+                              (EF1 POINTER)                  (* ; 
+
    "Extra fields for use of particular formats.  Possibly to hold standardized translation tables")

+                              (EF2 POINTER)))
+)
+
+(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
+                                         FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
+                                         POINTER)
+       '((EXTERNALFORMAT 0 (FLAGBITS . 0))
+         (EXTERNALFORMAT 0 (BITS . 17))
+         (EXTERNALFORMAT 0 (FLAGBITS . 48))
+         (EXTERNALFORMAT 0 POINTER)
+         (EXTERNALFORMAT 2 POINTER)
+         (EXTERNALFORMAT 4 POINTER)
+         (EXTERNALFORMAT 6 POINTER)
+         (EXTERNALFORMAT 8 POINTER)
+         (EXTERNALFORMAT 10 POINTER)
+         (EXTERNALFORMAT 12 POINTER)
+         (EXTERNALFORMAT 14 POINTER))
+       '16)
+
+(* "END EXPORTED DEFINITIONS")
+
+)
+
+(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
+                                         FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
+                                         POINTER)
+       '((EXTERNALFORMAT 0 (FLAGBITS . 0))
+         (EXTERNALFORMAT 0 (BITS . 17))
+         (EXTERNALFORMAT 0 (FLAGBITS . 48))
+         (EXTERNALFORMAT 0 POINTER)
+         (EXTERNALFORMAT 2 POINTER)
+         (EXTERNALFORMAT 4 POINTER)
+         (EXTERNALFORMAT 6 POINTER)
+         (EXTERNALFORMAT 8 POINTER)
+         (EXTERNALFORMAT 10 POINTER)
+         (EXTERNALFORMAT 12 POINTER)
+         (EXTERNALFORMAT 14 POINTER))
+       '16)
+(ADDTOVAR SYSTEMRECLST
+
+(DATATYPE EXTERNALFORMAT
 ((EOLVALID FLAG)
+                              (EOL BITS 2)
+                              (UNSTABLE FLAG)
+                              (INCCODEFN POINTER)
+                              (PEEKCCODEFN POINTER)
+                              (BACKCCODEFN POINTER)
+                              (OUTCHARFN POINTER)
+                              (NAME POINTER)
+                              (FORMATBYTESTREAMFN POINTER)
+                              (EF1 POINTER)
+                              (EF2 POINTER)))
+)
+(DEFINEQ
+
+(\EXTERNALFORMAT

+  [LAMBDA (STREAM NEWFORMAT/NAME)
                       (* ; "Edited 10-Sep-2021 20:44 by rmk:")


+                                                             (* ; "Edited 26-Feb-91 13:20 by nm")

+
+(* ;;; ";;; RMK July 2020:  Added interface for per-device default external format.  \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")

+
+(* ;;; "")

+
+(* ;;; "If NEWFORMAT/NAME is nil, just returns the current external format name of STREAM.  If NEWFORMAT/NAME is supplied and it is or names an external format, then the external format of STREAM is set to that format.")

+
+(* ;;; "")

+
+(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")

+
+(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device.  The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability.  ")

+
+    (\DTEST STREAM 'STREAM)
+    (SETQ SAVEDNAME (fetch
 DEVICENAME of
 (fetch
 DEVICE of
 STREAM)))
+    (SETQ SAVEDDEFAULTFORMATNAME (fetch
 (FDEV DEFAULTEXTERNALFORMAT) of
 (fetch
 DEVICE
+                                                                                   of
 STREAM)))
+    (SETQ FOUNDFORMAT (FIND-FORMAT
 SAVEDDEFAULTFORMATNAME T))
+    (CL:WHEN NEWFORMAT/NAME
+        (CL:WHEN (type?
 READER-ENVIRONMENT NEWFORMAT/NAME)
+            (SETQ NEWFORMAT/NAME (fetch
 (READER-ENVIRONMENT REFORMAT) of
 NEWFORMAT/NAME)))
+        [LET (EXTFORMAT)
+             [COND
+                ((type?
 EXTERNALFORMAT NEWFORMAT/NAME)
+                 (SETQ EXTFORMAT NEWFORMAT/NAME))
+                (T (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
+                       (SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch
 DEVICENAME
+                                                                of
 (fetch
 DEVICE of

+                                                                                         STREAM))
+                                                             *DEFAULT-EXTERNALFORMATS*))
+                                                (fetch
 (FDEV DEFAULTEXTERNALFORMAT)
+                                                   of
 (fetch
 DEVICE of
 STREAM))
+                                                *DEFAULT-EXTERNALFORMAT*)))
+                   (SETQ EXTFORMAT (FIND-FORMAT
 NEWFORMAT/NAME))
+                   (CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME 
+                                               "is not a registered external format name"))
+                   (CL:UNLESS (type?
 EXTERNALFORMAT EXTFORMAT)
+                          (ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
+             (UNINTERRUPTABLY
+                 (freplace
 (STREAM EXTERNALFORMAT) of
 STREAM with
 EXTFORMAT)
+                 (CL:WHEN (ffetch
 (EXTERNALFORMAT EOLVALID) of
 EXTFORMAT)
+                     (freplace
 (STREAM EOLCONVENTION) of
 STREAM with
 (ffetch

+                                                                                  (EXTERNALFORMAT
+                                                                                   EOL) of
 
+                                                                                            EXTFORMAT
+                                                                                  )))
+                 (freplace
 (STREAM OUTCHARFN) of
 STREAM with
 (ffetch
 (EXTERNALFORMAT
+                                                                                      OUTCHARFN)
+                                                                            of
 EXTFORMAT))
+                 (freplace
 (STREAM INCCODEFN) of
 STREAM with
 (ffetch
 (EXTERNALFORMAT
+                                                                                      INCCODEFN)
+                                                                            of
 EXTFORMAT))
+                 (freplace
 (STREAM PEEKCCODEFN) of
 STREAM with
 (ffetch
 (
+                                                                                       EXTERNALFORMAT
+                                                                                        PEEKCCODEFN)
+                                                                              of
 EXTFORMAT))
+                 (freplace
 (STREAM BACKCCODEFN) of
 STREAM with
 (ffetch
 (
+                                                                                       EXTERNALFORMAT
+                                                                                        BACKCCODEFN)
+                                                                              of
 EXTFORMAT)))])
+    (ffetch
 (EXTERNALFORMAT NAME) of
 (fetch
 (STREAM EXTERNALFORMAT) of
 STREAM])
+
+(MAKE-EXTERNALFORMAT

+  [LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE)

+                                                            (* ; "Edited 10-Sep-2021 19:47 by rmk:")

+
+    (* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed.  If EOL is not specified, then EOLVALID is also NIL")

+
+    (SETQ EOL (SELECTC EOL
+                  ((LIST 'LF LF.EOLC) 
+                       LF.EOLC)
+                  ((LIST 'CR CR.EOLC) 
+                       CR.EOLC)
+                  ((LIST 'CRLF CRLF.EOLC) 
+                       CRLF.EOLC)
+                  (NIL)
+                  (SHOULDNT)))
+    (\INSTALL.EXTERNALFORMAT
 (CREATE
 EXTERNALFORMAT
+                                        NAME _ NAME
+                                        INCCODEFN _ INCCODEFN
+                                        PEEKCCODEFN _ PEEKCCODEFN
+                                        BACKCCODEFN _ BACKCCODEFN
+                                        OUTCHARFN _ OUTCHARFN
+                                        FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
+                                        EOLVALID _ EOL
+                                        EOL _ (OR EOL LF.EOLC)
+                                        UNSTABLE _ UNSTABLE])
+)
+(DEFINEQ
+
+(\INSTALL.EXTERNALFORMAT

+  [LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT)
               (* ; "Edited  5-Aug-2021 14:22 by rmk:")

+
+(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")

+
+(* ;;; "For backward compatibility, the first argument can be a NAME with the second argument being the format.  If so, the NAME must match the name inside the format")

+
+    (LET (NAME)
+         (IF
 EXTERNALFORMAT
+             THEN
 
+
+                   (* ;; "Backwards compatibility")

+
+                   (SETQ NAME (MKATOM EXTFORMAT/NAME))
+                   (IF
 (EQ NAME (FETCH
 (EXTERNALFORMAT NAME) OF
 EXTERNALFORMAT))
+                     ELSEIF
 (FETCH
 (EXTERNALFORMAT NAME) OF
 EXTERNALFORMAT)
+                       THEN
 (ERROR "Mismatch of specified name and name of the external format")
+                     ELSE
 (REPLACE
 (EXTERNALFORMAT NAME) OF
 EXTERNALFORMAT WITH

+                                                                                       NAME))
+           ELSE
 (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
+                 (SETQ NAME (FETCH
 (EXTERNALFORMAT NAME) OF
 EXTERNALFORMAT)))
+         (IF
 (type?
 EXTERNALFORMAT EXTERNALFORMAT)
+             THEN
 (\REMOVE.EXTERNALFORMAT
 NAME)
+                   (push
 *EXTERNALFORMATS* EXTERNALFORMAT)
+           ELSE
 (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
+         EXTERNALFORMAT])
+
+(\REMOVE.EXTERNALFORMAT

+  [LAMBDA (NAME/EXTFORMAT)
                              (* ; "Edited  5-May-2021 15:42 by rmk:")

+
+(* ;;; "Deregisters external format EXTERNALFORMAT .")

+
+    (SETQ NAME/EXTFORMAT (IF
 (TYPE?
 EXTERNALFORMAT NAME/EXTFORMAT)
+                             THEN
 (FETCH
 (EXTERNALFORMAT NAME) OF
 NAME/EXTFORMAT)
+                           ELSE
 (MKATOM NAME/EXTFORMAT)))
+    (SETQ *EXTERNALFORMATS* (DREMOVE (FIND
 EF IN
 *EXTERNALFORMATS*
+                                        SUCHTHAT
 (EQ NAME/EXTFORMAT (FETCH
 (EXTERNALFORMAT
+                                                                                    NAME)
+                                                                           OF
 EF)))
+                                   *EXTERNALFORMATS*])
+
+(FIND-FORMAT

+  [LAMBDA (NAME NOERROR)
                                (* ; "Edited  7-Aug-2021 09:29 by rmk:")

+    (IF
 (TYPE?
 EXTERNALFORMAT NAME)
+        THEN
 NAME
+      ELSE
 (SETQ NAME (MKATOM NAME))                     (* ; 
+
     "The EQMEMB allows for synonyms, the first of which should be canonical.  E.g. (:UTF-8 :UTF8)")

+            (OR (FIND
 EF IN
 *EXTERNALFORMATS* SUCHTHAT
 (EQ NAME (FETCH
 (
+                                                                                       EXTERNALFORMAT
+                                                                                        NAME)
+                                                                               OF
 EF)))
+                (CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
+)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
+)
+
+(RPAQ? *EXTERNALFORMATS*
 NIL)
+
+(RPAQ? *DEFAULT-EXTERNALFORMATS*
 '((DSK :XCCS)))
+
+(RPAQ? *DEFAULT-EXTERNALFORMAT*
 :XCCS)
+
+
+
+(* ;; "Generic functions not compiled open (originally on LLREAD)")

+
+(DEFINEQ
+
+(\OUTCHAR

+  [LAMBDA (STREAM CODE)
                                 (* ; "Edited 10-Aug-2021 10:29 by rmk:")

+
+    (* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.")

+
+    (* ;; "Maybe the implementation function does something else, like move the X and Y positions.  At best we could convert the EOL into either CR or LF, or into a CR-LF sequence that we pass by two calls to the lower implementation function.")

+
+    (* ;; "")

+
+    (* ;; "This would make CHARPOSITION generic:")

+                                                             (* (FREPLACE (STREAM CHARPOSITION) 
+
                                                           OF STREAM WITH (CL:IF
+
                                                           (EQ CODE (CHARCODE EOL)) 0
+
                                                           (IPLUS16 1 (FFETCH
+
                                                           (STREAM CHARPOSITION) OF STREAM)))))

+    (CL:FUNCALL (OR (ffetch
 (STREAM OUTCHARFN) of
 STREAM)
+                    \DEFAULTOUTCHAR)
+           STREAM CODE)
+    CODE])
+
+(\INCCODE

+  [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
            (* ; "Edited  7-Aug-2021 00:11 by rmk:")

+
+    (* ;; "Calling functions pass the name of the BYTECOUNTVAR, or NIL. If non-NIL, implementing functions are required to SETQ *BYTECOUNTER* to the number of bytes read (positive) or backed up (negative).")

+
+    (* ;; "Caller must bind BYTECOUNTVAR as a SPECVAR.  BYTECOUNTVAL can be passed as the current value of BYTECOUNTVAR, to save a call to \EVALV1.")

+
+    (IF
 BYTECOUNTVAR
+        THEN
 [LET ((*BYTECOUNTER* 0))
+                      (DECLARE
 (SPECVARS *BYTECOUNTER*))
+                      (PROG1 (CL:FUNCALL (OR (ffetch
 (STREAM INCCODEFN) of
 STREAM)
+                                             \DEFAULTINCCODE)
+                                    STREAM
+                                    '*BYTECOUNTER*)
+                          (SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
+                                                   *BYTECOUNTER*)))]
+      ELSE
 (CL:FUNCALL (OR (ffetch
 (STREAM INCCODEFN) of
 STREAM)
+                               \DEFAULTINCCODE)
+                      STREAM])
+
+(\BACKCCODE

+  [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
            (* ; "Edited 14-Aug-2021 00:26 by rmk:")

+
+    (* ;; 
+
"Format function returns T if the backup succeed, NIL otherwise (e.g at the beginning of the file)")

+
+    (IF
 BYTECOUNTVAR
+        THEN
 [LET ((*BYTECOUNTER* 0))
+                      (DECLARE
 (SPECVARS *BYTECOUNTER*))
+                      (PROG1 (CL:FUNCALL (OR (ffetch
 (STREAM BACKCCODEFN) of
 STREAM)
+                                             \DEFAULTBACKCCODE)
+                                    STREAM T)
+                          (SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
+                                                   *BYTECOUNTER*)))]
+      ELSE
 (CL:FUNCALL (OR (ffetch
 (STREAM BACKCCODEFN) of
 STREAM)
+                               \DEFAULTBACKCCODE)
+                      STREAM])
+
+(\BACKCCODE.EOLC

+  [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
            (* ; "Edited 14-Aug-2021 00:27 by rmk:")

+
+    (* ;; "If the EOLCONVENTION is CRLF, and the first backup is over an LF encoding, this looks to see whether the preceding bytes encode a CR and if so, backs up over those.")

+
+    (* ;; "Within this we operate at the external-format implementation level.")

+
+    (* ;; "Counting is unusual in general (mostly just COPYCHARS and PFCOPYBYTES) , and counting while backing up is even rarer.  So for simplicity here we just count by looking at the byte pointer.")

+
+    (LET [(STARTPOS (CL:WHEN BYTECOUNTVAR (\GETFILEPTR STREAM]
+
+         (* ;; "In almost all cases, we just execute the first backup")

+
+         (PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch
 (STREAM BACKCCODEFN) of
 STREAM)
+                                         \DEFAULTBACKCCODE)
+                                STREAM)
+                    (IF
 (AND (EQ CRLF.EOLC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM))
+                                 (EQ (CHARCODE LF)
+                                     (CL:FUNCALL (OR (ffetch
 (STREAM PEEKCCODEFN) of
 STREAM)
+                                                     \DEFAULTPEEKCCODE)
+                                            STREAM)))
+                        THEN
 
+
+                              (* ;; 
+
                    "We just backed over an LF in a CRLF file.  If we go one more, do we get a CR?")

+
+                              (CL:WHEN (CL:FUNCALL (OR (ffetch
 (STREAM BACKCCODEFN) of
 STREAM
+                                                              )
+                                                       \DEFAULTBACKCCODE)
+                                              STREAM)
+                                  (CL:UNLESS (EQ (CHARCODE CR)
+                                                 (CL:FUNCALL (OR (ffetch
 (STREAM PEEKCCODEFN)
+                                                                    of
 STREAM)
+                                                                 \DEFAULTPEEKCCODE)
+                                                        STREAM))
+
+                                      (* ;; "Not a preceding CR, reread it.")

+
+                                      (CL:FUNCALL (OR (ffetch
 (STREAM INCCODEFN) of
 STREAM)
+                                                      \DEFAULTINCCODE)
+                                             STREAM))
+                                  T)
+                      ELSE
 T))
+             (CL:WHEN BYTECOUNTVAR
+                 [SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
+                                          (IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
+
+(\PEEKCCODE

+  [LAMBDA (STREAM NOERROR EOL)
                          (* ; "Edited 14-Jun-2021 12:40 by rmk:")

+    (\CHECKEOLC (CL:FUNCALL (OR (ffetch
 (STREAM PEEKCCODEFN) of
 STREAM)
+                                \DEFAULTPEEKCCODE)
+                       STREAM NOERROR)
+           EOL STREAM T])
+
+(\PEEKCCODE.NOEOLC

+  [LAMBDA (STREAM NOERROR)
                              (* ; "Edited 27-Jun-2021 23:26 by rmk:")

+    (CL:FUNCALL (OR (ffetch
 (STREAM PEEKCCODEFN) of
 STREAM)
+                    \DEFAULTPEEKCCODE)
+           STREAM NOERROR])
+
+(\INCCODE.EOLC

+  [LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL)
       (* ; "Edited  8-Aug-2021 14:52 by rmk:")

+
+    (* ;; 
+
  "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")

+
+    (* ;; " EOLC of NIL means all patterns go to EOL")

+
+    (IF
 BYTECOUNTVAR
+        THEN
 [LET (*BYTECOUNTER* CODE)
+                      (DECLARE
 (SPECVARS *BYTECOUNTER*))
+
+                      (* ;; "The INCCODEFN first sets *BYTECOUNTER*")

+
+                      (CL:UNLESS BYTECOUNTVAL
+                          (SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
+                      (SETQ CODE (CL:FUNCALL (OR (ffetch
 (STREAM INCCODEFN) of
 STREAM)
+                                                 \DEFAULTINCCODE)
+                                        STREAM T))
+
+                      (* ;; "Update according to the number of first-char (CR or LF) bytes")

+
+                      (SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
+                      (SETQ *BYTECOUNTER* 0)
+
+                      (* ;; 
+
                    "*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")

+
+                      (PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH
 (STREAM EOLCONVENTION)
+                                                          OF
 STREAM))
+                                    STREAM NIL T)
+
+                          (* ;; "Post the results")

+
+                          (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
+      ELSE
 (\CHECKEOLC (CL:FUNCALL (OR (ffetch
 (STREAM INCCODEFN) of
 STREAM)
+                                           \DEFAULTINCCODE)
+                                  STREAM)
+                      (OR EOLC (FFETCH
 (STREAM EOLCONVENTION) OF
 STREAM))
+                      STREAM])
+
+(\FORMATBYTESTREAM

+  [LAMBDA (STREAM BYTESTREAM)
                           (* ; "Edited 24-Jun-2021 17:26 by rmk:")

+
+    (* ;; "Create or modify a stream that will simulate the current character input/output byte sequences of  STREAM.  The set up here does what is common to all formats:  an IO stream starting with STREAM external format and EOL.")

+
+    (* ;; "If the format has its own FORMATBYTESTREAMFN function, that is applied to copy any other state.  (Currently that function is a property of the format, not carried over into a stream field that can be changed dynamically.)")

+
+    (CL:UNLESS (AND (STREAMP BYTESTREAM)
+                    (\IOMODEP STREAM 'BOTH))
+        (SETQ BYTESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH)))
+    (LET ((FORMAT (FETCH
 (STREAM EXTERNALFORMAT) OF
 STREAM))
+          (EOLC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM)))
+         (\EXTERNALFORMAT
 BYTESTREAM FORMAT)
+         (CL:WHEN (EQ EOLC ANY.EOLC)
+             (SETQ EOLC (OR (FETCH
 (EXTERNALFORMAT EOL) OF
 FORMAT)
+                            LF.EOLC)))
+         (REPLACE
 (STREAM EOLCONVENTION) OF
 BYTESTREAM WITH
 EOLC)
+         (SETFILEPTR BYTESTREAM 0)
+         (SETFILEINFO BYTESTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
+         (CL:WHEN (FETCH
 (EXTERNALFORMAT FORMATBYTESTREAMFN) OF
 FORMAT)
+             (APPLY* (FETCH
 (EXTERNALFORMAT FORMATBYTESTREAMFN) OF
 FORMAT)
+                    STREAM BYTESTREAM))
+         BYTESTREAM])
+
+(\CHECKEOLC.CRLF

+  [LAMBDA (STREAM PEEKBINFLG COUNTP)
                    (* ; "Edited  6-Aug-2021 23:30 by rmk:")

+
+    (* ;; "This is called only when a CR has been read and EOLC is either any or CRLF. This returns EOL if the next code is an LF")

+
+    (* ;; "If COUNTP, that sets *BYTECOUNTER* freely with the number of LF bytes.")

+
+    (DECLARE
 (USEDFREE *BYTECOUNTER*))
+    (LET (CH)
+         [SETQ CH (COND
+                     [PEEKBINFLG 
+
+                            (* ;; 
+
                          "T from PEEKC.  In this case, must leave the fileptr where it was.")

+
+                            (* ;; "The CR itself hasn't been read, just peeked.  So here we have to read it, then peek at the next character to see if it is an LF, and then back out the CR")

+
+                            (COND
+                               ([EQ (CHARCODE LF)
+                                    (UNINTERRUPTABLY
+                                        
+                                        (* ;; " Since we are going to \BACKCCODE back the peeked character, we don't need to update the counter variable")

+
+                                        (\INCCODE
 STREAM)
+                                        (PROG1 (\PEEKCCODE
 STREAM T 'NOEOLC)
+
+                                            (* ;; 
+
                          "This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")

+
+                                            (* ;; 
+
          "LF must be the next char after the CR.  We back up over the CR that \INCCODE just read.")

+
+                                            (\BACKCCODE
 STREAM)))]
+
+                                (* ;; "Got the CRLF, it's an EOL")

+
+                                (CHARCODE EOL))
+                               (T (CHARCODE CR]
+                     ((EQ (CHARCODE LF)
+                          (\PEEKCCODE
 STREAM T 'NOEOLC))
+
+                      (* ;; "Since we aren't peeking, the CR has actually been read, and we are entitled to read the LF that we just peeked at.")

+
+                      (IF
 COUNTP
+                          THEN
 (LET (NUMLFBYTES)
+                                        (DECLARE
 (SPECVARS NUMLFBYTES))
+                                        (\INCCODE
 STREAM 'NUMLFBYTES 0)
+                                        (ADD
 *BYTECOUNTER* NUMLFBYTES))
+                        ELSE
 (\INCCODE
 STREAM))
+                      (CHARCODE EOL))
+                     (T (CHARCODE CR]
+         CH])
+)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY 
+(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS \CHECKEOLC
 MACRO
 [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP)
+                                     (COND
+                                        ((EQ EOLC 'NOEOLC)
+                                         CH)
+                                        (T (SELCHARQ CH
+                                                (LF (SELECTC (OR EOLC (FFETCH
 (STREAM 
+                                                                                        EOLCONVENTION
+                                                                                         )
+                                                                         OF
 STRM))
+                                                        ((LIST LF.EOLC ANY.EOLC) 
+                                                             (CHARCODE EOL))
+                                                        (CHARCODE LF)))
+                                                (CR (SELECTC (OR EOLC (FFETCH
 (STREAM 
+                                                                                        EOLCONVENTION
+                                                                                         )
+                                                                         OF
 STRM))
+                                                        (CR.EOLC (CHARCODE EOL))
+                                                        ((LIST ANY.EOLC CRLF.EOLC) 
+                                                             (\CHECKEOLC.CRLF
 STRM PEEKBINFLG 
+                                                                    COUNTP))
+                                                        (CHARCODE CR)))
+                                                CH])
+)
+
+(* "END EXPORTED DEFINITIONS")
+
+)
+
+
+
+(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")

+
+(DEFINEQ
+
+(\CREATE.THROUGH.EXTERNALFORMAT

+  [LAMBDA NIL
                                           (* ; "Edited 23-Jun-2021 13:34 by rmk:")

+
+(* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :THROUGH as its name.  EOL is adjusted to CR so as not to do any eol conversion on this stream.")

+
+    (\INSTALL.EXTERNALFORMAT
 (create
 EXTERNALFORMAT
+                                        NAME _ :THROUGH
+                                        INCCODEFN _ (FUNCTION \THROUGHIN)
+                                        PEEKCCODEFN _ (FUNCTION \PEEKBIN)
+                                        BACKCCODEFN _ (FUNCTION \THROUGHBACKCCODE)
+                                        OUTCHARFN _ (FUNCTION \THROUGHOUTCHARFN)
+                                        EOL _ CR.EOLC])
+
+(\THROUGHIN

+  [LAMBDA (STREAM COUNTP)
                               (* ; "Edited  6-Aug-2021 16:13 by rmk:")

+
+(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")

+
+(* ;;; "If COUNTP is non-NIL,  the byte counter is always set to 1.")

+
+    (DECLARE
 (USEDFREE *BYTECOUNTER*))
+    (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
+    (\BIN STREAM])
+
+(\THROUGHBACKCCODE

+  [LAMBDA (STREAM COUNTP)
                               (* ; "Edited  6-Aug-2021 16:14 by rmk:")

+    (DECLARE
 (USEDFREE *BYTECOUNTER*))
+    (CL:WHEN (\BACKFILEPTR STREAM)
+        (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
+        T)])
+
+(\THROUGHOUTCHARFN

+  [LAMBDA (OUTSTREAM CHARCODE)
                           (* ; "Edited 26-Feb-91 13:44 by nm")

+
+(* ;;; "Encoder for THROUGH format.")

+
+    (COND
+       ((> CHARCODE 255)
+        (\BOUT OUTSTREAM (\CHARSET CHARCODE))
+        (\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))
+       (T (\BOUT OUTSTREAM CHARCODE])
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(\CREATE.THROUGH.EXTERNALFORMAT
)
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (5657 12044 (\EXTERNALFORMAT 5667 . 10729) (MAKE-EXTERNALFORMAT 10731 . 12042)) (12045 
+15158 (\INSTALL.EXTERNALFORMAT 12055 . 13504) (\REMOVE.EXTERNALFORMAT 13506 . 14337) (FIND-FORMAT 
+14339 . 15156)) (15488 27986 (\OUTCHAR 15498 . 16634) (\INCCODE 16636 . 17822) (\BACKCCODE 17824 . 
+18718) (\BACKCCODE.EOLC 18720 . 21483) (\PEEKCCODE 21485 . 21801) (\PEEKCCODE.NOEOLC 21803 . 22065) (
+\INCCODE.EOLC 22067 . 23926) (\FORMATBYTESTREAM 23928 . 25418) (\CHECKEOLC.CRLF 25420 . 27984)) (29929
+ 31772 (\CREATE.THROUGH.EXTERNALFORMAT 29939 . 30741) (\THROUGHIN 30743 . 31163) (\THROUGHBACKCCODE 
+31165 . 31432) (\THROUGHOUTCHARFN 31434 . 31770)))))
+STOP

sources/FILEPKG

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "23-Aug-2021 16:42:18" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;6
 284495 
 
-      changes to%:  (FNS GATHEREXPORTS)
+
(FILECREATED "10-Oct-2021 20:36:54" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;10
 284821 
 
-      previous date%: " 3-Jul-2021 11:08:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;5)
+      changes to%:  (FNS MAKEFILE)
+
+      previous date%: " 8-Oct-2021 23:56:39" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;9)
 
 
 (* ; "
@@ -19,15 +20,15 @@ with the terms of said license.
 (PRETTYCOMPRINT FILEPKGCOMS)
 
 (RPAQQ FILEPKGCOMS

-       [(COMS                                                (* ; 
-
            "standard records for accessing file  package type/command parts.  Exported for PRETTY")

+       [(COMS                                                (* ; 
+
            "standard records for accessing file  package type/command parts.  Exported for PRETTY")

               (VARS FILEPKGTYPEPROPS)
               (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS)))
               (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS)
               (INITRECORDS * FILEPKGRECORDS))
         [DECLARE%: EVAL@COMPILE DOCOPY 
 
-               (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")

+               (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")

 
                (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES 
                                        PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS
@@ -36,7 +37,7 @@ with the terms of said license.
                                        NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS]
         (INITVARS (MSDATABASELST))
         [COMS 
-              (* ;; "making, adding, listing, compiling files")

+              (* ;; "making, adding, listing, compiling files")

 
               (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES 
                    FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE
@@ -58,14 +59,14 @@ with the terms of said license.
               (INITVARS (MAKEFILEREMAKEFLG T)
                      (CLEANUPOPTIONS '(RC]
         (COMS 
-              (* ;; "scanning file coms")

+              (* ;; "scanning file coms")

 
               (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS 
                    FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM
                    INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN 
                    IFCDECLARE INFILEPAIRS INFILECOMSMACRO))
         (COMS 
-              (* ;; "adding to a file")

+              (* ;; "adding to a file")

 
               (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM 
                    ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM)
@@ -73,28 +74,28 @@ with the terms of said license.
               (ADDVARS (MARKASCHANGEDFNS))
               (FNS MERGEINSERT MERGEINSERT1)
               
-              (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")

+              (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")

 
               (FNS ADDTOFILEKEYLST)
               (INITVARS (ADDTOFILEKEYLST (ADDTOFILEKEYLST))
                      (LASTFILE)))
         (COMS 
-              (* ;; "deleting an item from a file")

+              (* ;; "deleting an item from a file")

 
               (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE)
               (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)
                  (MOVD? 'MOVETOFILE 'MOVEITEM NIL T))
               (ADDVARS (SYSPROPS PROPTYPE VARTYPE)))
-        [COMS                                                (* ; 
-
                      "functions for doing things and marking them changed and auxiliary functions")

+        [COMS                                                (* ; 
+
                      "functions for doing things and marking them changed and auxiliary functions")

               (FNS SAVEPUT)
               [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
                                                      (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT]
               (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS)
               (ADDVARS (LISPXFNS (PUT . SAVEPUT)
                               (PUTPROP . SAVEPUT]
-        (COMS                                                (* ; 
-
                                                  "sub-functions for file package commands & types")

+        (COMS                                                (* ; 
+
                                                  "sub-functions for file package commands & types")

               (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED 
                    MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS 
                    PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS 
@@ -107,24 +108,24 @@ with the terms of said license.
               (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS 
                     LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS 
                     PRETTYPRINTYPEMACROS USERMACROS))
-        (COMS                                                (* ; 
-
                    "Define the commands below AFTER the various properties have been established.")

+        (COMS                                                (* ; 
+
                    "Define the commands below AFTER the various properties have been established.")

               (USERMACROS M))
-        (COMS                                                (* ; "GETDEF methods")

+        (COMS                                                (* ; "GETDEF methods")

               (FNS RENAME CHANGECALLERS)
               (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE
                    GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF 
                    DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
               (INITVARS (WHEREIS.HASH)))
-                                                             (* ; "Must come after PUTDEF")

+                                                             (* ; "Must come after PUTDEF")

         (FNS FIXEDITDATE EDITDATE?)
-                                                             (* ; 
-
                                  "Edit date support for all kinds of definers (from PARC 6/10/92)")

+                                                             (* ; 
+
                                  "Edit date support for all kinds of definers (from PARC 6/10/92)")

         [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
               (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
         (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
         (COMS 
-              (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")

+              (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")

 
               (FNS FILEPKGCOM FILEPKGTYPE)
               (PROP ARGNAMES FILEPKGCOM)
@@ -137,24 +138,24 @@ with the terms of said license.
         (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS)
                         (VARIABLES VARS CONSTANTS)))
         (INITVARS (SAVEDDEFS))
-        (COMS                                                (* ; "EDITCALLERS")

+        (COMS                                                (* ; "EDITCALLERS")

               (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN)
               (FNS SEPRCASE)
               [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL]
               (INITVARS (SEPRCASEARRAYS)
                      (CLISPCASEARRAYS))
               (P (MOVD? 'INFILEP 'FINDFILE)
-                                                             (* ; "or else from SPELLFILE")
)
+                                                             (* ; "or else from SPELLFILE")
)
               (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
                              (NOLINKFNS LOADFROM)))
               (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS))
-        (COMS                                                (* ; "EXPORT")

+        (COMS                                                (* ; "EXPORT")

               (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS)
               (FILEPKGCOMS EXPORT)
               [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")
                      (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"]
               (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM))
-        (COMS                                                (* ; "for GAINSPACE")

+        (COMS                                                (* ; "for GAINSPACE")

               (FNS CLEARFILEPKG)
               [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
                                               ((Y "es")
@@ -254,11 +255,11 @@ with the terms of said license.
                                                       (REMOVE (FASSOC DATUM (GETTOPVAL 
                                                                                    'PRETTYDEFMACROS))
                                                              (GETTOPVAL 'PRETTYDEFMACROS]
-                                                             (* Not an atom record cause want 
-
                                                           REMPROP on NILs.)

-                                                             (* NOTE%: PRETTCOM on PRETTY has 
-
                                                           open-coded access to the MACRO 
-
                                                           property.)

+                                                             (* Not an atom record cause want 
+
                                                           REMPROP on NILs.)

+                                                             (* NOTE%: PRETTCOM on PRETTY has 
+
                                                           open-coded access to the MACRO 
+
                                                           property.)

                           (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
                                        FILEPKGCONTENTS)))
 
@@ -289,8 +290,8 @@ with the terms of said license.
                                                                     (REMOVE (SEARCHPRETTYTYPELST
                                                                              DATUM)
                                                                            (GETTOPVAL 'PRETTYTYPELST]
-                                                             (* NOTE%: PRETTYCOM on PRETTY has 
-
                                                           open-coded access to GETDEF property)

+                                                             (* NOTE%: PRETTYCOM on PRETTY has 
+
                                                           open-coded access to GETDEF property)

                                    (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
                                                 (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                                                                    (PUT X
@@ -455,31 +456,35 @@ with the terms of said license.
           (RETURN FILE])
 
 (MAKEFILE

-  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)
          (* ; "Edited  3-Jul-2021 11:03 by rmk:")


-                                                            (* ; "Edited 29-Jun-2021 17:24 by rmk:")

+  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)
          (* ; "Edited 10-Oct-2021 20:36 by rmk:")


+                                                            (* ; "Edited 29-Jun-2021 17:24 by rmk:")

 
-    (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL;  LIST means list the FILE;  RC means RECOMPILE, C means COMPILEL;  --- for C AND RC assume ST unless next option is F.")

+    (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL;  LIST means list the FILE;  RC means RECOMPILE, C means COMPILEL;  --- for C AND RC assume ST unless next option is F.")

 
+    (* ;; "RMK:  OPTIONS can specify external format, either as a pair like (FORMAT :UTF-8) or just :UTF-8 where (FIND-FORMAT :UTF-8) is non NIL.")

+
+    [SETQ OPTIONS (FOR
 OPT INSIDE
 OPTIONS COLLECT
 (CL:IF (FIND-FORMAT OPT T)
+                                                                  (LIST 'FORMAT OPT))]
     (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS]
                            PRETTYFLG))
            (*PRINT-BASE* (if
 (EQ *PRINT-BASE* 8)
                              then
 8
-                           else
                          (* ; "make sure radix is either 8 or 10, because all others don't read in like they print.  Maybe obsolete now with makefile environments")

+                           else
                          (* ; "make sure radix is either 8 or 10, because all others don't read in like they print.  Maybe obsolete now with makefile environments")

                                  10))
            FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE
 FILE)))
           (DECLARE
 (CL:SPECIAL PRETTYFLG))
-          (SETQ FILE (CAR Z))                                (* ; 
-
                                               "Necessary because FILE might have been misspelled.")

-          (SETQ ROOTNAME (CADR Z))                           (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")

+          (SETQ FILE (CAR Z))                                (* ; 
+
                                               "Necessary because FILE might have been misspelled.")

+          (SETQ ROOTNAME (CADR Z))                           (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")

           (SETQ FILEPROP (CDDR Z))
-          (UPDATEFILES
)                                  (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")

+          (UPDATEFILES
)                                  (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")

           (SETQ CHANGES (fetch
 TOBEDUMPED of
 FILEPROP))
           (SETQ FILEDATES (LISTP (fetch
 FILEDATES of
 ROOTNAME)))
           (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE))
       LP0 (if
 (AND (NULL (fetch
 LOADTYPE of
 FILEPROP))
                        (NULL FILEDATES))
-              then
                                       (* ; 
-
                   "File has never been loaded and never dumped i.e. user just set up COMS in core")

+              then
                                       (* ; 
+
                   "File has never been loaded and never dumped i.e. user just set up COMS in core")

             elseif
 [OR (EQMEMB 'NEW OPTIONS)
                            (AND (NULL MAKEFILEREMAKEFLG)
                                 (NOT (MEMB 'REMAKE OPTIONS]
@@ -500,14 +505,14 @@ with the terms of said license.
                                   T)
                            (COND
                               ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ")
-                                    'Y)                      (* ; 
-
            "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")

+                                    'Y)                      (* ; 
+
            "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")

                                (GO OUT)))
                            (/replace
 LOADTYPE of
 FILEPROP with
 NIL)))
                     (SETQ SOURCEFILE NIL)
                     (SETQ REPRINTFNS NIL)
             elseif
 SOURCEFILE
-              then
                                       (* ; "source file given")

+              then
                                       (* ; "source file given")

             elseif
 [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T))
                                                (EQUAL (FILEDATE SOURCEFILE)
                                                       (fetch
 FILEDATE of
 (CAR FILEDATES]
@@ -527,7 +532,7 @@ with the terms of said license.
                                    (fetch
 FILEDATE of
 (CADR FILEDATES]
               then
 
 
-                    (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")

+                    (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")

 
                     (SETQ CHANGES (FILEPKG.MERGECHANGES
 (fetch
 TOBEDUMPED of
 FILEPROP)
                                          (fetch
 FILECHANGES of
 ROOTNAME)))
@@ -545,8 +550,8 @@ with the terms of said license.
                   (GO LP0))
           (COND
              ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch
 LOADTYPE of
 FILEPROP)
-                                          (LOADCOMP          (* ; 
-
                                                   "only loaded via LOADCOMP.  Need to do LOADFROM")

+                                          (LOADCOMP          (* ; 
+
                                                   "only loaded via LOADCOMP.  Need to do LOADFROM")

                                                     (LIST 'N SOURCEFILE "was loaded with LOADCOMP"
                                                           '- "LOADFROM it to obtain VARS/COMS"))
                                           (Compiled (AND (INFILECOMS?
 'DONTCOPY 'DECLARE%:
@@ -569,23 +574,23 @@ with the terms of said license.
                                 (A "bort MAKEFILE
 "]
                   (Y (SELECTQ (fetch
 LOADTYPE of
 FILEPROP)
-                         (LOADCOMP                           (* ; 
-
                               "file was never actually loaded, just loadcomped.  thus no filecoms")

+                         (LOADCOMP                           (* ; 
+
                               "file was never actually loaded, just loadcomped.  thus no filecoms")

                                    (LOADFROM SOURCEFILE))
                          (Compiled 
 
-                                 (* ;; "This is going to be a remake.  If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")

+                                 (* ;; "This is going to be a remake.  If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")

 
                                    (LOADVARS 'DONTCOPY SOURCEFILE)
                                    (/replace
 LOADTYPE of
 FILEPROP with
 'COMPILED)
-                                                             (* ; "So wont have to be done again.")

+                                                             (* ; "So wont have to be done again.")

 
-                                 (* ;; "These are the only DECLARE:'s that are not also on the compiled file.  Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE:  Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")

+                                 (* ;; "These are the only DECLARE:'s that are not also on the compiled file.  Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE:  Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")

 
                                    )
                          ((loadfns compiled) 
 
-                                 (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")

+                                 (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")

 
                               (LOADVARS T SOURCEFILE))
                          NIL))
@@ -4789,7 +4794,7 @@ compiling " T)
 
 (MOVD? 'INFILEP 'FINDFILE)
 
-                                                             (* ; "or else from SPELLFILE")

+                                                             (* ; "or else from SPELLFILE")

 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
 
 (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
@@ -5036,46 +5041,46 @@ compiling " T)
 (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 
 1990 1991 1992 1993 1995 2018 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (20621 22326 (SEARCHPRETTYTYPELST 20631 . 21610) (PRETTYDEFMACROS 21612 . 22070) (
-FILEPKGCOMPROPS 22072 . 22324)) (23128 57617 (CLEANUP 23138 . 24526) (COMPILEFILES 24528 . 24804) (
-COMPILEFILES0 24806 . 25526) (CONTINUEDIT 25528 . 26948) (MAKEFILE 26950 . 38958) (FILECHANGES 38960
- . 41295) (FILEPKG.MERGECHANGES 41297 . 42120) (FILEPKG.CHANGEDFNS 42122 . 42434) (MAKEFILE1 42436 . 
-46663) (COMPILE-FILE? 46665 . 48222) (MAKEFILES 48224 . 49917) (ADDFILE 49919 . 52440) (ADDFILE0 52442
- . 56578) (LISTFILES 56580 . 57615)) (58313 93553 (FILEPKGCHANGES 58323 . 59673) (GETFILEPKGTYPE 59675
- . 62748) (MARKASCHANGED 62750 . 64387) (FILECOMS 64389 . 64773) (WHEREIS 64775 . 66195) (
-SMASHFILECOMS 66197 . 66432) (FILEFNSLST 66434 . 66596) (FILECOMSLST 66598 . 67082) (UPDATEFILES 67084
- . 72384) (INFILECOMS? 72386 . 74289) (INFILECOMTAIL 74291 . 75431) (INFILECOMS 75433 . 75594) (
-INFILECOM 75596 . 85805) (INFILECOMSVALS 85807 . 86134) (INFILECOMSVAL 86136 . 87138) (INFILECOMSPROP 
-87140 . 87969) (IFCPROPS 87971 . 89232) (IFCEXPRTYPE 89234 . 89745) (IFCPROPSCAN 89747 . 90800) (
-IFCDECLARE 90802 . 92113) (INFILEPAIRS 92115 . 92447) (INFILECOMSMACRO 92449 . 93551)) (93588 125008 (
-FILES? 93598 . 95791) (FILES?1 95793 . 96491) (FILES?PRINTLST 96493 . 97275) (ADDTOFILES? 97277 . 
-108323) (ADDTOFILE 108325 . 109241) (WHATIS 109243 . 111219) (ADDTOCOMS 111221 . 112865) (ADDTOCOM 
-112867 . 119414) (ADDTOCOM1 119416 . 120587) (ADDNEWCOM 120589 . 121639) (MAKENEWCOM 121641 . 123484) 
-(DEFAULTMAKENEWCOM 123486 . 125006)) (125078 127895 (MERGEINSERT 125088 . 127431) (MERGEINSERT1 127433
- . 127893)) (128049 129406 (ADDTOFILEKEYLST 128059 . 129404)) (129523 140435 (DELFROMFILES 129533 . 
-130383) (DELFROMCOMS 130385 . 132064) (DELFROMCOM 132066 . 137934) (DELFROMCOM1 137936 . 138733) (
-REMOVEITEM 138735 . 139609) (MOVETOFILE 139611 . 140433)) (140649 143018 (SAVEPUT 140659 . 143016)) (
-143143 151467 (UNMARKASCHANGED 143153 . 144861) (PREEDITFN 144863 . 147374) (POSTEDITPROPS 147376 . 
-149877) (POSTEDITALISTS 149879 . 151465)) (151616 172170 (ALISTS.GETDEF 151626 . 152005) (
-ALISTS.WHENCHANGED 152007 . 152651) (CLEARCLISPARRAY 152653 . 153827) (EXPRESSIONS.WHENCHANGED 153829
- . 154203) (MAKEALISTCOMS 154205 . 155278) (MAKEFILESCOMS 155280 . 156717) (MAKELISPXMACROSCOMS 156719
- . 158737) (MAKEPROPSCOMS 158739 . 159437) (MAKEUSERMACROSCOMS 159439 . 161239) (PROPS.WHENCHANGED 
-161241 . 161862) (FILEGETDEF.LISPXMACROS 161864 . 163306) (FILEGETDEF.ALISTS 163308 . 163927) (
-FILEGETDEF.RECORDS 163929 . 164860) (FILEGETDEF.PROPS 164862 . 165654) (FILEGETDEF.MACROS 165656 . 
-166716) (FILEGETDEF.VARS 166718 . 167134) (FILEGETDEF.FNS 167136 . 168500) (FILEPKGCOMS.PUTDEF 168502
- . 170942) (FILES.PUTDEF 170944 . 171901) (VARS.PUTDEF 171903 . 172046) (FILES.WHENCHANGED 172048 . 
-172168)) (174192 181625 (RENAME 174202 . 175603) (CHANGECALLERS 175605 . 181623)) (181626 229574 (
-SHOWDEF 181636 . 182429) (COPYDEF 182431 . 184905) (GETDEF 184907 . 187183) (GETDEFCOM 187185 . 188151
-) (GETDEFCOM0 188153 . 189499) (GETDEFCURRENT 189501 . 195921) (GETDEFERR 195923 . 197224) (
-GETDEFFROMFILE 197226 . 201506) (GETDEFSAVED 201508 . 202612) (PUTDEF 202614 . 203317) (EDITDEF 203319
- . 204296) (DEFAULT.EDITDEF 204298 . 207134) (EDITDEF.FILES 207136 . 207337) (LOADDEF 207339 . 207515)
- (DWIMDEF 207517 . 208371) (DELDEF 208373 . 211387) (DELFROMLIST 211389 . 211893) (HASDEF 211895 . 
-218217) (GETFILEDEF 218219 . 218741) (SAVEDEF 218743 . 220402) (UNSAVEDEF 220404 . 221300) (
-COMPAREDEFS 221302 . 224604) (COMPARE 224606 . 225310) (TYPESOF 225312 . 229572)) (229641 234684 (
-FIXEDITDATE 229651 . 233154) (EDITDATE? 233156 . 234682)) (235103 243874 (FILEPKGCOM 235113 . 240046) 
-(FILEPKGTYPE 240048 . 243872)) (255911 270843 (FINDCALLERS 255921 . 256436) (EDITCALLERS 256438 . 
-264348) (EDITFROMFILE 264350 . 270158) (FINDATS 270160 . 270432) (LOOKIN 270434 . 270841)) (270844 
-272571 (SEPRCASE 270854 . 272569)) (273088 278645 (IMPORTFILE 273098 . 274072) (IMPORTEVAL 274074 . 
-274954) (IMPORTFILESCAN 274956 . 275377) (CHECKIMPORTS 275379 . 276715) (GATHEREXPORTS 276717 . 278055
-) (\DUMPEXPORTS 278057 . 278643)) (278983 281191 (CLEARFILEPKG 278993 . 281189)))))
+  (FILEMAP (NIL (20618 22323 (SEARCHPRETTYTYPELST 20628 . 21607) (PRETTYDEFMACROS 21609 . 22067) (
+FILEPKGCOMPROPS 22069 . 22321)) (23125 57943 (CLEANUP 23135 . 24523) (COMPILEFILES 24525 . 24801) (
+COMPILEFILES0 24803 . 25523) (CONTINUEDIT 25525 . 26945) (MAKEFILE 26947 . 39284) (FILECHANGES 39286
+ . 41621) (FILEPKG.MERGECHANGES 41623 . 42446) (FILEPKG.CHANGEDFNS 42448 . 42760) (MAKEFILE1 42762 . 
+46989) (COMPILE-FILE? 46991 . 48548) (MAKEFILES 48550 . 50243) (ADDFILE 50245 . 52766) (ADDFILE0 52768
+ . 56904) (LISTFILES 56906 . 57941)) (58639 93879 (FILEPKGCHANGES 58649 . 59999) (GETFILEPKGTYPE 60001
+ . 63074) (MARKASCHANGED 63076 . 64713) (FILECOMS 64715 . 65099) (WHEREIS 65101 . 66521) (
+SMASHFILECOMS 66523 . 66758) (FILEFNSLST 66760 . 66922) (FILECOMSLST 66924 . 67408) (UPDATEFILES 67410
+ . 72710) (INFILECOMS? 72712 . 74615) (INFILECOMTAIL 74617 . 75757) (INFILECOMS 75759 . 75920) (
+INFILECOM 75922 . 86131) (INFILECOMSVALS 86133 . 86460) (INFILECOMSVAL 86462 . 87464) (INFILECOMSPROP 
+87466 . 88295) (IFCPROPS 88297 . 89558) (IFCEXPRTYPE 89560 . 90071) (IFCPROPSCAN 90073 . 91126) (
+IFCDECLARE 91128 . 92439) (INFILEPAIRS 92441 . 92773) (INFILECOMSMACRO 92775 . 93877)) (93914 125334 (
+FILES? 93924 . 96117) (FILES?1 96119 . 96817) (FILES?PRINTLST 96819 . 97601) (ADDTOFILES? 97603 . 
+108649) (ADDTOFILE 108651 . 109567) (WHATIS 109569 . 111545) (ADDTOCOMS 111547 . 113191) (ADDTOCOM 
+113193 . 119740) (ADDTOCOM1 119742 . 120913) (ADDNEWCOM 120915 . 121965) (MAKENEWCOM 121967 . 123810) 
+(DEFAULTMAKENEWCOM 123812 . 125332)) (125404 128221 (MERGEINSERT 125414 . 127757) (MERGEINSERT1 127759
+ . 128219)) (128375 129732 (ADDTOFILEKEYLST 128385 . 129730)) (129849 140761 (DELFROMFILES 129859 . 
+130709) (DELFROMCOMS 130711 . 132390) (DELFROMCOM 132392 . 138260) (DELFROMCOM1 138262 . 139059) (
+REMOVEITEM 139061 . 139935) (MOVETOFILE 139937 . 140759)) (140975 143344 (SAVEPUT 140985 . 143342)) (
+143469 151793 (UNMARKASCHANGED 143479 . 145187) (PREEDITFN 145189 . 147700) (POSTEDITPROPS 147702 . 
+150203) (POSTEDITALISTS 150205 . 151791)) (151942 172496 (ALISTS.GETDEF 151952 . 152331) (
+ALISTS.WHENCHANGED 152333 . 152977) (CLEARCLISPARRAY 152979 . 154153) (EXPRESSIONS.WHENCHANGED 154155
+ . 154529) (MAKEALISTCOMS 154531 . 155604) (MAKEFILESCOMS 155606 . 157043) (MAKELISPXMACROSCOMS 157045
+ . 159063) (MAKEPROPSCOMS 159065 . 159763) (MAKEUSERMACROSCOMS 159765 . 161565) (PROPS.WHENCHANGED 
+161567 . 162188) (FILEGETDEF.LISPXMACROS 162190 . 163632) (FILEGETDEF.ALISTS 163634 . 164253) (
+FILEGETDEF.RECORDS 164255 . 165186) (FILEGETDEF.PROPS 165188 . 165980) (FILEGETDEF.MACROS 165982 . 
+167042) (FILEGETDEF.VARS 167044 . 167460) (FILEGETDEF.FNS 167462 . 168826) (FILEPKGCOMS.PUTDEF 168828
+ . 171268) (FILES.PUTDEF 171270 . 172227) (VARS.PUTDEF 172229 . 172372) (FILES.WHENCHANGED 172374 . 
+172494)) (174518 181951 (RENAME 174528 . 175929) (CHANGECALLERS 175931 . 181949)) (181952 229900 (
+SHOWDEF 181962 . 182755) (COPYDEF 182757 . 185231) (GETDEF 185233 . 187509) (GETDEFCOM 187511 . 188477
+) (GETDEFCOM0 188479 . 189825) (GETDEFCURRENT 189827 . 196247) (GETDEFERR 196249 . 197550) (
+GETDEFFROMFILE 197552 . 201832) (GETDEFSAVED 201834 . 202938) (PUTDEF 202940 . 203643) (EDITDEF 203645
+ . 204622) (DEFAULT.EDITDEF 204624 . 207460) (EDITDEF.FILES 207462 . 207663) (LOADDEF 207665 . 207841)
+ (DWIMDEF 207843 . 208697) (DELDEF 208699 . 211713) (DELFROMLIST 211715 . 212219) (HASDEF 212221 . 
+218543) (GETFILEDEF 218545 . 219067) (SAVEDEF 219069 . 220728) (UNSAVEDEF 220730 . 221626) (
+COMPAREDEFS 221628 . 224930) (COMPARE 224932 . 225636) (TYPESOF 225638 . 229898)) (229967 235010 (
+FIXEDITDATE 229977 . 233480) (EDITDATE? 233482 . 235008)) (235429 244200 (FILEPKGCOM 235439 . 240372) 
+(FILEPKGTYPE 240374 . 244198)) (256237 271169 (FINDCALLERS 256247 . 256762) (EDITCALLERS 256764 . 
+264674) (EDITFROMFILE 264676 . 270484) (FINDATS 270486 . 270758) (LOOKIN 270760 . 271167)) (271170 
+272897 (SEPRCASE 271180 . 272895)) (273414 278971 (IMPORTFILE 273424 . 274398) (IMPORTEVAL 274400 . 
+275280) (IMPORTFILESCAN 275282 . 275703) (CHECKIMPORTS 275705 . 277041) (GATHEREXPORTS 277043 . 278381
+) (\DUMPEXPORTS 278383 . 278969)) (279309 281517 (CLEARFILEPKG 279319 . 281515)))))
 STOP

sources/FILESETS

@@ -1,11 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "25-Jun-2021 10:21:40" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;6
 6395   
+
(FILECREATED "11-Sep-2021 00:01:52" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;10
 6469   
 
-      changes to%:  (VARS 0LISPSET)
+      changes to%:  (VARS MAKEINITTYPES 0LISPSET EXPORTFILES)
 
-      previous date%: "19-Jun-2021 12:13:31" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;5)
+      previous date%: "10-Sep-2021 19:53:14" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;8)
 
 
 (* ; "
@@ -17,13 +17,13 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
 (RPAQQ FILESETSCOMS

        (
 
-(* ;;; "contains all of the lists of files which are used in various ways")

+(* ;;; "contains all of the lists of files which are used in various ways")

 
         
-        (* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC.  -- Pavel")

+        (* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC.  -- Pavel")

 
         
-        (* ;; "The file with the default EXTERNALFORMAT should come right after FILEIO, and particularly before ATERM.")

+        (* ;; "The file with the default EXTERNALFORMAT should come right after FILEIO, and particularly before ATERM.")

 
         (VARS * FILESETS)
         (VARS EXPORTFILES)
@@ -51,10 +51,10 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
 
 (RPAQQ FILESETS
 (0LISPSET 1LISPSET 2LISPSET 3LISPSET))
 
-(RPAQQ 0LISPSET
 (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO IMAGEIO LLBASIC LLGC
-                           LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS 
-                           LLARITH LLFLOAT LLBIGNUM LLREAD XCCS LLCHAR LLSTK LLDATATYPE IOCHAR LLKEY
-                           LLTIMER))
+(RPAQQ 0LISPSET
 (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO EXTERNALFORMAT 
+                           IMAGEIO LLBASIC LLGC LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME 
+                           SETF-RUNTIME CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD XCCS LLCHAR 
+                           LLSTK LLDATATYPE IOCHAR LLKEY LLTIMER))
 
 (RPAQQ 1LISPSET

        (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC 
@@ -69,17 +69,17 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
 
 (RPAQQ EXPORTFILES

        (MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR
-              LLSTK PMAP LLGC ATBL FILEIO LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT 
-              RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER IMAGEIO PROC XCCS 
-              LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS))
+              LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY 
+              ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER 
+              IMAGEIO PROC XCCS LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS))
 
 (RPAQQ MAKEINITFILES
 (MAKEINIT MEM I-NEW))
 
 (RPAQQ MAKEINITTYPES

        ((NIL INIT (0 1)
              2LISPSET 1600)
-        (SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO LLBASIC LLGC LLINTERP LLARITH LLREAD 
-                                    LLCHAR TINYPATCH))
+        (SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO EXTERNALFORMAT LLBASIC LLGC LLINTERP 
+                                    LLARITH LLREAD LLCHAR TINYPATCH))
         (MACROTEST MACROTEST ((MACROTEST)
                               0 1)
                2LISPSET)
@@ -114,7 +114,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
            (COMSNAME . RDCOMS)
            (EXTRACOMS 
 
-                  (* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)")

+                  (* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)")

 
                   (FILES VMEM)
                   (VARS RDVALS RDPTRS)

sources/FONTPROFILE

@@ -1,103 +1,103 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "28-Jun-99 22:10:46" {DSK}<project>medley3.5>sources>FONTPROFILE.;2
 29960  
+
(FILECREATED " 6-Sep-2021 19:11:32" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;4
 30288  
 
-      changes to%:  (VARS FONTPROFILECOMS)
-                    (ALISTS (FONTDEFS NS)
-                           (FONTDEFS BIGGERNS))
+      changes to%:  (ALISTS (FONTDEFS BIGGERNS))
 
-      previous date%: " 9-Jul-91 18:38:04" {DSK}<project>medley3.5>sources>FONTPROFILE.;1)
+      previous date%: " 6-Sep-2021 15:52:13" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;2)
 
 
 (* ; "
-Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT FONTPROFILECOMS)
 
 (RPAQQ FONTPROFILECOMS

        (
-        (* ;; "FONT")

+        (* ;; "FONT")

 
         (ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER NS BIGGERNS))
         (ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
         [VARS (FONTVARS '(
-                          (* ;; "standard size fonts. Assumes only DEFAULTFONT set")

+                          (* ;; "standard size fonts. Assumes only DEFAULTFONT set")

 
                           (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
-                                                             (* ; "default  BOLD")

+                                                             (* ; "default  BOLD")

                           (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
                           (LITTLEFONT DEFAULTFONT)
-                                                             (* ; " should usually be smaller")

+                                                             (* ; " should usually be smaller")

                           (TINYFONT LITTLEFONT)
-                                                             (* ; "and this one smaller still")

+                                                             (* ; "and this one smaller still")

                           (BIGFONT BOLDFONT)
-                                                             (* ; "should be bigger still")

+                                                             (* ; "should be bigger still")

                           (TEXTFONT DEFAULTFONT)
-                                                             (* ; "default for text")

+                                                             (* ; "default for text")

                           (TEXTBOLDFONT BOLDFONT)
-                                                             (* ; "default for bold text")

+                                                             (* ; "default for bold text")

                           
-                          (* ;; "")

+                          (* ;; "")

 
                           
-                          (* ;; "Fonts for window system, processes")

+                          (* ;; "Fonts for window system, processes")

 
                           
-                          (* ;; "")

+                          (* ;; "")

 
                           (MENUFONT DEFAULTFONT T)
                           (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
-                                                             (* ; "if not supplied")

+                                                             (* ; "if not supplied")

                           (INTERRUPTMENUFONT DEFAULTFONT T)
-                                                             (* ; "used by control-B")

+                                                             (* ; "used by control-B")

                           (DEFAULTICONFONT MENUFONT)
-                                                             (* ; "for shrinking windows")

+                                                             (* ; "for shrinking windows")

                           (BACKTRACEFONT TINYFONT T)
-                                                             (* ; " for backtrace in debugger")

+                                                             (* ; " for backtrace in debugger")

                           (WINDOWTITLEFONT MENUFONT)
                           ((WINDOWTITLEFONT WINDOWTITLEFONT)
                            NIL)
-                                                             (* ; " used for titles of all windows")

+                                                             (* ; " used for titles of all windows")

                           
-                          (* ;; "")

+                          (* ;; "")

 
                           
-                          (* ;; "Fonts for Exec")

+                          (* ;; "Fonts for Exec")

 
                           
-                          (* ;; "")

+                          (* ;; "")

 
                           (PROMPTFONT LITTLEFONT)
-                                                             (* ; "for printing out prompts")

+                                                             (* ; "for printing out prompts")

                           (INPUTFONT BOLDFONT)
-                                                             (* ; "for user typein in Exec")

+                                                             (* ; "for user typein in Exec")

                           (PRINTOUTFONT DEFAULTFONT)
-                                                             (* ; " for intermediate typin in Exec")

+                                                             (* ; " for intermediate typin in Exec")

                           (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
                           (VALUEFONT DEFAULTFONT)
-                                                             (* ; 
-
                                                        " for printing out values returned in Exec")

+                                                             (* ; 
+
                                                        " for printing out values returned in Exec")

                           
-                          (* ;; "")

+                          (* ;; "")

 
                           
-                          (* ;; "Fonts for prettyprinting")

+                          (* ;; "Fonts for prettyprinting")

 
                           
-                          (* ;; "")

+                          (* ;; "")

 
                           (COMMENTFONT LITTLEFONT)
-                                                             (* ; "for comments ")

+                                                             (* ; "for comments ")

                           (PRETTYCOMFONT BOLDFONT)
-                                                             (* ; " for words being defined")

+                                                             (* ; " for words being defined")

                           (CLISPFONT BOLDFONT)
-                                                             (* ; " for keywords & CLISP")

+                                                             (* ; " for keywords & CLISP")

                           (SYSTEMFONT DEFAULTFONT)
-                                                             (* ; " for %"system%" words(?)")

+                                                             (* ; " for %"system%" words(?)")

                           (LAMBDAFONT BIGFONT)
-                                                             (* ; "for words being defined")

+                                                             (* ; "for words being defined")

                           (USERFONT BOLDFONT)
-                                                             (* ; " for %"user%" defined words")
]
+                                                             (* ; " for %"user%" defined words")
]
         (P (MOVD? 'NILL 'WINDOWTITLEFONT))
         (FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE)
         (INITVARS (FONTESCAPECHAR (CHARACTER 6))
@@ -242,7 +242,11 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation.  All ri
                             (MODERN 8 MIR))
                      (BIGFONT 4 (MODERN 12 BRR)
                             (MODERN 10 BRR)
-                            (MODERN 10 BRR]
+                            (MODERN 10 BRR))
+                     (MENUFONT 5 (MODERN 10))
+                     (COMMENTFONT 6 (MODERN 8)
+                            (MODERN 6 MIR)
+                            (MODERN 8 MIR]
           [BIGGERNS (FONTCHANGEFLG . ALL)
                  (FILELINELENGTH . 102)
                  (COMMENTLINELENGTH 116 . 126)
@@ -263,89 +267,93 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation.  All ri
                                (MODERN 8 MIR))
                         (BIGFONT 4 (MODERN 14 BRR)
                                (MODERN 10 BRR)
-                               (MODERN 10 BRR])
+                               (MODERN 10 BRR))
+                        (MENUFONT 5 (MODERN 12))
+                        (COMMENTFONT 6 (MODERN 10)
+                               (MODERN 8 MIR)
+                               (MODERN 10 MIR])
 
 (ADDTOVAR CACHEDMENUS
 BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
 
 (RPAQQ FONTVARS

        (
-        (* ;; "standard size fonts. Assumes only DEFAULTFONT set")

+        (* ;; "standard size fonts. Assumes only DEFAULTFONT set")

 
         (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
-                                                             (* ; "default  BOLD")

+                                                             (* ; "default  BOLD")

         (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
         (LITTLEFONT DEFAULTFONT)
-                                                             (* ; " should usually be smaller")

+                                                             (* ; " should usually be smaller")

         (TINYFONT LITTLEFONT)
-                                                             (* ; "and this one smaller still")

+                                                             (* ; "and this one smaller still")

         (BIGFONT BOLDFONT)
-                                                             (* ; "should be bigger still")

+                                                             (* ; "should be bigger still")

         (TEXTFONT DEFAULTFONT)
-                                                             (* ; "default for text")

+                                                             (* ; "default for text")

         (TEXTBOLDFONT BOLDFONT)
-                                                             (* ; "default for bold text")

+                                                             (* ; "default for bold text")

         
-        (* ;; "")

+        (* ;; "")

 
         
-        (* ;; "Fonts for window system, processes")

+        (* ;; "Fonts for window system, processes")

 
         
-        (* ;; "")

+        (* ;; "")

 
         (MENUFONT DEFAULTFONT T)
         (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
-                                                             (* ; "if not supplied")

+                                                             (* ; "if not supplied")

         (INTERRUPTMENUFONT DEFAULTFONT T)
-                                                             (* ; "used by control-B")

+                                                             (* ; "used by control-B")

         (DEFAULTICONFONT MENUFONT)
-                                                             (* ; "for shrinking windows")

+                                                             (* ; "for shrinking windows")

         (BACKTRACEFONT TINYFONT T)
-                                                             (* ; " for backtrace in debugger")

+                                                             (* ; " for backtrace in debugger")

         (WINDOWTITLEFONT MENUFONT)
         ((WINDOWTITLEFONT WINDOWTITLEFONT)
          NIL)
-                                                             (* ; " used for titles of all windows")

+                                                             (* ; " used for titles of all windows")

         
-        (* ;; "")

+        (* ;; "")

 
         
-        (* ;; "Fonts for Exec")

+        (* ;; "Fonts for Exec")

 
         
-        (* ;; "")

+        (* ;; "")

 
         (PROMPTFONT LITTLEFONT)
-                                                             (* ; "for printing out prompts")

+                                                             (* ; "for printing out prompts")

         (INPUTFONT BOLDFONT)
-                                                             (* ; "for user typein in Exec")

+                                                             (* ; "for user typein in Exec")

         (PRINTOUTFONT DEFAULTFONT)
-                                                             (* ; " for intermediate typin in Exec")

+                                                             (* ; " for intermediate typin in Exec")

         (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
         (VALUEFONT DEFAULTFONT)
-                                                             (* ; 
-
                                                        " for printing out values returned in Exec")

+                                                             (* ; 
+
                                                        " for printing out values returned in Exec")

         
-        (* ;; "")

+        (* ;; "")

 
         
-        (* ;; "Fonts for prettyprinting")

+        (* ;; "Fonts for prettyprinting")

 
         
-        (* ;; "")

+        (* ;; "")

 
         (COMMENTFONT LITTLEFONT)
-                                                             (* ; "for comments ")

+                                                             (* ; "for comments ")

         (PRETTYCOMFONT BOLDFONT)
-                                                             (* ; " for words being defined")

+                                                             (* ; " for words being defined")

         (CLISPFONT BOLDFONT)
-                                                             (* ; " for keywords & CLISP")

+                                                             (* ; " for keywords & CLISP")

         (SYSTEMFONT DEFAULTFONT)
-                                                             (* ; " for %"system%" words(?)")

+                                                             (* ; " for %"system%" words(?)")

         (LAMBDAFONT BIGFONT)
-                                                             (* ; "for words being defined")

+                                                             (* ; "for words being defined")

         (USERFONT BOLDFONT)
-                                                             (* ; " for %"user%" defined words")
))
+                                                             (* ; " for %"user%" defined words")
))
 
 (MOVD? 'NILL 'WINDOWTITLEFONT)
 (DEFINEQ
@@ -591,8 +599,8 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation.  All ri
 
 (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
        1 FILERDTBL)
-(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999))
+(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (16000 27584 (FONTSET 16010 . 22351) (FONTPROFILE 22353 . 24702) (FONTPROFILE.ADDDEVICE 
-24704 . 27582)) (27820 29719 (FONTMAPARRAY 27830 . 29717)))))
+  (FILEMAP (NIL (16323 27907 (FONTSET 16333 . 22674) (FONTPROFILE 22676 . 25025) (FONTPROFILE.ADDDEVICE 
+25027 . 27905)) (28143 30042 (FONTMAPARRAY 28153 . 30040)))))
 STOP

sources/FONTPROFILEPATCH

@@ -1,608 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "12-Mar-93 11:02:28" {DSK}<project>medley2.0>patches>FONTPROFILEPATCH.;4
 30621  
-
-      changes to%:  (ALISTS (FONTDEFS HUGE)
-                           (FONTDEFS BIG)
-                           (FONTDEFS MEDIUM)
-                           (FONTDEFS STANDARD)
-                           (FONTDEFS BIGGER)
-                           (FONTDEFS BIGGERNS)
-                           (FONTDEFS NS))
-
-      previous date%: "11-Mar-93 11:51:49" {DSK}<project>medley2.0>patches>FONTPROFILEPATCH.;3)
-
-
-(* ; "
-Copyright (c) 1993 by Xerox Corporation.  All rights reserved.
-")
-
-(PRETTYCOMPRINT FONTPROFILEPATCHCOMS)
-
-(RPAQQ FONTPROFILEPATCHCOMS

-       (
-        (* ;; "FONT")

-
-        (ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER BIGGERNS NS))
-        (ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
-        [VARS (FONTVARS '(
-                          (* ;; "standard size fonts. Assumes only DEFAULTFONT set")

-
-                          (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
-                                                             (* ; "default  BOLD")

-                          (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
-                          (LITTLEFONT DEFAULTFONT)
-                                                             (* ; " should usually be smaller")

-                          (TINYFONT LITTLEFONT)
-                                                             (* ; "and this one smaller still")

-                          (BIGFONT BOLDFONT)
-                                                             (* ; "should be bigger still")

-                          (TEXTFONT DEFAULTFONT)
-                                                             (* ; "default for text")

-                          (TEXTBOLDFONT BOLDFONT)
-                                                             (* ; "default for bold text")

-                          
-                          (* ;; "")

-
-                          
-                          (* ;; "Fonts for window system, processes")

-
-                          
-                          (* ;; "")

-
-                          (MENUFONT DEFAULTFONT T)
-                          (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
-                                                             (* ; "if not supplied")

-                          (INTERRUPTMENUFONT DEFAULTFONT T)
-                                                             (* ; "used by control-B")

-                          (DEFAULTICONFONT MENUFONT)
-                                                             (* ; "for shrinking windows")

-                          (BACKTRACEFONT TINYFONT T)
-                                                             (* ; " for backtrace in debugger")

-                          (WINDOWTITLEFONT MENUFONT)
-                          ((WINDOWTITLEFONT WINDOWTITLEFONT)
-                           NIL)
-                                                             (* ; " used for titles of all windows")

-                          
-                          (* ;; "")

-
-                          
-                          (* ;; "Fonts for Exec")

-
-                          
-                          (* ;; "")

-
-                          (PROMPTFONT LITTLEFONT)
-                                                             (* ; "for printing out prompts")

-                          (INPUTFONT BOLDFONT)
-                                                             (* ; "for user typein in Exec")

-                          (PRINTOUTFONT DEFAULTFONT)
-                                                             (* ; " for intermediate typin in Exec")

-                          (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
-                          (VALUEFONT DEFAULTFONT)
-                                                             (* ; 
-
                                                        " for printing out values returned in Exec")

-                          
-                          (* ;; "")

-
-                          
-                          (* ;; "Fonts for prettyprinting")

-
-                          
-                          (* ;; "")

-
-                          (COMMENTFONT LITTLEFONT)
-                                                             (* ; "for comments ")

-                          (PRETTYCOMFONT BOLDFONT)
-                                                             (* ; " for words being defined")

-                          (CLISPFONT BOLDFONT)
-                                                             (* ; " for keywords & CLISP")

-                          (SYSTEMFONT DEFAULTFONT)
-                                                             (* ; " for %"system%" words(?)")

-                          (LAMBDAFONT BIGFONT)
-                                                             (* ; "for words being defined")

-                          (USERFONT BOLDFONT)
-                                                             (* ; " for %"user%" defined words")
]
-        (P (MOVD? 'NILL 'WINDOWTITLEFONT))
-        (FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE)
-        (INITVARS (FONTESCAPECHAR (CHARACTER 6))
-               (FONTFNS)
-               (FONTWORDS))
-        [DECLARE%: DONTEVAL@LOAD DOCOPY (P (FONTSET 'STANDARD]
-        (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS)
-        (FNS FONTMAPARRAY)
-        (INITVARS (\FONTMAPCACHE))
-        (P (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
-                  1 FILERDTBL))))
-
-
-
-(* ;; "FONT")

-
-
-(ADDTOVAR FONTDEFS

-          [HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24)
-                                    NIL
-                                    (TERMINAL 8))
-                       (BOLDFONT 2 (MODERN 24 BRR)
-                              NIL
-                              (MODERN 8 BRR))
-                       (LITTLEFONT 3 (MODERN 18 MRR)
-                              NIL
-                              (MODERN 8 MIR))
-                       (BIGFONT 4 (MODERN 36 BRR)
-                              NIL
-                              (MODERN 10 BRR))
-                       (TEXTFONT 5 (CLASSIC 24)
-                              NIL
-                              (CLASSIC 10))
-                       (TEXTBOLDFONT 7 (CLASSIC 24 BRR)
-                              NIL
-                              (CLASSIC 10 BRR]
-          [BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18)
-                                   NIL
-                                   (TERMINAL 8))
-                      (TEXTFONT 5 (CLASSIC 18)
-                             NIL
-                             (CLASSIC 10))
-                      (BOLDFONT 2 (MODERN 18 BRR)
-                             NIL
-                             (MODERN 8 BRR))
-                      (LITTLEFONT 3 (MODERN 12 MRR)
-                             NIL
-                             (MODERN 8 MIR))
-                      (BIGFONT 4 (MODERN 24 BRR)
-                             NIL
-                             (MODERN 10 BRR))
-                      (TEXTBOLDFONT 7 (CLASSIC 18 BRR)
-                             NIL
-                             (CLASSIC 10 BRR]
-          [MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14)
-                                      NIL
-                                      (TERMINAL 8))
-                         (BOLDFONT 2 (MODERN 14 BRR)
-                                NIL
-                                (MODERN 8 BRR))
-                         (LITTLEFONT 3 (MODERN 10)
-                                NIL
-                                (MODERN 8 MIR))
-                         (BIGFONT 4 (MODERN 18)
-                                NIL
-                                (MODERN 10 BRR))
-                         (TEXTFONT 5 (CLASSIC 14)
-                                NIL
-                                (CLASSIC 10))
-                         (TEXTBOLDFONT 7 (CLASSIC 14 BRR)
-                                NIL
-                                (CLASSIC 10 BRR]
-          [STANDARD (FONTCHANGEFLG . ALL)
-                 (FILELINELENGTH . 102)
-                 (FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
-                                     (GACHA 8)
-                                     (TERMINAL 8))
-                        (ITALICFONT 1 (HELVETICA 10 MIR)
-                               (GACHA 8 MIR)
-                               (MODERN 8 MIR))
-                        (BOLDFONT 2 (HELVETICA 10 BRR)
-                               (HELVETICA 8 BRR)
-                               (MODERN 8 BRR))
-                        (LITTLEFONT 3 (HELVETICA 8)
-                               (HELVETICA 6 MIR)
-                               (MODERN 8 MIR))
-                        (TINYFONT 6 (GACHA 8)
-                               (GACHA 6)
-                               (TERMINAL 6))
-                        (BIGFONT 4 (HELVETICA 12 BRR)
-                               NIL
-                               (MODERN 10 BRR))
-                        (MENUFONT 5 (HELVETICA 10))
-                        (COMMENTFONT 6 (HELVETICA 10)
-                               (HELVETICA 8)
-                               (MODERN 8))
-                        (TEXTFONT 7 (TIMESROMAN 10)
-                               NIL
-                               (CLASSIC 10]
-          [BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
-                                      NIL
-                                      (TERMINAL 8))
-                         (ITALICFONT 1 (HELVETICA 12 MIR)
-                                (GACHA 8 MIR)
-                                (MODERN 8 MIR))
-                         (BOLDFONT 2 (HELVETICA 12 BRR)
-                                (HELVETICA 8 BRR)
-                                (MODERN 8 BRR))
-                         (LITTLEFONT 3 (HELVETICA 10)
-                                (HELVETICA 6 MIR)
-                                (MODERN 8 MIR))
-                         (TINYFONT 6 (GACHA 10)
-                                (GACHA 6)
-                                (TERMINAL 6))
-                         (BIGFONT 4 (HELVETICA 14 BRR)
-                                NIL
-                                (MODERN 10 BRR))
-                         (MENUFONT 5 (HELVETICA 12))
-                         (COMMENTFONT 6 (HELVETICA 12)
-                                (HELVETICA 8)
-                                (MODERN 8))
-                         (TEXTFONT 7 (TIMESROMAN 12)
-                                NIL
-                                (CLASSIC 10]
-          [BIGGERNS (FONTCHANGEFLG . ALL)
-                 (FILELINELENGTH . 102)
-                 (COMMENTLINELENGTH 116 . 126)
-                 (FIRSTCOL . 60)
-                 (PRETTYLCOM . 25)
-                 (FONTESCAPECHAR . %)
-                 (FONTPROFILE (DEFAULTFONT 1 (TERMINAL 12)
-                                     (TERMINAL 8)
-                                     (TERMINAL 8))
-                        (ITALICFONT 1 (MODERN 12 BIR)
-                               (MODERN 8 BIR)
-                               (MODERN 8 BIR))
-                        (BOLDFONT 2 (MODERN 12 BRR)
-                               (MODERN 8 BRR)
-                               (MODERN 8 BRR))
-                        (LITTLEFONT 3 (MODERN 10)
-                               (MODERN 6 MIR)
-                               (MODERN 8 MIR))
-                        (BIGFONT 4 (MODERN 14 BRR)
-                               (MODERN 10 BRR)
-                               (MODERN 10 BRR]
-          [NS (FONTCHANGEFLG . ALL)
-              (FILELINELENGTH . 102)
-              (COMMENTLINELENGTH 116 . 126)
-              (FIRSTCOL . 60)
-              (PRETTYLCOM . 25)
-              (FONTESCAPECHAR . %)
-              (FONTPROFILE (DEFAULTFONT 1 (TERMINAL 10)
-                                  (TERMINAL 8)
-                                  (TERMINAL 8))
-                     (ITALICFONT 1 (MODERN 10 BIR)
-                            (MODERN 8 BIR)
-                            (MODERN 8 BIR))
-                     (BOLDFONT 2 (MODERN 10 BRR)
-                            (MODERN 8 BRR)
-                            (MODERN 8 BRR))
-                     (LITTLEFONT 3 (MODERN 8)
-                            (MODERN 6 MIR)
-                            (MODERN 8 MIR))
-                     (BIGFONT 4 (MODERN 12 BRR)
-                            (MODERN 10 BRR)
-                            (MODERN 10 BRR])
-
-(ADDTOVAR CACHEDMENUS
 BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
-
-(RPAQQ FONTVARS

-       (
-        (* ;; "standard size fonts. Assumes only DEFAULTFONT set")

-
-        (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
-                                                             (* ; "default  BOLD")

-        (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
-        (LITTLEFONT DEFAULTFONT)
-                                                             (* ; " should usually be smaller")

-        (TINYFONT LITTLEFONT)
-                                                             (* ; "and this one smaller still")

-        (BIGFONT BOLDFONT)
-                                                             (* ; "should be bigger still")

-        (TEXTFONT DEFAULTFONT)
-                                                             (* ; "default for text")

-        (TEXTBOLDFONT BOLDFONT)
-                                                             (* ; "default for bold text")

-        
-        (* ;; "")

-
-        
-        (* ;; "Fonts for window system, processes")

-
-        
-        (* ;; "")

-
-        (MENUFONT DEFAULTFONT T)
-        (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
-                                                             (* ; "if not supplied")

-        (INTERRUPTMENUFONT DEFAULTFONT T)
-                                                             (* ; "used by control-B")

-        (DEFAULTICONFONT MENUFONT)
-                                                             (* ; "for shrinking windows")

-        (BACKTRACEFONT TINYFONT T)
-                                                             (* ; " for backtrace in debugger")

-        (WINDOWTITLEFONT MENUFONT)
-        ((WINDOWTITLEFONT WINDOWTITLEFONT)
-         NIL)
-                                                             (* ; " used for titles of all windows")

-        
-        (* ;; "")

-
-        
-        (* ;; "Fonts for Exec")

-
-        
-        (* ;; "")

-
-        (PROMPTFONT LITTLEFONT)
-                                                             (* ; "for printing out prompts")

-        (INPUTFONT BOLDFONT)
-                                                             (* ; "for user typein in Exec")

-        (PRINTOUTFONT DEFAULTFONT)
-                                                             (* ; " for intermediate typin in Exec")

-        (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
-        (VALUEFONT DEFAULTFONT)
-                                                             (* ; 
-
                                                        " for printing out values returned in Exec")

-        
-        (* ;; "")

-
-        
-        (* ;; "Fonts for prettyprinting")

-
-        
-        (* ;; "")

-
-        (COMMENTFONT LITTLEFONT)
-                                                             (* ; "for comments ")

-        (PRETTYCOMFONT BOLDFONT)
-                                                             (* ; " for words being defined")

-        (CLISPFONT BOLDFONT)
-                                                             (* ; " for keywords & CLISP")

-        (SYSTEMFONT DEFAULTFONT)
-                                                             (* ; " for %"system%" words(?)")

-        (LAMBDAFONT BIGFONT)
-                                                             (* ; "for words being defined")

-        (USERFONT BOLDFONT)
-                                                             (* ; " for %"user%" defined words")
))
-
-(MOVD? 'NILL 'WINDOWTITLEFONT)
-(DEFINEQ
-
-(FONTSET

-  [LAMBDA (NAME CHANGE-WINDOWS?)                             (* ; "Edited 23-Jun-88 10:46 by jds")

-    (COND
-       [NAME
-        (LET
-         [(TEM (FASSOC NAME FONTDEFS))
-          (OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY]
-         (OR TEM (ERROR NAME "not a defined font configuration"))
-
-         (* ;; "Looks up NAME on FONTSLST and sets apropriate parameters.  entries are added to fontslst by FONTNAME.")

-
-         (for
 X in
 FONTVARS when
 (AND (CL:SYMBOLP (CAR X))
-                                                  (NEQ (CAR X)
-                                                       '*)
-                                                  (NEQ (CAR X)
-                                                       (CADR X))) do
 (SETTOPVAL (CAR X)))
-         [MAPC (CDR TEM)
-               (FUNCTION (LAMBDA (X)
-                           (/SETTOPVAL (CAR X)
-                                  (CDR X]
-         [PROG (BASICCLASSES)
-               (for
 X in
 FONTPROFILE
-                  do
 (PROG (SEEN (NAME (CAR X))
-                                     (FONTS X))
-                           LP  [COND
-                                  ((MEMB (CAR FONTS)
-                                         SEEN)
-                                   (ERROR "Circular font profile specification" X))
-                                  (T (push
 SEEN (CAR FONTS]
-                               [SETQ FONTS (CDR (COND
-                                                   ((OR (NULL (CADR FONTS))
-                                                        (LISTP (CADR FONTS)))
-                                                             (*)

-                                                             (* ; 
-
                                   "This skips over the now-defunct NIL or list-of-escape sequence")

-                                                    (CDR FONTS))
-                                                   (T FONTS]
-                               (COND
-                                  ((OR (NLISTP FONTS)
-                                       (LITATOM (CAR FONTS)))(* ; 
-
                                                           "Indirect thru another's font spec")

-                                   (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
-                                                               ((NIL DEFAULTFONT) 
-                                                             (* ; 
-
                                                           "Don't let DEFAULTFONT loop thru itself")

-                                                                    (AND (NOT (MEMB 'DEFAULTFONT SEEN
-                                                                                    ))
-                                                                         'DEFAULTFONT))
-                                                               (CAR FONTS))
-                                                           FONTPROFILE))
-                                        (GO LP)))
-                                  (T [push
 BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS
-                                                                               'DISPLAY]
-                                                             (* ; 
-
                                                           "Now we have a font class datastructure")

-                                     ))
-                               (AND NAME (/SETTOPVAL NAME FONTS))
-
-                          (* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")

-
-                           ))
-               (AND BASICCLASSES (FONTMAPARRAY
 BASICCLASSES 'DISPLAY]
-         [for
 X in
 FONTVARS when
 (NEQ (CAR X)
-                                                  '*)
-            do
 (COND
-                      ((LISTP (CAR X))
-                       (EVAL (CAR X)))
-                      [(CADDR X)
-                       (SET (CAR X)
-                            (FONTCREATE (OR (GETTOPVAL (CAR X))
-                                            (EVAL (CADR X))
-                                            DEFAULTFONT)
-                                   NIL NIL NIL 'DISPLAY]
-                      (T (OR (GETTOPVAL (CAR X))
-                             (AND (CADR X)
-                                  (SET (CAR X)
-                                       (EVAL (CADR X]
-         (CL:WHEN CHANGE-WINDOWS?
-             (CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY))
-                 (for
 X in
 (OPENWINDOWS) when
 (EQ OLDDEFAULT (DSPFONT NIL X))
-                    do
 (DSPFONT DEFAULTFONT X)))
-             (DSPFONT WINDOWTITLEFONT WindowTitleDisplayStream)
-             (SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT)))
-             (MAPC CACHEDMENUS 'SET)
-             [for
 W in
 (OPENWINDOWS) do
 [COND
-                                                       [(OR (EQ (WINDOWPROP W 'RESHAPEFN)
-                                                                'DONT)
-                                                            (WINDOWPROP W 'MAINWINDOW]
-                                                       (T 
-                                                          (* ;; 
-
                                 "don't reshape if can't or if this window is attached to another.")

-
-                                                          (SHAPEW W (WINDOWREGION W]
-                                                   (COND
-                                                      ((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
-                                                                 (FUNCTION \TEDIT.PROCIDLEFN))
-                                                            (WINDOWPROP W 'REPAINTFN))
-                                                       (REDISPLAYW W])
-
-         (* ;; "Set the new font profile name, and return the old one, so he can restore later.")

-
-         (PROG1 FONTNAME (SETQ FONTNAME NAME]
-       (T                                                    (* ; 
-
                                         "He passed in NIL, so return font profile name in effect.")

-          FONTNAME])
-
-(FONTPROFILE

-  [LAMBDA (PROFILE)                                          (* lmm "10-Sep-86 12:33")

-    [PROG (BASICCLASSES)
-          (for
 X in
 PROFILE
-             do
 (PROG (SEEN (NAME (CAR X))
-                                (FONTS X))
-                      LP  [COND
-                             ((MEMB (CAR FONTS)
-                                    SEEN)
-                              (ERROR "Circular font profile specification" X))
-                             (T (push
 SEEN (CAR FONTS]
-                          [SETQ FONTS (CDR (COND
-                                              ((OR (NULL (CADR FONTS))
-                                                   (LISTP (CADR FONTS)))
-                                                             (* ; 
-
                                   "This skips over the now-defunct NIL or list-of-escape sequence")

-                                               (CDR FONTS))
-                                              (T FONTS]
-                          (COND
-                             ((OR (NLISTP FONTS)
-                                  (LITATOM (CAR FONTS)))     (* Indirect thru another's font spec)

-                              (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
-                                                          ((NIL DEFAULTFONT) 
-                                                             (* Don't let DEFAULTFONT loop thru 
-
                                                           itself)

-                                                               (AND (NOT (MEMB 'DEFAULTFONT SEEN))
-                                                                    'DEFAULTFONT))
-                                                          (CAR FONTS))
-                                                      PROFILE))
-                                   (GO LP)))
-                             (T [push
 BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY]
-                                                             (* Now we have a font class 
-
                                                           datastructure)

-                                ))
-                          (AND NAME (/SETATOMVAL NAME FONTS))
-
-         (* NIL for the class-name means just establish the font-correspondences but 
-
       don't connect them up with a pretty class name.)

-
-                      ))
-          (AND BASICCLASSES (FONTMAPARRAY
 BASICCLASSES 'DISPLAY]
-    T])
-
-(FONTPROFILE.ADDDEVICE

-  [LAMBDA (NEWDEVICE OLDDEVICE)
                          (* ; "Edited  3-Mar-93 14:46 by rmk:")

-
-    (* ;; "Fills in all fontprofile specifications so that an entry for NEWDEVICE is present for each fontclass.  Nothing is changed if the entry is already there, otherwise the specification for the class currently provided for OLDDEVICE will be used for NEWDEVICE.")

-
-    (DECLARE
 (USEDFREE FONTDEFS FONTNAME))
-    (SETQ NEWDEVICE (U-CASE NEWDEVICE))
-    (SETQ OLDDEVICE (U-CASE OLDDEVICE))
-    [FOR
 FD IN
 FONTDEFS
-       DO
 (FOR
 FC OLDSPEC IN
 (CDR (ASSOC 'FONTPROFILE (CDR FD)))
-                 UNLESS
 (LITATOM (CADR FC))
-                 DO
 (SETQ FC (CDR FC))                   (* ; "Skip over name")

-                       (CL:WHEN [SETQ OLDSPEC (SELECTQ OLDDEVICE
-                                                  (DISPLAY (CADR FC))
-                                                  (INTERPRESS (CADDDR FC))
-                                                  (PRESS (CADDR FC))
-                                                  (CADR (ASSOC OLDDEVICE (CDDDDR FC]
-                           [SETQ FC (OR (CDR FC)
-                                        (CDR (RPLACD FC (CONS]
-                                                             (* ; 
-
                                          "Fill in NIL's for missing DISPLAY, PRESS, or INTERPRESS")

-                           [SELECTQ NEWDEVICE
-                               (DISPLAY (OR (CAR FC)
-                                            (RPLACA FC OLDSPEC)))
-                               (INTERPRESS (OR (CADDR FC)
-                                               (RPLACA [PROGN [SETQ FC (OR (CDR FC)
-                                                                           (CDR (RPLACD FC (CONS]
-                                                              (OR (CDR FC)
-                                                                  (CDR (RPLACD FC (CONS]
-                                                      OLDSPEC)))
-                               (PRESS (OR (CADDR FC)
-                                          (RPLACA [OR (CDR FC)
-                                                      (CDR (RPLACD FC (CONS]
-                                                 OLDSPEC)))
-                               (OR (CADR (ASSOC NEWDEVICE (CDDDR FC)))
-                                   (PROGN (PROGN [SETQ FC (OR (CDR FC)
-                                                              (CDR (RPLACD FC (CONS]
-                                                 [SETQ FC (OR (CDR FC)
-                                                              (CDR (RPLACD FC (CONS]
-                                                 (PUSH
 (CDR FC)
-                                                        (LIST NEWDEVICE OLDSPEC])]
-    (FONTSET
 FONTNAME])
-)
-
-(RPAQ? FONTESCAPECHAR
 (CHARACTER 6))
-
-(RPAQ? FONTFNS
 )
-
-(RPAQ? FONTWORDS
 )
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(FONTSET
 'STANDARD)
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS)
-)
-(DEFINEQ
-
-(FONTMAPARRAY

-  [LAMBDA (FONTCLASSES)                                      (* lmm "28-Sep-86 14:23")

-
-    (* ;; "Makes a font array from a font-mapping list of fontclasses.  The array provides a fast map from font# to font classes/descriptors. This function caches the last array.  If IMAGETYPES is given, then the FD's are pre-computed for the imagetypes it.  Otherwise, the first use of the fontclass for that imagetype would cause the fontcreate to be done.")

-
-    (PROG (FA (MAXFONT 0)
-              (MINFONT 100))
-          [COND
-             ((NULL \FONTMAPCACHE))
-             ((OR (NULL FONTCLASSES)
-                  (EQUAL FONTCLASSES (CAR \FONTMAPCACHE)))
-              (RETURN (CDR \FONTMAPCACHE]
-          [for
 F PRETTYFONT# in
 FONTCLASSES do
 (SETQ PRETTYFONT# (fetch
 (FONTCLASS
-                                                                                         PRETTYFONT#)
-                                                                                of
 F))
-                                                          (COND
-                                                             ((IGREATERP PRETTYFONT# MAXFONT)
-                                                              (SETQ MAXFONT PRETTYFONT#)))
-                                                          (COND
-                                                             ((ILESSP PRETTYFONT# 1)
-                                                              (ERROR "Invalid font number" 
-                                                                     PRETTYFONT# F))
-                                                             ((ILESSP PRETTYFONT# MINFONT)
-                                                              (SETQ MINFONT PRETTYFONT#]
-          (SETQ FA (ARRAY MAXFONT))
-          (for
 F in
 FONTCLASSES do
 (SETA FA (fetch
 (FONTCLASS PRETTYFONT#)
-                                                           of
 F)
-                                                     F))
-          (for
 I from
 1 to
 MAXFONT unless
 (ELT FA I)
-             do
 (SETA FA I (ELT FA MINFONT)))
-          (SETQ \FONTMAPCACHE (CONS (COPY FONTCLASSES)
-                                    FA))
-          (RETURN FA])
-)
-
-(RPAQ? \FONTMAPCACHE
 )
-
-(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
-       1 FILERDTBL)
-(PUTPROPS FONTPROFILEPATCH COPYRIGHT ("Xerox Corporation" 1993))
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (16158 27897 (FONTSET 16168 . 22509) (FONTPROFILE 22511 . 25015) (FONTPROFILE.ADDDEVICE 
-25017 . 27895)) (28133 30403 (FONTMAPARRAY 28143 . 30401)))))
-STOP

sources/HARDCOPY

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-May-2021 19:41:55" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley2>sources>HARDCOPY.;9
 103663 
+
+
(FILECREATED " 8-Oct-2021 22:23:49" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;13
 103499 
 
       changes to%:  (FNS COPY.TEXT.TO.IMAGE)
 
-      previous date%: "16-Apr-2018 22:15:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley2>sources>HARDCOPY.;8)
+      previous date%: " 7-Oct-2021 10:43:32" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;12)
 
 
 (* ; "
@@ -15,46 +16,47 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (PRETTYCOMPRINT HARDCOPYCOMS)
 
 (RPAQQ HARDCOPYCOMS

-       [(COMS                                                (* ; "exported functionality")

+       [(COMS                                                (* ; "exported functionality")

               (FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER 
                    HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER COPY.WINDOW.TO.BITMAP)
-                                                             (* ; "user interface jazz")

+                                                             (* ; "user interface jazz")

               (INITVARS (ChangeDefaultPrinter))
               (FNS MakeMenuOfPrinters PRINTERS.WHENSELECTEDFN MakeMenuOfImageTypes 
                    GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter 
                    GetPrinterName GetImageFile FetchDefaultPrinter)
-                                                             (* ; "filename diddlers")

+                                                             (* ; "filename diddlers")

               (FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
-        (COMS                                                (* ; 
-
                                                           "Interface for PRINTERS and IMAGEFILES")

+        (COMS                                                (* ; 
+
                                                           "Interface for PRINTERS and IMAGEFILES")

               (FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS 
                    HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE 
                    PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE 
                    \EXPECTED.FILE.TYPE SEND.FILE.TO.PRINTER)
               (FNS PRINTERDEVICE)
               [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT]
-              (P                                             (* ; "for backward compatibility")

+              (P                                             (* ; "for backward compatibility")

                  (MOVD? 'NILL 'PRINTERMODE))
               (INITVARS (DEFAULTPRINTINGHOST)
                      (DEFAULTPRINTERTYPE 'INTERPRESS)
                      (EMPRESS.SCRATCH)
-                     (EMPRESS#SIDES T))
+                     (EMPRESS#SIDES T)
+                     (PRINTFILETYPES NIL))
               (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES 
                      PRINTFILETYPES))
-        (COMS                                                (* ; 
-
                                                           "Converting text files to imagestreams")

+        (COMS                                                (* ; 
+
                                                           "Converting text files to imagestreams")

               (INITVARS (TEXTDEFAULTTABS (LIST 20320))
                      (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
-                                                             (* ; 
-
                                                "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")

+                                                             (* ; 
+
                                                "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")

               (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
               (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
         (COMS (FNS \BLTSHADE.GENERICPRINTER)
-                                                             (* ; 
-
                                                     "hack for printers that can't really BLTSHADE")

+                                                             (* ; 
+
                                                     "hack for printers that can't really BLTSHADE")

               )
-        [COMS                                                (* ; 
-
                                                "stuff to support hardcopy streams on the display.")

+        [COMS                                                (* ; 
+
                                                "stuff to support hardcopy streams on the display.")

               (FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY
                    \DSPFONT.HDCPYDISPLAY \DSPRIGHTMARGIN.HDCPYDISPLAY \DSPXPOSITION.HDCPYDISPLAY 
                    \DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \STRINGWIDTH.HCPYDISPLAYAUX 
@@ -65,8 +67,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
                                                                 (IMICASPERPT 35]
               (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
-        [COMS                                                (* ; 
-
                                       "Stuff to support MICA-unit hardcopy streams on the display")

+        [COMS                                                (* ; 
+
                                       "Stuff to support MICA-unit hardcopy streams on the display")

               (FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE 
                    \BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE 
                    \DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE 
@@ -649,7 +651,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (PRINTERDEVICE
 'LPT)
 )
 
-                                                             (* ; "for backward compatibility")

+                                                             (* ; "for backward compatibility")

 
 (MOVD? 'NILL 'PRINTERMODE)
 
@@ -660,6 +662,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (RPAQ? EMPRESS.SCRATCH
 )
 
 (RPAQ? EMPRESS#SIDES
 T)
+
+(RPAQ? PRINTFILETYPES
 NIL)
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES)
@@ -719,105 +723,100 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
                             (CLOSEF IMAGESTREAM])])
 
 (COPY.TEXT.TO.IMAGE

-  [LAMBDA (INFILE IMAGESTREAM FONTS TABS)
               (* ; "Edited  5-May-2021 19:41 by rmk:")


-                                                             (* ; "Edited 10-Apr-95 21:23 by rmk:")

+  [LAMBDA (INFILE IMAGESTREAM FONTS TABS)
               (* ; "Edited  8-Oct-2021 22:23 by rmk:")


+                                                             (* ; "Edited 10-Apr-95 21:23 by rmk:")

 
-    (* ;; "Copy text to an image stream, obeying PSPOOL control characters")

+    (* ;; "Copy text to an image stream, obeying PSPOOL control characters")

 
     (LET*
-     ((IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
+     [(IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
       (RIGHTMAR (DSPRIGHTMARGIN NIL IMAGESTREAM))
       (FONTARRAY (FONTMAPARRAY FONTS))
       (MAXFONT (ARRAYSIZE FONTARRAY))
       (INSTRM (GETSTREAM INFILE 'INPUT))
-      DEFAULTTAB C FC)
-     (replace
 (STREAM ENDOFSTREAMOP) of
 INSTRM with
 (FUNCTION ZERO))
-     (do

-      (COND
-         ((AND [EQ 0 (LOGAND 255 (SETQ C (\INCCODE INSTRM]
-               (EOFP INSTRM))
-          (RETURN))
-         ((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
-                           RIGHTMAR))                        (* ; 
-
                                                      "Not to walk off the right edge of the paper")

-          (TERPRI IMAGESTREAM)))
-      (COND
-         ([> C (CONSTANT (APPLY (FUNCTION MAX)
-                                (CHARCODE (^F CR LF ^L TAB NULL]
-          (\OUTCHAR IMAGESTREAM C))
-         (T
-          (SELCHARQ C
-               (^F                                           (* ; "Font shift")

+      DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
 
-                   (* ;; 
-
                 "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")

+     (* ;; 
+
"RMK:  EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")

 
-                   (DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
-                                        1)
-                          IMAGESTREAM)
-                   [SELCHARQ (SETQ FC (\INCCODE INSTRM))
-                        (^T                                  (* ; "tab to absolute pos.")

-                            (COND
-                               ((EQ 0 (SETQ FC (\INCCODE INSTRM)))
-                                (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
-                                (\OUTCHAR IMAGESTREAM (CHARCODE ^T))
-                                (AND (\EOFP INSTRM)
-                                     (RETURN))
-                                (\OUTCHAR IMAGESTREAM FC))
-                               (T 
+     (SETFILEINFO INSTRM 'ENDOFSTREAMOP (FUNCTION NILL))
+     [while
 (SETQ C (\INCCODE INSTRM))
+        do

+        (COND
+           ((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
+                             RIGHTMAR))                      (* ; 
+
                                                      "Not to walk off the right edge of the paper")

+            (TERPRI IMAGESTREAM)))
+        (COND
+           ([> C (CONSTANT (APPLY (FUNCTION MAX)
+                                  (CHARCODE (^F CR LF ^L TAB]
+            (\OUTCHAR IMAGESTREAM C))
+           (T
+            (SELCHARQ C
+                 (^F                                         (* ; "Font shift")

 
-                                 (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream.  Should really be a property of the stream or imagetype, or defined in terms of standard scale")

+                     (* ;; 
+
                   "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")

 
-                                  [SETQ FC
-                                   (IF
 TABS
-                                       THEN
 (OR (CAR (NTH TABS FC))
-                                                    (ERROR "Undefined absolute tab number" FC))
-                                     ELSE
 (TIMES FC
-                                                     (OR DEFAULTTAB
-                                                         (SETQ DEFAULTTAB
-                                                          (TIMES 8 (CHARWIDTH (CHARCODE SPACE)
-                                                                          (FONTCREATE (ELT FONTARRAY
-                                                                                           1)
-                                                                                 NIL NIL NIL 
-                                                                                 IMAGESTREAM]
-                                  (DSPXPOSITION FC IMAGESTREAM))))
-                        (NULL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
-                              (AND (\EOFP INSTRM)
-                                   (RETURN))
-                              (\OUTCHAR IMAGESTREAM FC)      (* ; "EOS after ^F")

-                              )
-                        (COND
-                           ((AND (>= MAXFONT FC)
-                                 (NEQ FC 0))
-                            (DSPFONT (ELT FONTARRAY FC)
-                                   IMAGESTREAM))
-                           (T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
-                              (\OUTCHAR IMAGESTREAM C])
-               (CR 
-                   (* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text.  Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file as a carriage-return.  But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously.  Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, which is to treat all instances of CR, CRLF, and LF as end-of-line.")

+                     (DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
+                                          1)
+                            IMAGESTREAM)
+                     [SELCHARQ (SETQ FC (\INCCODE INSTRM))
+                          (^T                                (* ; "tab to absolute pos.")

+                              (CL:UNLESS (SETQ FC (\INCCODE INSTRM))
+                                  (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
+                                  (\OUTCHAR IMAGESTREAM (CHARCODE ^T))
+                                  (RETURN))
 
-                   (TERPRI IMAGESTREAM)
-                   (COND
-                      ((EQ (CHARCODE LF)
-                           (\PEEKBIN INSTRM T))
-                       (BIN INSTRM))))
-               (TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
-                               (TAB.WIDTH (TIMES (CHARWIDTH (CHARCODE SPACE)
-                                                        IMAGESTREAM)
-                                                 8))
-                               (CURRENT.X (- (DSPXPOSITION NIL IMAGESTREAM)
-                                             LEFTMARGIN))
-                               (CURRENT.STOP (- CURRENT.X (REMAINDER CURRENT.X TAB.WIDTH]
-                              (NLSETQ (RELMOVETO (- (+ CURRENT.STOP TAB.WIDTH)
-                                                    CURRENT.X)
-                                             0 IMAGESTREAM)))
-                        (\OUTCHAR IMAGESTREAM C)))
-               (LF                                           (* ; "See comment at CR")

-                   (TERPRI IMAGESTREAM))
-               (NULL (AND (EOFP INSTRM)
-                          (RETURN))
-                     (\OUTCHAR IMAGESTREAM C))
-               (\OUTCHAR IMAGESTREAM C])
+                              (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream.  Should really be a property of the stream or imagetype, or defined in terms of standard scale")

+
+                              [SETQ FC
+                               (IF
 TABS
+                                   THEN
 (OR (CAR (NTH TABS FC))
+                                                (ERROR "Undefined absolute tab number" FC))
+                                 ELSE
 (TIMES FC (OR DEFAULTTAB
+                                                        (SETQ DEFAULTTAB
+                                                         (TIMES 8 (CHARWIDTH (CHARCODE SPACE)
+                                                                         (FONTCREATE (ELT FONTARRAY 1
+                                                                                          )
+                                                                                NIL NIL NIL 
+                                                                                IMAGESTREAM]
+                              (DSPXPOSITION FC IMAGESTREAM))
+                          (NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
+                                                             (* ; "EOS after ^F")

+                               (RETURN))
+                          (COND
+                             ((AND (>= MAXFONT FC)
+                                   (NEQ FC 0))
+                              (DSPFONT (ELT FONTARRAY FC)
+                                     IMAGESTREAM))
+                             (T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
+                                (\OUTCHAR IMAGESTREAM FC])
+                 (CR 
+                     (* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text.  Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file 
+as a carriage-return.  But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously.  Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, wh
+ich is to treat all instances of CR, CRLF, and LF as end-of-line.")

+
+                     (COND
+                        ((EQ (CHARCODE LF)
+                             (\PEEKCCODE.NOEOLC INSTRM T))
+                         (\INCCODE INSTRM)))
+                     (TERPRI IMAGESTREAM))
+                 (LF                                         (* ; "Isolatedx LF, see comment at CR")

+                     (TERPRI IMAGESTREAM))
+                 (TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
+                                 (TAB.WIDTH (TIMES (CHARWIDTH (CHARCODE SPACE)
+                                                          IMAGESTREAM)
+                                                   8))
+                                 (CURRENT.X (- (DSPXPOSITION NIL IMAGESTREAM)
+                                               LEFTMARGIN))
+                                 (CURRENT.STOP (- CURRENT.X (REMAINDER CURRENT.X TAB.WIDTH]
+                                (NLSETQ (RELMOVETO (- (+ CURRENT.STOP TAB.WIDTH)
+                                                      CURRENT.X)
+                                               0 IMAGESTREAM)))
+                          (\OUTCHAR IMAGESTREAM C)))
+                 (\OUTCHAR IMAGESTREAM C]
+     (SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP])
 )
 (DEFINEQ
 
@@ -1085,39 +1084,39 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
  1993 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6141 10325 (HARDCOPY.SOMEHOW 6151 . 7509) (HARDCOPYIMAGEW 7511 . 7663) (
-HARDCOPYIMAGEW.TOFILE 7665 . 7973) (HARDCOPYIMAGEW.TOPRINTER 7975 . 8640) (HARDCOPYREGION.TOFILE 8642
- . 8940) (HARDCOPYREGION.TOPRINTER 8942 . 9564) (COPY.WINDOW.TO.BITMAP 9566 . 10323)) (10397 20947 (
-MakeMenuOfPrinters 10407 . 11632) (PRINTERS.WHENSELECTEDFN 11634 . 13376) (MakeMenuOfImageTypes 13378
- . 13896) (GetNewPrinterFromUser 13898 . 14326) (PopUpWindowAndGetAtom 14328 . 15713) (
-PopUpWindowAndGetList 15715 . 17281) (NewPrinter 17283 . 18231) (GetPrinterName 18233 . 18513) (
-GetImageFile 18515 . 20802) (FetchDefaultPrinter 20804 . 20945)) (20982 21520 (
-ExtensionForPrintFileType 20992 . 21185) (PRINTFILETYPE.FROM.EXTENSION 21187 . 21518)) (21575 37959 (
-DEFAULTPRINTER 21585 . 21745) (CAN.PRINT.DIRECTLY 21747 . 21903) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
-21905 . 22949) (EMPRESS 22951 . 23264) (HARDCOPYW 23266 . 26226) (LISTFILES1 26228 . 26401) (
-PRINTER.BITMAPFILE 26403 . 26650) (PRINTER.BITMAPSCALE 26652 . 26917) (PRINTER.SCRATCH.FILE 26919 . 
-27042) (PRINTERPROP 27044 . 27227) (PRINTERSTATUS 27229 . 27418) (PRINTERTYPE 27420 . 29729) (
-PRINTERNAME 29731 . 30033) (PRINTFILEPROP 30035 . 30226) (PRINTFILETYPE 30228 . 32172) (
-\EXPECTED.FILE.TYPE 32174 . 32956) (SEND.FILE.TO.PRINTER 32958 . 37957)) (37960 42942 (PRINTERDEVICE 
-37970 . 42940)) (43725 51926 (TEXTTOIMAGEFILE 43735 . 45925) (COPY.TEXT.TO.IMAGE 45927 . 51924)) (
-51927 53062 (\BLTSHADE.GENERICPRINTER 51937 . 53060)) (53190 71942 (MAKEHARDCOPYSTREAM 53200 . 54204) 
-(UNMAKEHARDCOPYSTREAM 54206 . 54890) (HARDCOPYSTREAMTYPE 54892 . 55171) (\CHARWIDTH.HDCPYDISPLAY 55173
- . 55604) (\DSPFONT.HDCPYDISPLAY 55606 . 57011) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57013 . 57590) (
-\DSPXPOSITION.HDCPYDISPLAY 57592 . 57853) (\DSPYPOSITION.HDCPYDISPLAY 57855 . 58116) (
-\STRINGWIDTH.HDCPYDISPLAY 58118 . 58625) (\STRINGWIDTH.HCPYDISPLAYAUX 58627 . 60959) (\HDCPYBLTCHAR 
-60961 . 63496) (\HDCPYDISPLAY.FIX.XPOS 63498 . 63918) (\HDCPYDISPLAY.FIX.YPOS 63920 . 64340) (
-\HDCPYDISPLAYINIT 64342 . 65119) (\HDCPYDSPPRINTCHAR 65121 . 67281) (\SLOWHDCPYBLTCHAR 67283 . 70786) 
-(\CHANGECHARSET.HDCPYDISPLAY 70788 . 71940)) (72664 102961 (MAKEHARDCOPYMODESTREAM 72674 . 74583) (
-UNMAKEHARDCOPYMODESTREAM 74585 . 75663) (\BLTSHADE.HCPYMODE 75665 . 76112) (\BITBLT.HCPYMODE 76114 . 
-76736) (\BRUSHCONVERT.HCPYMODE 76738 . 76975) (\CHANGECHARSET.HCPYMODE 76977 . 78744) (
-\DASHINGCONVERT.HCPYMODE 78746 . 79009) (\CHARWIDTH.HCPYMODE 79011 . 79298) (\DRAWLINE.HCPYMODE 79300
- . 79612) (\DRAWCURVE.HCPYMODE 79614 . 80043) (\DRAWCIRCLE.HCPYMODE 80045 . 80440) (
-\DRAWELLIPSE.HCPYMODE 80442 . 80954) (\DSPFONT.HCPYMODE 80956 . 82112) (\DSPLEFTMARGIN.HCPYMODE 82114
- . 82698) (\DSPLINEFEED.HCPYMODE 82700 . 83110) (\DSPRIGHTMARGIN.HCPYMODE 83112 . 83741) (
-\DSPSPACEFACTOR.HCPYMODE 83743 . 84264) (\DSPXPOSITION.HCPYMODE 84266 . 84847) (\DSPYPOSITION.HCPYMODE
- 84849 . 85254) (\MOVETO.HCPYMODE 85256 . 85408) (\FONTCREATE.HCPYMODE.PRESS 85410 . 86422) (
-\CREATECHARSET.HCPYMODE.PRESS 86424 . 87395) (\FONTCREATE.HCPYMODE.INTERPRESS 87397 . 88431) (
-\CREATECHARSET.HCPYMODE.INTERPRESS 88433 . 89421) (\STRINGWIDTH.HCPYMODE 89423 . 89857) (
-\HCPYMODEBLTCHAR 89859 . 92828) (\HCPYMODEDISPLAYINIT 92830 . 95761) (\HCPYMODEDSPPRINTCHAR 95763 . 
-97944) (\SLOWHCPYMODEBLTCHAR 97946 . 101460) (\SFFixY.HCPYMODE 101462 . 102959)))))
+  (FILEMAP (NIL (6184 10368 (HARDCOPY.SOMEHOW 6194 . 7552) (HARDCOPYIMAGEW 7554 . 7706) (
+HARDCOPYIMAGEW.TOFILE 7708 . 8016) (HARDCOPYIMAGEW.TOPRINTER 8018 . 8683) (HARDCOPYREGION.TOFILE 8685
+ . 8983) (HARDCOPYREGION.TOPRINTER 8985 . 9607) (COPY.WINDOW.TO.BITMAP 9609 . 10366)) (10440 20990 (
+MakeMenuOfPrinters 10450 . 11675) (PRINTERS.WHENSELECTEDFN 11677 . 13419) (MakeMenuOfImageTypes 13421
+ . 13939) (GetNewPrinterFromUser 13941 . 14369) (PopUpWindowAndGetAtom 14371 . 15756) (
+PopUpWindowAndGetList 15758 . 17324) (NewPrinter 17326 . 18274) (GetPrinterName 18276 . 18556) (
+GetImageFile 18558 . 20845) (FetchDefaultPrinter 20847 . 20988)) (21025 21563 (
+ExtensionForPrintFileType 21035 . 21228) (PRINTFILETYPE.FROM.EXTENSION 21230 . 21561)) (21618 38002 (
+DEFAULTPRINTER 21628 . 21788) (CAN.PRINT.DIRECTLY 21790 . 21946) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
+21948 . 22992) (EMPRESS 22994 . 23307) (HARDCOPYW 23309 . 26269) (LISTFILES1 26271 . 26444) (
+PRINTER.BITMAPFILE 26446 . 26693) (PRINTER.BITMAPSCALE 26695 . 26960) (PRINTER.SCRATCH.FILE 26962 . 
+27085) (PRINTERPROP 27087 . 27270) (PRINTERSTATUS 27272 . 27461) (PRINTERTYPE 27463 . 29772) (
+PRINTERNAME 29774 . 30076) (PRINTFILEPROP 30078 . 30269) (PRINTFILETYPE 30271 . 32215) (
+\EXPECTED.FILE.TYPE 32217 . 32999) (SEND.FILE.TO.PRINTER 33001 . 38000)) (38003 42985 (PRINTERDEVICE 
+38013 . 42983)) (43800 51762 (TEXTTOIMAGEFILE 43810 . 46000) (COPY.TEXT.TO.IMAGE 46002 . 51760)) (
+51763 52898 (\BLTSHADE.GENERICPRINTER 51773 . 52896)) (53026 71778 (MAKEHARDCOPYSTREAM 53036 . 54040) 
+(UNMAKEHARDCOPYSTREAM 54042 . 54726) (HARDCOPYSTREAMTYPE 54728 . 55007) (\CHARWIDTH.HDCPYDISPLAY 55009
+ . 55440) (\DSPFONT.HDCPYDISPLAY 55442 . 56847) (\DSPRIGHTMARGIN.HDCPYDISPLAY 56849 . 57426) (
+\DSPXPOSITION.HDCPYDISPLAY 57428 . 57689) (\DSPYPOSITION.HDCPYDISPLAY 57691 . 57952) (
+\STRINGWIDTH.HDCPYDISPLAY 57954 . 58461) (\STRINGWIDTH.HCPYDISPLAYAUX 58463 . 60795) (\HDCPYBLTCHAR 
+60797 . 63332) (\HDCPYDISPLAY.FIX.XPOS 63334 . 63754) (\HDCPYDISPLAY.FIX.YPOS 63756 . 64176) (
+\HDCPYDISPLAYINIT 64178 . 64955) (\HDCPYDSPPRINTCHAR 64957 . 67117) (\SLOWHDCPYBLTCHAR 67119 . 70622) 
+(\CHANGECHARSET.HDCPYDISPLAY 70624 . 71776)) (72500 102797 (MAKEHARDCOPYMODESTREAM 72510 . 74419) (
+UNMAKEHARDCOPYMODESTREAM 74421 . 75499) (\BLTSHADE.HCPYMODE 75501 . 75948) (\BITBLT.HCPYMODE 75950 . 
+76572) (\BRUSHCONVERT.HCPYMODE 76574 . 76811) (\CHANGECHARSET.HCPYMODE 76813 . 78580) (
+\DASHINGCONVERT.HCPYMODE 78582 . 78845) (\CHARWIDTH.HCPYMODE 78847 . 79134) (\DRAWLINE.HCPYMODE 79136
+ . 79448) (\DRAWCURVE.HCPYMODE 79450 . 79879) (\DRAWCIRCLE.HCPYMODE 79881 . 80276) (
+\DRAWELLIPSE.HCPYMODE 80278 . 80790) (\DSPFONT.HCPYMODE 80792 . 81948) (\DSPLEFTMARGIN.HCPYMODE 81950
+ . 82534) (\DSPLINEFEED.HCPYMODE 82536 . 82946) (\DSPRIGHTMARGIN.HCPYMODE 82948 . 83577) (
+\DSPSPACEFACTOR.HCPYMODE 83579 . 84100) (\DSPXPOSITION.HCPYMODE 84102 . 84683) (\DSPYPOSITION.HCPYMODE
+ 84685 . 85090) (\MOVETO.HCPYMODE 85092 . 85244) (\FONTCREATE.HCPYMODE.PRESS 85246 . 86258) (
+\CREATECHARSET.HCPYMODE.PRESS 86260 . 87231) (\FONTCREATE.HCPYMODE.INTERPRESS 87233 . 88267) (
+\CREATECHARSET.HCPYMODE.INTERPRESS 88269 . 89257) (\STRINGWIDTH.HCPYMODE 89259 . 89693) (
+\HCPYMODEBLTCHAR 89695 . 92664) (\HCPYMODEDISPLAYINIT 92666 . 95597) (\HCPYMODEDSPPRINTCHAR 95599 . 
+97780) (\SLOWHCPYMODEBLTCHAR 97782 . 101296) (\SFFixY.HCPYMODE 101298 . 102795)))))
 STOP

sources/IMAGEIO

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-Sep-2021 08:24:49" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;6
 79647  
+
(FILECREATED "25-Sep-2021 20:58:07" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;4
 79783  
 
-      changes to%:  (FNS \DISPLAYINIT \4DISPLAYINIT \8DISPLAYINIT \24DISPLAYINIT)
+      changes to%:  (VARS IMAGEIOCOMS)
+                    (FNS \DISPLAYINIT \4DISPLAYINIT \8DISPLAYINIT \24DISPLAYINIT)
 
       previous date%: " 2-Aug-2021 19:41:35" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;5)
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;2)
 
 
 (* ; "
@@ -27,7 +28,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
         (FNS \DRAWPOINT.GENERIC \DRAWPOLYGON.GENERIC \DRAWCIRCLE.GENERIC \DRAWELLIPSE.GENERIC)
         (FNS \IMAGEIOINIT \NOIMAGE.DSPFONT \UNIMPIMAGEOP)
         [COMS 
-              (* ;; "stuff to support the checking and defaulting of arguments in the device independent drawing functions.")

+              (* ;; "stuff to support the checking and defaulting of arguments in the device independent drawing functions.")

 
               (FNS INSURE.BRUSH BRUSHP \POSSIBLECOLOR NEGSHADE)
               (DECLARE%: DONTCOPY EVAL@COMPILE (RESOURCES SYSTEMBRUSH))
@@ -42,7 +43,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
         (SYSRECORDS IMAGEOPS)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\IMAGEIOINIT)))
         [COMS 
-              (* ;; "Implementation of display stream resident `files.' Done here cause it might matter that the display device get defined early so that its event fn will be evaluated as the last thing before logout")

+              (* ;; "Implementation of display stream resident `files.' Done here cause it might matter that the display device get defined early so that its event fn will be evaluated as the last thing before logout")

 
               (INITVARS (\COLORDISPLAYSTREAMTYPES '(4DISPLAY 8DISPLAY 24DISPLAY))
                      (\DISPLAYSTREAMTYPES (CONS 'DISPLAY \COLORDISPLAYSTREAMTYPES)))
@@ -1170,11 +1171,11 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
         NIL])
 
 (\DISPLAYINIT

-  [LAMBDA NIL
                                           (* ; "Edited  2-Aug-2021 19:41 by rmk:")

+  [LAMBDA NIL
                                           (* ; "Edited 25-Sep-2021 20:57 by rmk:")

 
-    (* ;; "Initializes global variables for the Display device")

+    (* ;; "Initializes global variables for the Display device")

 
-    (* ;; "Display Streams are referred to only by themselves so they do not need directory operations.  Most of the fields in the DisplayDevice are empty to avoid something bad happening.")

+    (* ;; "Display Streams are referred to only by themselves so they do not need directory operations.  Most of the fields in the DisplayDevice are empty to avoid something bad happening.")

 
     (DECLARE
 (GLOBALVARS DisplayFDEV \DISPLAYIMAGEOPS \DisplayDeviceMethods \DisplayDeviceData))
     (SETQ \DisplayDeviceMethods (create
 WSOPS))
@@ -1186,6 +1187,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
                               BOTTOM _ 0
                               WIDTH _ 1024
                               HEIGHT _ 808)))
+    (MAKE-EXTERNALFORMAT :DISPLAY NIL NIL NIL (FUNCTION \DSPPRINTCHAR)
+           NIL CR.EOLC)
     (SETQ \DISPLAYIMAGEOPS (create
 IMAGEOPS
                                   IMAGETYPE _ 'DISPLAY
                                   IMFONT _ (FUNCTION \DSPFONT.DISPLAY)
@@ -1252,13 +1255,11 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
                              WINDOWOPS _ \DisplayDeviceMethods
                              WINDOWDATA _ \DisplayDeviceData
                              DEVICEINFO _ (create
 DISPLAYSTATE)
-                             DEFAULTEXTERNALFORMAT _ (MAKE-EXTERNALFORMAT :DISPLAY NIL NIL NIL
-                                                            (FUNCTION \DSPPRINTCHAR)
-                                                            NIL CR.EOLC)))
+                             DEFAULTEXTERNALFORMAT _ :DISPLAY))
     (\DEFINEDEVICE 'LFDISPLAY DisplayFDEV])
 
 (\4DISPLAYINIT

-  [LAMBDA NIL
                                         (* ; "Edited 22-Apr-94 15:17 by sybalsky")

+  [LAMBDA NIL
                                           (* ; "Edited 25-Sep-2021 18:42 by rmk:")

     (DECLARE
 (GLOBALVARS \4DISPLAYIMAGEOPS \4DISPLAYFDEV))
     (SETQ \4DISPLAYIMAGEOPS (create
 IMAGEOPS
                                    IMAGETYPE _ '4DISPLAY
@@ -1322,11 +1323,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
                                BLOCKIN _ (FUNCTION \ILLEGAL.DEVICEOP)
                                BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
                                DEVICEINFO _ (create
 DISPLAYSTATE)
-                               WINDOWOPS _ NIL))
+                               WINDOWOPS _ NIL
+                               DEFAULTEXTERNALFORMAT _ :DISPLAY))
     (\DEFINEDEVICE NIL \4DISPLAYFDEV])
 
 (\8DISPLAYINIT

-  [LAMBDA NIL
                                         (* ; "Edited 22-Apr-94 15:18 by sybalsky")

+  [LAMBDA NIL
                                           (* ; "Edited 25-Sep-2021 18:43 by rmk:")

     (DECLARE
 (GLOBALVARS \8DISPLAYIMAGEOPS \8DISPLAYFDEV))
     (SETQ \8DISPLAYIMAGEOPS (create
 IMAGEOPS
                                    IMAGETYPE _ '8DISPLAY
@@ -1390,11 +1392,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
                                BLOCKIN _ (FUNCTION \ILLEGAL.DEVICEOP)
                                BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
                                DEVICEINFO _ (create
 DISPLAYSTATE)
-                               WINDOWOPS _ NIL))
+                               WINDOWOPS _ NIL
+                               DEFAULTEXTERNALFORMAT _ :DISPLAY))
     (\DEFINEDEVICE NIL \8DISPLAYFDEV])
 
 (\24DISPLAYINIT

-  [LAMBDA NIL
                                         (* ; "Edited 22-Apr-94 15:18 by sybalsky")

+  [LAMBDA NIL
                                           (* ; "Edited 25-Sep-2021 18:44 by rmk:")

     (DECLARE
 (GLOBALVARS \24DISPLAYIMAGEOPS \24DISPLAYFDEV))
     (SETQ \24DISPLAYIMAGEOPS (create
 IMAGEOPS
                                     IMAGETYPE _ '24DISPLAY
@@ -1458,7 +1461,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
                                 BLOCKIN _ (FUNCTION \ILLEGAL.DEVICEOP)
                                 BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
                                 DEVICEINFO _ (create
 DISPLAYSTATE)
-                                WINDOWOPS _ NIL))
+                                WINDOWOPS _ NIL
+                                DEFAULTEXTERNALFORMAT _ :DISPLAY))
     (\DEFINEDEVICE NIL \24DISPLAYFDEV])
 
 (\DISPLAYSTREAMTYPEBPP

@@ -1509,24 +1513,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
 (PUTPROPS IMAGEIO COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
 1993 1994 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3384 12141 (IMAGESTREAMP 3394 . 4226) (IMAGESTREAMTYPE 4228 . 4441) (IMAGESTREAMTYPEP 
-4443 . 5078) (OPENIMAGESTREAM 5080 . 10034) (\GOOD.DASHLST 10036 . 12139)) (12176 14473 (
-DRAWDASHEDLINE 12186 . 14471)) (14474 21814 (DSPBACKCOLOR 14484 . 14856) (DSPBOTTOMMARGIN 14858 . 
-15243) (DSPCOLOR 15245 . 15609) (DSPCLIPPINGREGION 15611 . 16316) (DSPRESET 16318 . 16598) (DSPFONT 
-16600 . 16964) (DSPLEFTMARGIN 16966 . 17347) (DSPLINEFEED 17349 . 17649) (DSPOPERATION 17651 . 18028) 
-(DSPRIGHTMARGIN 18030 . 18413) (DSPTOPMARGIN 18415 . 18794) (DSPSCALE 18796 . 19163) (DSPSPACEFACTOR 
-19165 . 19558) (DSPXPOSITION 19560 . 19865) (DSPYPOSITION 19867 . 20172) (DSPROTATE 20174 . 20469) (
-DSPPUSHSTATE 20471 . 20717) (DSPPOPSTATE 20719 . 20962) (DSPDEFAULTSTATE 20964 . 21216) (DSPSCALE2 
-21218 . 21509) (DSPTRANSLATE 21511 . 21812)) (21815 30616 (DSPNEWPAGE 21825 . 22517) (DRAWBETWEEN 
-22519 . 23221) (DRAWCIRCLE 23223 . 23719) (DRAWARC 23721 . 24238) (DRAWCURVE 24240 . 24917) (
-DRAWELLIPSE 24919 . 25705) (DRAWLINE 25707 . 26097) (DRAWPOLYGON 26099 . 26554) (DRAWPOINT 26556 . 
-26975) (FILLPOLYGON 26977 . 27543) (DRAWTO 27545 . 27963) (FILLCIRCLE 27965 . 28188) (MOVETO 28190 . 
-28554) (RELDRAWTO 28556 . 29473) (BITMAPIMAGESIZE 29475 . 29646) (SCALEDBITBLT 29648 . 30614)) (30617 
-37656 (\DRAWPOINT.GENERIC 30627 . 30974) (\DRAWPOLYGON.GENERIC 30976 . 33284) (\DRAWCIRCLE.GENERIC 
-33286 . 34944) (\DRAWELLIPSE.GENERIC 34946 . 37654)) (37657 43043 (\IMAGEIOINIT 37667 . 41800) (
-\NOIMAGE.DSPFONT 41802 . 42877) (\UNIMPIMAGEOP 42879 . 43041)) (43166 46290 (INSURE.BRUSH 43176 . 
-44550) (BRUSHP 44552 . 45342) (\POSSIBLECOLOR 45344 . 45895) (NEGSHADE 45897 . 46288)) (46846 47530 (
-DASHINGP 46856 . 47186) (INSURE.DASHING 47188 . 47528)) (58011 78460 (\DisplayEventFn 58021 . 58531) (
-\DISPLAYINIT 58533 . 64212) (\4DISPLAYINIT 64214 . 68851) (\8DISPLAYINIT 68853 . 73492) (
-\24DISPLAYINIT 73494 . 78201) (\DISPLAYSTREAMTYPEBPP 78203 . 78458)))))
+  (FILEMAP (NIL (3423 12180 (IMAGESTREAMP 3433 . 4265) (IMAGESTREAMTYPE 4267 . 4480) (IMAGESTREAMTYPEP 
+4482 . 5117) (OPENIMAGESTREAM 5119 . 10073) (\GOOD.DASHLST 10075 . 12178)) (12215 14512 (
+DRAWDASHEDLINE 12225 . 14510)) (14513 21853 (DSPBACKCOLOR 14523 . 14895) (DSPBOTTOMMARGIN 14897 . 
+15282) (DSPCOLOR 15284 . 15648) (DSPCLIPPINGREGION 15650 . 16355) (DSPRESET 16357 . 16637) (DSPFONT 
+16639 . 17003) (DSPLEFTMARGIN 17005 . 17386) (DSPLINEFEED 17388 . 17688) (DSPOPERATION 17690 . 18067) 
+(DSPRIGHTMARGIN 18069 . 18452) (DSPTOPMARGIN 18454 . 18833) (DSPSCALE 18835 . 19202) (DSPSPACEFACTOR 
+19204 . 19597) (DSPXPOSITION 19599 . 19904) (DSPYPOSITION 19906 . 20211) (DSPROTATE 20213 . 20508) (
+DSPPUSHSTATE 20510 . 20756) (DSPPOPSTATE 20758 . 21001) (DSPDEFAULTSTATE 21003 . 21255) (DSPSCALE2 
+21257 . 21548) (DSPTRANSLATE 21550 . 21851)) (21854 30655 (DSPNEWPAGE 21864 . 22556) (DRAWBETWEEN 
+22558 . 23260) (DRAWCIRCLE 23262 . 23758) (DRAWARC 23760 . 24277) (DRAWCURVE 24279 . 24956) (
+DRAWELLIPSE 24958 . 25744) (DRAWLINE 25746 . 26136) (DRAWPOLYGON 26138 . 26593) (DRAWPOINT 26595 . 
+27014) (FILLPOLYGON 27016 . 27582) (DRAWTO 27584 . 28002) (FILLCIRCLE 28004 . 28227) (MOVETO 28229 . 
+28593) (RELDRAWTO 28595 . 29512) (BITMAPIMAGESIZE 29514 . 29685) (SCALEDBITBLT 29687 . 30653)) (30656 
+37695 (\DRAWPOINT.GENERIC 30666 . 31013) (\DRAWPOLYGON.GENERIC 31015 . 33323) (\DRAWCIRCLE.GENERIC 
+33325 . 34983) (\DRAWELLIPSE.GENERIC 34985 . 37693)) (37696 43082 (\IMAGEIOINIT 37706 . 41839) (
+\NOIMAGE.DSPFONT 41841 . 42916) (\UNIMPIMAGEOP 42918 . 43080)) (43205 46329 (INSURE.BRUSH 43215 . 
+44589) (BRUSHP 44591 . 45381) (\POSSIBLECOLOR 45383 . 45934) (NEGSHADE 45936 . 46327)) (46885 47569 (
+DASHINGP 46895 . 47225) (INSURE.DASHING 47227 . 47567)) (58050 78596 (\DisplayEventFn 58060 . 58570) (
+\DISPLAYINIT 58572 . 64155) (\4DISPLAYINIT 64157 . 68858) (\8DISPLAYINIT 68860 . 73563) (
+\24DISPLAYINIT 73565 . 78337) (\DISPLAYSTREAMTYPEBPP 78339 . 78594)))))
 STOP