Rmk46: Minor changes to comparison functions (#789)

* COMPARETEXT: Inverted nodes stay inverted when scrolled

* COMPARESOURCES: Remove unused stub for browsing in TEDIT window

* COMPAREDIRECTORIES: Upgrade to new LISPFILETYPE, add CD-COMPARE-FILES

CD-COMPARE-FILES interface to compare 2 given files, not whole directory

Dockerfile

@@ -11,8 +11,8 @@ ARG DOCKER_NAMESPACE=interlisp
 
 FROM ${DOCKER_NAMESPACE}/maiko:latest
 
-# Add tightvnc server to the image
-RUN apt-get update && apt-get install -y tightvncserver
+# Add tightvnc server and xclip to the image
+RUN apt-get update && apt-get install -y tightvncserver && apt-get install -y xclip
 
 #  Handle ARGs, ENV variables, and LABELs
 ARG BUILD_DATE=unknown

README.md

@@ -37,12 +37,12 @@ From a shell/terminal window:
 Unpack the medley loadups file
 
 *  `cd ` ~parent~
-*  `tar -xvfz medley-`YYMMDD`-loadups.tgz`
+*  `tar xvzf medley-`YYMMDD`-loadups.tgz`
 
 2. Unpack the medley runtime OR clone the Medley repo
    (the "medley runtime" is just a subset of the whole repo)
    
-* `tar -xvfz medley-`YYMMDD`-runtime.tgz` 
+* `tar xvzf medley-`YYMMDD`-runtime.tgz` 
 
    OR
    ```
@@ -52,7 +52,7 @@ Unpack the medley loadups file
 3. Unpack the maiko file for your operating system and CPU type, e.g.,
 
    ```
-   tar -xvfz maiko-210823.linux.x86_64.tgz
+   tar xvzf maiko-210823.linux.x86_64.tgz
    ```
 
 3. This should leave you with two directories, `medley` and `maiko`.

docs/README.md

@@ -1,11 +1,10 @@
-This directory has:
+See [Documentation links](https://github.com/Interlisp/medley/wiki/Documentation)
+a complete list of available documentation. Much of the documentation still
+needs review and updating.
+
+This directory has source (.TEDIT) for some documents that are found elsewhere.
+
 
 * dinfo  -- files for HelpSys man command Interlisp Reference Manual
-* Documentation Tools -- should be moved into Library
-
- * Various conversions of Medley legacy documentation
- 
- Needs to be cleaned up. Putting PDF files in the repo doesn't seem right; 
- we can make PS and PDF files as part of building a loadup
  
  

greetfiles/MEDLEYDIR-INIT

@@ -1,8 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2
 4677   
+
(FILECREATED " 9-Mar-2022 11:50:44" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2
 4690   
 
-      :PREVIOUS-DATE "20-Feb-2022 11:47:18" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
+      :CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
+
+      :PREVIOUS-DATE "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
 
 
 (PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
@@ -13,7 +15,7 @@
                          "/sources/MEDLEYDIR.LCOM"))
            (MEDLEY-INIT-VARS)
            (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
-        (FILES BACKGROUND-YIELD PAGEHOLD VTCHAT)
+        (FILES BACKGROUND-YIELD)
         (VARS 
               (* ;; "settings for new users")

 
@@ -40,7 +42,7 @@
 
 (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
 
-(FILESLOAD BACKGROUND-YIELD PAGEHOLD VTCHAT)
+(FILESLOAD BACKGROUND-YIELD)
 
 (RPAQQ DWIMWAIT
 180)
 
@@ -118,5 +120,5 @@
                                (CLASSIC 12)
                                (POSTSCRIPT (CLASSIC 12])
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1936 2761 (INTERLISPMODE 1946 . 2759)))))
+  (FILEMAP (NIL (1949 2774 (INTERLISPMODE 1959 . 2772)))))
 STOP

internal/MEDLEY-UTILS

@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "20-Feb-2022 12:59:27" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;4|
 12701  
+
(FILECREATED "31-May-2022 09:37:37" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;3|
 12695  
 
       :CHANGES-TO (FNS HCFILES)
 
-      :PREVIOUS-DATE "17-Feb-2022 21:44:44" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
+      :PREVIOUS-DATE "12-Mar-2022 12:46:25" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -138,16 +138,15 @@
     (GATHEREXPORTS EXPORTFILES (MEDLEYDIR "tmp" "exports.all" T))))
 
 (MAKE-WHEREIS-HASH

-  (LAMBDA NIL                                                (* \; 
-
                                                           "Edited 24-Mar-2021 13:26 by larry")

-    (LET ((FILING.ENUMERATION.DEPTH 1)
+  (LAMBDA NIL
                                               (* \; "Edited 12-Mar-2022 12:46 by rmk")


+                                                          (* \; "Edited 24-Mar-2021 13:26 by larry")

+    (LET ((FILING.ENUMERATION.DEPTH 2)
           HASHFILE)
          (DRIBBLE (MEDLEYDIR "tmp" "whereis.dribble" T))
          (SETQ HASHFILE (XCL::WHERE-IS-NOTICE (MEDLEYDIR "tmp" "whereis.hash-tmp" T)
                                :FILES
-                               (|for|
 X |in|
 MEDLEY-FIX-DIRS |collect|

-                                                                     (CONCAT (MEDLEYDIR X)
-                                                                            "*.;"))
+                               (|for|
 X |in|
 MEDLEY-FIX-DIRS |collect|
 (CONCAT (MEDLEYDIR X)
+                                                                              "*.;"))
                                :HASH-FILE-SIZE 60000 :NEW T))
          (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T))
          (DRIBBLE))))
@@ -160,58 +159,65 @@
 (DEFINEQ
 
 (HCFILES

-  (LAMBDA (TFILE PREFIX DEST REDOFLG TOPDIRLEN)
           (* \; "Edited 20-Feb-2022 12:16 by larry")


+  (LAMBDA (TFILE DEST REDOFLG TOPDIRLEN)
                  (* \; "Edited 31-May-2022 09:31 by larry")


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


                                                           (* \; "Edited 21-Aug-2021 20:56 by larry")

     (DECLARE
 (SPECVARS TFILE))
+    (|if|
 (NULL TFILE)
+        |then|
 (SETQ TFILE MEDLEYDIR))
     (COND
-       ((NULL TFILE)
-        (HCFILES
 MEDLEYDIR))
        ((DIRECTORYNAMEP TFILE)
+
+        (* |;;| "canonicalize")

+
         (SETQ TFILE (DIRECTORYNAME TFILE))
-        (OR TOPDIRLEN (SETQ TOPDIRLEN (IPLUS 1 (CL:LENGTH (MKSTRING (FILENAMEFIELD TFILE 'DIRECTORY))
-                                                      ))))
-        (OR DEST (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
+        (OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY))))
+        (CL:UNLESS DEST
+            (|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
+                                   "/tmp/psfiles/"))
+            (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
 
         (* |;;| "first deal with files in this directory")

 
-        (|for|
 X |in|
 (|if|
 (EQ REDOFLG 'REV)
-                          |then|
 (REVERSE (DIRECTORY (CONCAT TFILE "*.TED*;")))
-                        |else|
 (DIRECTORY (CONCAT TFILE "*.TED*;")))
-           |do|
 (HCFILES
 X PREFIX DEST REDOFLG TOPDIRLEN))
+        (|for|
 X |in|
 (DIRECTORY (CONCAT TFILE "*.TED*;")) |do|
 (HCFILES
 X DEST REDOFLG TOPDIRLEN))
 
         (* |;;| " then deal with subdirs ")

 
-        (|for|
 X |in|
 (|if|
 (EQ REDOFLG 'REV)
-                          |then|
 (REVERSE (DIRECTORY (CONCAT TFILE "*")))
-                        |else|
 (DIRECTORY (CONCAT TFILE "*")))
+        (|for|
 X |in|
 (DIRECTORY (CONCAT TFILE "*"))
            |when|
 (|for|
 SKIP |in|
 '(">." ">dinfo>") |always|
 (NOT (STRPOS SKIP (L-CASE X))))
-           |when|
 (DIRECTORYNAMEP X) |do|
 (HCFILES
 X PREFIX DEST REDOFLG TOPDIRLEN)))
+           |when|
 (DIRECTORYNAMEP X) |do|
 (HCFILES
 X DEST REDOFLG TOPDIRLEN)))
        ((SETQ TFILE (INFILEP TFILE))
-        (PROG ((PSFILE (PACKFILENAME.STRING 'EXTENSION (|if|
 (EQ REDOFLG 'IP)
-                                                           |then|
 'IP
-                                                         |else|
 "PS")
-                              'NAME
-                              (CONCAT (OR PREFIX "")
-                                     (|if|
 PREFIX
-                                         |then|
 "-"
-                                       |else|
 "")
-                                     (PACK (SUBST '- '> (UNPACK (SUBSTRING (FILENAMEFIELD
-                                                                            TFILE
-                                                                            'DIRECTORY)
-                                                                       (IPLUS 1 TOPDIRLEN)
-                                                                       -1))))
-                                     "-"
-                                     (FILENAMEFIELD TFILE 'NAME))
-                              'DIRECTORY DEST))
+        (LET* ((TF (UNPACKFILENAME.STRING TFILE))
+               (NAME (LISTGET TF 'NAME))
+               (DIR (LISTGET TF 'DIRECTORY))
+               (PSFILE (PACKFILENAME.STRING
+                        'EXTENSION
+                        (|if|
 (EQ REDOFLG 'IP)
+                            |then|
 "IP"
+                          |else|
 "PS")
+                        'NAME
+                        (|if|
 (EQ DEST T)
+                            |then|
                           (* \; "with the tedit file")

+                                  NAME
+                          |else|
 (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN
+                                                                                          )
+                                                                           -1))))
+                                        "-" NAME))
+                        'HOST
+                        (LISTGET TF 'HOST)
+                        'DIRECTORY
+                        (|if|
 (EQ DEST T)
+                            |then|
 DIR
+                          |else|
 DEST)))
                (TEXTSTREAM))
               (|if|
 (AND (NOT REDOFLG)
                          (INFILEP PSFILE))
                   |then|
                                     (* \; " do nothing")

                         (PRINTOUT T PSFILE " already there" T)
                 |elseif|
 (EQ REDOFLG 'TEST)
-                  |then|
 (PRINTOUT T "TESTING " TFILE)
+                  |then|
 (PRINTOUT T TFILE "-> " PSFILE T)
                         (CLOSEF (OPENTEXTSTREAM TFILE))
-                |else|
 (PRINTOUT T "Converting " TFILE "...")
+                |else|
 (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
                       (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
                              PSFILE T NIL NIL NIL (|if|
 (EQ REDOFLG 'IP)
                                                       |then|
 'INTERPRESS
@@ -224,6 +230,6 @@
 (RPAQ? HCFILES
 )
 (DECLARE\: DONTCOPY
   (FILEMAP (NIL (699 7147 (GATHER-INFO 709 . 6249) (MEDLEY-FIX-LINKS 6251 . 6774) (MEDLEY-FIX-DATES 6776
- . 7145)) (7246 9117 (MAKE-EXPORTS-ALL 7256 . 8272) (MAKE-WHEREIS-HASH 8274 . 9115)) (9152 12656 (
-HCFILES 9162 . 12654)))))
+ . 7145)) (7246 9096 (MAKE-EXPORTS-ALL 7256 . 8272) (MAKE-WHEREIS-HASH 8274 . 9094)) (9131 12650 (
+HCFILES 9141 . 12648)))))
 STOP

internal/TESTUPF

@@ -0,0 +1,546 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "23-May-2022 12:30:29" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TESTUPF.;1
 32843  )
+
+
+(PRETTYCOMPRINT TESTUPFCOMS)
+
+(RPAQQ TESTUPFCOMS

+       ((COMS                                                (* ; "Original code")

+              (FNS OLD-UNPACKFILENAME.STRING \UPF.NEXTPOS \UPF.TEMPFILEP)
+              (DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY UNPACKFILE1)))
+        
+        (* ;; "Debugging")

+
+        
+        (* ;; "DOTTEDNAMES:  mismatch intended")

+
+        
+        (* ;; "RETURNFAILS:  mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped.  But original doesn't agree with its own complete analaysis.")

+
+        (VARS DOTTEDNAMES TESTS RETURNFAILS)
+        (FNS TRY TRYALL DT)))
+
+
+
+(* ; "Original code")

+
+(DEFINEQ
+
+(OLD-UNPACKFILENAME.STRING

+  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)
     (* ; "Edited 25-Jan-2022 17:16 by rmk")


+                                                             (* ; "Edited  5-Jan-2022 11:03 by rmk")


+                                                             (* ; "Edited 30-Mar-90 22:37 by nm")

+
+(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")

+
+(* ;;; "rmk: devices must come before directories.")

+
+    (PROG ((POS 1)
+           (LEN (NCHARS FILE))
+           TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
+          (COND
+             ((NULL FILE)
+              (RETURN NIL))
+             ((OR (LITATOM FILE)
+                  (STRINGP FILE)
+                  (NUMBERP FILE)))
+             ((TYPEP FILE 'PATHNAME)
+              (RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
+             [(STREAMP FILE)                                 (* ; 
+
                                                 "For streams, use full name.  If anonymous, fake it")

+              (SETQ FILE (OR (ffetch
 FULLFILENAME of
 FILE)
+                             (RETURN (COND
+                                        (ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
+                                                          FILE))
+                                        (T (LIST 'NAME FILE]
+             (T (\ILLEGAL.ARG FILE)))
+          (COND
+             ((SELCHARQ (NTHCHARCODE FILE 1)
+                   ({                                        (* ; "normal use in Interlisp-D")

+                      (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS
 (CHARCODE })
+                                                 FILE 2)
+                                          0))))
+                   (%[                                       (* ; 
+
                                                    "some Xerox and Arpanet systems use '[' for host")

+                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS
 (CHARCODE "]")
+                                                  FILE 2)
+                                           0))))
+                   (%(                                       (* ; 
+
                                                  "this is the 'proposed standard' for Xerox servers")

+                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS
 (CHARCODE ")")
+                                                  FILE 2)
+                                           0))))
+                   NIL)
+              (UNPACKFILE1 'HOST 2 TEM)
+              [COND
+                 ((EQ TEM -1)                                (* ; 
+
      "Started with the host field delimiter, but there was no corresponding terminating delimiter .")

+                                                             (* ; 
+
                                             "I'm not sure why the name is dealt with the host name.")

+                  (RETURN (DREVERSE VAL]
+              (SETQ POS (IPLUS TEM 2))
+              [if
 (EQ OSTYPE T)
+                  then
                                       (* ; 
+
                                                             "Use actual host to determine os type")

+                       (SETQ OSTYPE (GETHOSTINFO (CAR VAL)
+                                           'OSTYPE]
+              (SETQ HOSTP T)))
+
+     (* ;; "rmk:  if there is a colon before the next < or /, then we must be looking at a device.  A device appears to end after the last colon, i.e., a device name can have a colon inside it.")

+
+          (COND
+             ((AND (SETQ TEM (\UPF.NEXTPOS
 (CHARCODE (%: < /))
+                                    FILE POS))
+                   (EQ (CHARCODE %:)
+                       (NTHCHARCODE FILE TEM)))              (* ; 
+
                                   "all device returned have DEVICE.END on it so that NIL: will work")

+              (UNPACKFILE1 'DEVICE POS (if
 CLFLG
+                                           then
 (SUB1 TEM)
+                                         else
 TEM))
+              (SETQ POS (ADD1 TEM))
+              (SETQ HOSTP T)))
+          (COND
+             ((EQ DIRFLG 'RETURN)                            (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter.  If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention.  In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")

+              (LET ((TYPE 'DIRECTORY)
+                    (START (SELCHARQ (NTHCHARCODE FILE POS)
+                                (NIL                         (* ; "just host, return")

+                                     (RETURN (DREVERSE VAL)))
+                                ((/ <)                       (* ; 
+
                                                      "Started with the initial directory delimiter.")

+                                     (ADD1 POS))
+                                POS))
+                    END)
+                   (SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
+                                  ((/ >) 
+                                       [COND
+                                          ((EQ START POS)    (* ; 
+
                                                           "Didn't start with a directory delimiter,")

+                                           (COND
+                                              ((NOT HOSTP)   (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")

+                                               (SETQ TYPE 'SUBDIRECTORY))
+                                              (T             (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")

+                                                 (SETQ TYPE 'RELATIVEDIRECTORY]
+                                       (COND
+                                          ((EQ LEN POS)      (* ; 
+
                                         "Only the initial directory is specified (i.e. %"{DSK}/%").")

+                                           (SETQ START POS)
+                                           -1)
+                                          (T -2)))
+                                  (PROGN [COND
+                                            [(EQ START POS)  (* ; 
+
                                              "Both of the initial and trail delimiters are omitted.")

+                                             (COND
+                                                ((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")

+                                                 (SETQ TYPE 'SUBDIRECTORY))
+                                                (T           (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")

+                                                   (SETQ TYPE 'RELATIVEDIRECTORY]
+                                            (T (COND
+                                                  ((EQ LEN POS)
+                                                             (* ; 
+
                                         "Only the initial directory is specified (i.e. %"{DSK}<%").")

+                                                   (SETQ START POS]
+                                         -1)))
+                   (UNPACKFILE1.DIRECTORY TYPE START END))
+              (RETURN (DREVERSE VAL)))
+             ((SELCHARQ (NTHCHARCODE FILE POS)
+                   (/                                        (* ; 
+
                                                  "unix and the 'xerox standard' use / for delimiter")

+                                                             (* ; 
+
                         "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")

+                      (SETQ TEM (LASTCHPOS (CHARCODE (/ >))
+                                       FILE
+                                       (ADD1 POS)))
+                      T)
+                   ((< >)                                    (* ; 
+
               "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>.  Jericho uses >>")

+                                                             (* ; 
+
                         "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")

+                        (SETQ TEM (LASTCHPOS (CHARCODE (> /))
+                                         FILE
+                                         (ADD1 POS)))
+                        T)
+                   NIL)
+
+              (* ;; "allow {DSK}/etc   to be a directory specification.")

+
+              (if
 TEM
+                  then
 (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
+                              (SUB1 TEM))
+                       (SETQ POS (ADD1 TEM))
+                else
 
+                     (* ;; "{DSK}/foo: the directory is /, the name is foo")

+
+                     (UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
+                     (SETQ POS (ADD1 POS)))
+              (SETQ HOSTP T))
+             ((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
+                               FILE POS))                    (* ; " {eris}abc>  relative")

+
+              (* ;; 
+
          " This is the true %"relative pathname%".  Returns RELATIVEDIRECTORY instead of DIRECTORY.")

+
+              [COND
+                 ((NOT HOSTP)                                (* ; "%"Incomplete file names%" case.")

+                  (UNPACKFILE1.DIRECTORY (if
 (EQ DIRFLG 'FIELD)
+                                             then
 'DIRECTORY
+                                           else
 'SUBDIRECTORY)
+                         POS
+                         (SUB1 TEM)))
+                 (T                                          (* ; "True %"relative pathname%".")

+                    (UNPACKFILE1.DIRECTORY (if
 (EQ DIRFLG 'FIELD)
+                                               then
 'DIRECTORY
+                                             else
 'RELATIVEDIRECTORY)
+                           POS
+                           (SUB1 TEM]
+              (SETQ POS (ADD1 TEM))
+              (SETQ HOSTP T)))
+          (OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
+              (RETURN (DREVERSE VAL)))
+          (if
 (EQ OSTYPE T)
+              then
                                           (* ; 
+
                                          "There wasn't a host field in the name, so we have no clue")

+                   (SETQ OSTYPE NIL))
+      NAMELP
+          
+
+     (* ;; "At this point, CODE is the TEM'th char of file name.  POS is the first character of the field we are currently working on.")

+
+          (SELCHARQ CODE
+               (%.                                           (* ; 
+
                            "Note position for later--we only want to deal with the last set of dots")

+                   (if
 BEYONDNAME
+                       then
                                  (* ; 
+
                                                   "no longer of interest (probably a bad name, too)")

+                     elseif
 FIRSTDOT
+                       then
                                  (* ; "We're recording the second dot")

+                            (if
 SECONDDOT
+                                then
                         (* ; 
+
                                                             "Note only the two most recent dots")

+                                     (SETQ FIRSTDOT SECONDDOT))
+                            (SETQ SECONDDOT TEM)
+                     else
 (SETQ FIRSTDOT TEM)))
+               ((! ; NIL)                                    (* ; 
+
                               "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")

+                    (if
 (SELCHARQ CODE
+                             (!                              (* ; 
+
                 "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")

+                                (AND OSTYPE (NEQ OSTYPE 'IFS)))
+                             (;                              (* ; "If we've already parsed the extension, then we have a semi in the middle of the version.  Skip it unless it's ;T or ;S")

+                                [AND BEYONDEXT (NOT (\UPF.TEMPFILEP
 FILE (ADD1 TEM])
+                             NIL)
+                        then
 (GO NEXTCHAR))
+                    (if
 FIRSTDOT
+                        then
                                 (* ; 
+
                                                          "Have a name and/or extension to parse now")

+                        (if

+                         [AND SECONDDOT
+                              (NOT (if
 OSTYPE
+                                       then
                  (* ; 
+
                                        "Known OS type must be Tops20 for second dot to mean version")

+                                            (EQ OSTYPE 'TOPS20)
+                                     else
                    (* ; 
+
                                  "Unknown OS type, so check that %"version%" is numeric or wildcard")

+                                          (AND [for
 I from
 (ADD1 SECONDDOT) to
 (SUB1 TEM)
+                                                  bind
 CH
+                                                  always
 (OR (DIGITCHARP (SETQ CH (NTHCHARCODE FILE I
+                                                                                         )))
+                                                             (EQ CH (CHARCODE *
]
+                                               (SELCHARQ CODE
+                                                    (NIL     (* ; "end of file name, ok")

+                                                         T)
+                                                    (;       (* ; 
+
                                                "This semi-colon better not be introducing a version")

+                                                       (\UPF.TEMPFILEP
 FILE (ADD1 TEM)))
+                                                    NIL]
+                            then
                             (* ; 
+
                                                             "Second dot is not intoducing a version")

+                                 (SETQ FIRSTDOT SECONDDOT)
+                                 (SETQ SECONDDOT NIL))
+                        (UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
+                        (SETQ POS (ADD1 (if
 SECONDDOT
+                                            then
 (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
+                                                        (SUB1 SECONDDOT))
+                                                 (SETQ BEYONDEXT T)
+                                                 SECONDDOT
+                                          else
 FIRSTDOT)))
+                        (SETQ BEYONDNAME T)
+                        (SETQ FIRSTDOT NIL))
+                    (UNPACKFILE1 (COND
+                                    ((NOT BEYONDNAME)
+                                     (SETQQ BEYONDNAME NAME))
+                                    ((NOT BEYONDEXT)
+                                     'EXTENSION)
+                                    ((AND (EQ BEYONDEXT (CHARCODE ";"))
+                                          (\UPF.TEMPFILEP
 FILE POS)))
+                                    (T                       (* ; 
+
                                                             "Everything after the semi was version")

+                                       'VERSION))
+                           POS
+                           (SUB1 TEM))
+                    (if
 (NULL CODE)
+                        then
                                 (* ; "End of string")

+                             (RETURN (DREVERSE VAL)))
+                    (SETQ BEYONDEXT CODE)                    (* ; 
+
                                                    "Note the character that terminated the name/ext")

+                    (SETQ POS (ADD1 TEM)))
+               (%'                                           (* ; "Quoter")

+                   (add
 TEM 1))
+               NIL)
+      NEXTCHAR
+          (SETQ CODE (NTHCHARCODE FILE (add
 TEM 1)))
+          (GO NAMELP])
+
+(\UPF.NEXTPOS

+  [LAMBDA (CHAR STRING POS)                                  (* lmm " 5-Oct-84 18:41")

+    (bind
 NCH while
 (SETQ NCH (NTHCHARCODE STRING POS)) do
 (COND
+                                                              ((EQMEMB NCH CHAR)
+                                                               (RETURN POS))
+                                                              ((EQ NCH (CHARCODE %'))
+                                                               (add
 POS 1)))
+                                                           (add
 POS 1])
+
+(\UPF.TEMPFILEP

+  [LAMBDA (FILENAME START)
                                   (* ; "Edited  6-Jan-88 13:12 by bvm:")

+
+    (* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START.  Returns the appropriate field name if so.  Not sure we should parse this junk any more, but this at least localizes it.")

+
+    (SELCHARQ (NTHCHARCODE FILENAME START)
+         ((T S)                                              (* ; "Funny temp stuff")

+              (AND (EQ START (NCHARS FILENAME))
+                   'TEMPORARY))
+         NIL])
+)
+(DECLARE%: DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS CANONICAL.DIRECTORY
 MACRO

+          [OPENLAMBDA (SRCSTRING)
+            (AND
+             SRCSTRING
+             (LET
+              ((LEN (NCHARS SRCSTRING)))
+              (COND
+                 ((EQ LEN 1)
+                  (if
 (STREQUAL SRCSTRING "/")
+                      then
 "<"
+                    else
 SRCSTRING))
+                 (T
+                  (LET*
+                   ((FATP (ffetch
 (STRINGP FATSTRINGP) of
 SRCSTRING))
+                    (DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
+                    (DSTBASE (ffetch
 (STRINGP BASE) of
 DSTSTRING))
+                    (DSTPOS 0)
+                    (NEXTPOS -1))
+                   (if
 (NOT FATP)
+                       then
 [for
 SRCPOS from
 1 to
 LEN bind
 CODE
+                               first
 (while
 (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
+                                                   (CHARCODE (< / >))) do
 (add
 SRCPOS 1))
+                                     (if
 (> SRCPOS LEN)
+                                         then
 (RETURN "<"))
+                               do
 (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
+                                       ((> /) 
+                                            (if
 (> DSTPOS NEXTPOS)
+                                                then
 (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
+                                                     (SETQ NEXTPOS (add
 DSTPOS 1))))
+                                       (%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
+                                           (add
 DSTPOS 1)
+                                           (if
 (NEQ SRCPOS LEN)
+                                               then
 (\PUTBASETHIN DSTBASE DSTPOS
+                                                           (NTHCHARCODE SRCSTRING (add
 SRCPOS 1)))
+                                                    (add
 DSTPOS 1)))
+                                       (PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
+                                              (add
 DSTPOS 1)))
+                               finally
 (RETURN (if
 (EQ DSTPOS LEN)
+                                                   then
 (if
 (EQMEMB (NTHCHARCODE DSTSTRING -1)
+                                                                   (CHARCODE (> /)))
+                                                            then
 (SUBSTRING DSTSTRING 1 -2)
+                                                          else
 DSTSTRING)
+                                                 elseif
 (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
+                                                               (CHARCODE (> /)))
+                                                   then
 (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
+                                                 else
 (SUBSTRING DSTSTRING 1 DSTPOS]
+                     else
 (for
 SRCPOS from
 1 to
 LEN bind
 CODE
+                             first
 (while
 (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
+                                                 (CHARCODE (< / >))) do
 (add
 SRCPOS 1))
+                             do
 (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
+                                     ((> /) 
+                                          (if
 (> DSTPOS NEXTPOS)
+                                              then
 (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
+                                                   (SETQ NEXTPOS (add
 DSTPOS 1))))
+                                     (%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
+                                         (add
 DSTPOS 1)
+                                         (if
 (NEQ SRCPOS LEN)
+                                             then
 (\PUTBASEFAT DSTBASE DSTPOS (NTHCHARCODE
+                                                                               SRCSTRING
+                                                                               (add
 SRCPOS 1)))
+                                                  (add
 DSTPOS 1)))
+                                     (PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
+                                            (add
 DSTPOS 1)))
+                             finally
 (RETURN (if
 (EQ DSTPOS LEN)
+                                                 then
 (if
 (EQMEMB (NTHCHARCODE DSTSTRING -1)
+                                                                 (CHARCODE (> /)))
+                                                          then
 (SUBSTRING DSTSTRING 1 -2)
+                                                        else
 DSTSTRING)
+                                               elseif
 (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
+                                                             (CHARCODE (> /)))
+                                                 then
 (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
+                                               else
 (SUBSTRING DSTSTRING 1 DSTPOS])
+
+(PUTPROPS UNPACKFILE1.DIRECTORY
 MACRO
 [OPENLAMBDA (NAM ST END)
+                                        (LET* ((OLDDIR (SUBSTRING FILE ST END))
+                                               (NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
+                                              (COND
+                                                 [(NOT ONEFIELDFLG)
+                                                  (SETQ VAL (CONS (COND
+                                                                     (PACKFLG (AND NEWDIR
+                                                                                   (MKATOM NEWDIR)))
+                                                                     (T (OR NEWDIR "")))
+                                                                  (CONS NAM VAL]
+                                                 ((EQMEMB NAM ONEFIELDFLG)
+                                                  (RETURN (COND
+                                                             (PACKFLG (AND NEWDIR (MKATOM NEWDIR)))
+                                                             (T (OR NEWDIR ""])
+
+(PUTPROPS UNPACKFILE1
 MACRO
 [OPENLAMBDA (NAM ST END)         (* lmm "22-APR-81 22:21")

+                              (COND
+                                 [(NOT ONEFIELDFLG)
+                                  (SETQ VAL (CONS (COND
+                                                     (PACKFLG (SUBATOM FILE ST END))
+                                                     (T (OR (SUBSTRING FILE ST END)
+                                                            "")))
+                                                  (CONS NAM VAL]
+                                 ((EQMEMB NAM ONEFIELDFLG)
+                                  (RETURN (COND
+                                             (PACKFLG (SUBATOM FILE ST END))
+                                             (T (OR (SUBSTRING FILE ST END)
+                                                    ""])
+)
+)
+
+
+
+(* ;; "Debugging")

+
+
+
+
+(* ;; "DOTTEDNAMES:  mismatch intended")

+
+
+
+
+(* ;; 
+"RETURNFAILS:  mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped.  But original doesn't agree with its own complete analaysis."
+)

+
+
+(RPAQQ DOTTEDNAMES
 (".x" ">.git" "x.y.100"))
+
+(RPAQQ TESTS

+       ("*,;" "*.*;*" "*.;" "*.;*" "///abc/x" "/abc.x" "<" "<<<abc" "<<<abc>" "<<<abc>>" "<<<abc>x" 
+              "<<abc" "<<xyz>>>zz" "<<xyz>>>zzz/" "<<xyz>>zz" "<<xyz>zz" "<ABC>" "<XYZ>aa" "<a.b>" 
+              "<a;b>" "<ab;c" "<ab>" "<abc" "<abc*." "<abc.x" "<abc.x;1" "<abc;x" "<abc<<<x" 
+              "<abc<xyz<foo" "<abc<xyz>qrs" "<abc>" "<abc>;1" "<abc>xyz" "<abc>xyz>foo" "<xxx" 
+              "<xy>>zz" "<xyz>>>zzz/" ">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" 
+              "A.B.C" "XXX<yyy" "a;b" "a;b/d" "a;b;c" "a;b;c;d" "aa" "aa;" "aa;NEWEST" "aa;newest" 
+              "aaa" "aaa/bbb" "aaa/bbb/" "aaa/xyz;x;m" "aaa<bbb" "aaa<bbb/" "aaa<xyz>" "aaa>bbb>" 
+              "aaa>xyz.e;m;n" "aaa>xyz>qrs" "abc" "abc...c" "abc///XYZ//" "abc/d" "abc/xyz" 
+              "abc/xyz.qrs" "abc/xyz.qrs;2" "abc:x<qrs>z" "abc<<<XYZ//" "abc<x" "abc<xyz" 
+              "abc<xyz>qq" "abc<xyzqq" "abc>;1" "abc>qr.x" "abc>xy" "abc>xyz" "abc>xyz;2" 
+              "dev:aaa>xyz>qrs" "foo:" "foo:aaa<xyz" "foo:aaa<xyz>" "foo:x<qrs>z" "foo<a:B>" "s;n;b"
+              "x.y.z;w" "x.y;z" "x;y" "x<abc<xyz>qrs" "x<abc<z" "x<abc>z" "xxx<yyy" "xxx<yyy>" 
+              "xxx<yyy>zzz" "xxx>yyy" "xxx>yyy>" "{ABC}" "{ABC}XXX:" "{DSK}" "{DSK}*.;*" "{DSK}...<a"
+              "{DSK}<a" "{DSK}xxx<a" "{DSK}xxx<xxx>yyy" "{DSK}xxx>xxx" "{DSK}xxx>yyy" 
+              "{HOST}foo:x<qrs>z" "{HOST}x<qrs>z" "{abc}" "{dsk}foo:aaa>b>.c.e.g;f" 
+              "{dsk}foo:aaa>b>.c.e;f" "{dsk}foo:aaa>b>c.e;f" "{eris}abc>" "{host}abc/xyz;2" 
+              "{host}abc>xyz;2" "{x}abc<xyz>qq" "{x}abc<xyzqq" "<abc<xyz>abc" "<abc<xyz>qrs" 
+              "<abc<xyz>"))
+
+(RPAQQ RETURNFAILS
 (">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" ">" ">>>abc/x" 
+                        ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"))
+(DEFINEQ
+
+(TRY

+  [LAMBDA (FILE ONEFIELDFLG DIRFLG)
                          (* ; "Edited 23-May-2022 12:09 by rmk")


+                                                             (* ; "Edited 25-Apr-2022 14:15 by rmk")


+                                                             (* ; "Edited 24-Apr-2022 08:45 by rmk")


+                                                             (* ; "Edited 21-Apr-2022 15:36 by rmk")

+    (CL:WHEN (LISTP (CAR (LISTP FILE)))
+        (SETQ FILE (CAR FILE)))
+    (LET (ORIG NEW)
+         (CL:WHEN (LISTP FILE)
+             (SETQ ONEFIELDFLG (CADR FILE))
+             (SETQ DIRFLG (CADDR FILE))
+             (SETQ FILE (CAR FILE)))
+         (SETQ ORIG (OLD-UNPACKFILENAME.STRING
 FILE ONEFIELDFLG DIRFLG))
+         (SETQ NEW (UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
+         (LIST (LIST FILE ONEFIELDFLG DIRFLG)
+               (AND (EQUAL ORIG NEW)
+                    '=)
+               ORIG NEW])
+
+(TRYALL

+  [LAMBDA (FILES ALLFLAG ONEFIELDFLG DIRFLG)
                 (* ; "Edited 21-Apr-2022 17:56 by rmk")


+                                                             (* ; "Edited  2-Apr-2022 23:50 by rmk")


+                                                             (* ; "Edited 31-Mar-2022 22:57 by rmk")

+    (CL:WHEN (LISTP FILES)
+        (SETQ FILES (FOR
 F IN
 FILES COLLECT
 (CL:IF (LISTP (CAR (LISTP F)))
+                                                (CAR F)
+                                                F))))
+    (FOR
 FILE INFO (SAME _ 0)
+         (DIFF _ 0) IN
 FILES EACHTIME
 (SETQ INFO (TRY
 FILE ONEFIELDFLG DIRFLG))
+                                   (CL:IF (CADR INFO)
+                                       (ADD
 SAME 1)
+                                       (ADD
 DIFF 1)) UNLESS
 (AND (CADR INFO)
+                                                                 (NOT ALLFLAG))
+       COLLECT
 (PRINTOUT T .P2 (CAAR INFO)
+                      31)
+             (IF
 (CADR INFO)
+                 THEN
 (PRINTOUT T "  = " .P2 (CADDR INFO))
+                      (CL:WHEN (OR (CADAR INFO)
+                                   (CADDAR INFO))
+                          (PRINTOUT T 60 (CADAR INFO)
+                                 %,,
+                                 (CADDAR INFO))
+                          (TERPRI T))
+               ELSE
 (PRINTOUT T " ~= " -2 "old: " .P2 (CADDR INFO))
+                    (CL:WHEN (OR (CADAR INFO)
+                                 (CADDAR INFO))
+                        (PRINTOUT T 60 (CADAR INFO)
+                               %,,
+                               (CADDAR INFO))
+                        (TERPRI T))
+                    (PRINTOUT T 37 "new: " .P2 (CADDDR INFO)
+                           T))
+             INFO FINALLY
 (PRINTOUT T SAME " matches, " DIFF " mismatches" T])
+
+(DT

+  [LAMBDA (STRINGS ALLFLAG)
                                  (* ; "Edited 21-Apr-2022 17:53 by rmk")


+                                                             (* ; "Edited 19-Apr-2022 20:55 by rmk")

+
+    (* ;; "Tests the DIRFLG options on STRINGS.  If an element of STRINGS is a list, it is assumed to be a (STRING ONEFIELD DIRFLG), STRING is extracted.")

+
+    (SETQ STRINGS (FOR
 S INSIDE
 STRINGS COLLECT
 (CL:IF (LISTP S)
+                                                    (CAR S)
+                                                    S)))
+    [AND NIL (FOR
 ONEFIELD IN
 '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
+                JOIN
 (FOR
 DIR ORIG NEW SAME IN
 '(FIELD RETURN)
+                        JOIN
 (PRINTOUT T T "ONEFIELDFLG = " ONEFIELD -3 "DIRFLG = " DIR T T)
+                             (TRYALL
 STRINGS ALLFLAG ONEFIELD DIR))
+                FINALLY
 (FOR
 INFO SAME (DIFF _ 0) IN
 $$VAL DO
 (CL:IF (CADR INFO)
+                                                                  (ADD
 SAME 1)
+                                                                  (ADD
 DIFF 1))
+                           FINALLY
 (SETQ SAME (IDIFFERENCE (LENGTH STRINGS)
+                                                     DIFF))
+                                 (PRINTOUT T T "Overall:  " SAME " matched, " DIFF " mismatched" T]
+    (TRYALL
 (FOR
 S IN
 STRINGS JOIN
 (FOR
 ONEFIELD IN
 '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
+                                      JOIN
 (FOR
 DIR IN
 '(FIELD RETURN)
+                                              COLLECT
 (LIST S ONEFIELD DIR])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (893 18981 (OLD-UNPACKFILENAME.STRING 903 . 17808) (\UPF.NEXTPOS 17810 . 18396) (
+\UPF.TEMPFILEP 18398 . 18979)) (28216 32820 (TRY 28226 . 29192) (TRYALL 29194 . 31111) (DT 31113 . 
+32818)))))
+STOP

internal/TESTUPF.TXT

@@ -0,0 +1,23 @@
+TESTUPF contains functions for testing the new implementation of UNPACKFILENAME.STRING (now in ADIR) and the original definition.
+
+The original definition is also provided here, under the name OLD-UNPACKFILENAME.STRING
+
+TESTUPF also includes some test functions, and some of the strings that I have been testing with.
+
+(TRY FILE ONEDIRFLG DIRFLG)
+
+returns a comparison of the behavior of the original version and the new version in a list of the form 
+
+(FILE ONEDIRFLG DIRFLG) MATCH ORIG NEW)
+
+where MATCH is = if ORIG and NEW are EQUAL, otherwise NIL. (For convenience, a list of this form can also be passed in as an argument.)
+
+(TRYALL FILES ALLFLG ONDIRFLG DIRFLG)
+
+applies TRY to each file-string in FILES, prints and reports what it discovers. If ALLFLG, it prints the result on every file, otherwise just the mismatches. Value is a list of TRY values that it printed.
+
+(DT FILES) sets up a call to TRYALL for DIRFLG testing (setting DIRFLG NIL, FIELD, RETURN for each file in FILES).
+
+The variable TESTS has the strings that I have tested against, the variable DOTTEDNAMES has the strings that I intend to be different (.cshrc as NAME, not EXTENSION).  The new behavior avoids the bug that (PACKFILENAME.STRING 'EXTENSION "txt "BODY ".bashrc") produces  ".txt" instead of ".bashrc.txt".
+
+The variable RETURNFAILS is a list of strings with DIRFLG=RETURN that also don¹t match, in that the DIRECTORY and SUBDIRECTORY classifications are inverted between old and new for strings beginning with ª>". But the old code is inconsistent  for these inputs:  it returns different classifications of those substrings with or without the RETURN. (I think RETURN is for the case "/Users/kaplan" where the caller knows that the whole thing is a directory, doesn¹t want ªkaplanº to be parsed as a name. Just wants it to be normalized, with host and device stripped off.)

library/CLIPBOARD.TXT

@@ -4,13 +4,13 @@ Written by Ron Kaplan, 2020-2021
 
 A small package that implements copy and paste to the system clipboard.
 
-It arms meta-C for copy to the clipboard from the current selection of an application that has been armed (Tedit, Sedit), and also meta-X for extraction (copy followed by delete).
+For Tedit, Sedit, and perhaps other applications, meta-C is armed for copy to the clipboard from the current selection, and also meta-X is armed for extraction (copy followed by delete).
 
-Meta-V is defined as an interrupt character that pastes the current clipboard contents into whatever process curent has input focus.
+Meta-V is defined as an interrupt character that pastes the current clipboard contents into whatever process currently has input focus.
 
-The information in the clipboard can be provided from or provided to external (non-Medley) applications (mail, emacs, etc.) in the usual way.  For example, a form cselected in SEDIT can be copied to the clipboard and pasted into an email message.
+The information in the clipboard can be provided from or provided to external (non-Medley) applications (mail, emacs, etc.) in the usual way.  For example, a form selected in SEDIT can be copied to the clipboard and pasted into an email message.
 
-It assumes that the clipboard is a utf-8/unicode stream, and uses the UNICODE package to convert to and from the Medley internal character encoding (XCCS).
+It assumes that the clipboard is a UTF-8/Unicode stream, and uses the UNICODE package to convert to and from the Medley internal character encoding (XCCS).
 
 The name of the clipboard stream may differ from platform to platform.  On the Mac, the paste stream is "pbpaste" and the copy stream is "pbcopy".  Those names are used if "darwin" is a substring of (UNIX-GETENV "ostype").  Otherwise both stream-names default to "xclip".  The functions CLIPBOARD-COPY-STREAM and CLIPBOARD-PASTE-STREAM perform this selection.
 

library/COPYFILES

@@ -1,15 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 6-Apr-2018 21:14:29" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>COPYFILES.;2
 23656  
 
-      changes to%:  (FNS MAPFILES)
+
(FILECREATED "26-Mar-2022 11:43:49" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>COPYFILES.;3
 23773  
 
-      previous date%: "23-Mar-93 02:39:53" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>COPYFILES.;1)
+      :CHANGES-TO (FNS MAPFILES)
+
+      :PREVIOUS-DATE " 6-Apr-2018 21:14:29" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>COPYFILES.;1)
 
 
 (* ; "
-Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1989-1991, 1993, 2018 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT COPYFILESCOMS)
@@ -18,15 +18,15 @@ Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation.  All ri
        ((FNS COPYFILES MAPFILES MAPFILES1 COPIEDFILENAME COPIEDFILEPATTERN COPIEDFILEMATCH 
              COPIEDFROMSPEC COPIEDTOSPEC ESPATTERN NOHOST COMPAREFILES)
         (COMS 
-              (* ;; "For concatenating a list of files into one file.")

+              (* ;; "For concatenating a list of files into one file.")

 
               (FNS CONCATFILES))
         (COMS 
-              (* ;; "For splitting a big file into several files.")

+              (* ;; "For splitting a big file into several files.")

 
               (FNS SPLITFILE))
         (COMS 
-              (* ;; "For making DOS file systems")

+              (* ;; "For making DOS file systems")

 
               (FNS DOSLINKER SHORTEN))
         (I.S.OPRS INFILES)))
@@ -37,37 +37,41 @@ Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation.  All ri
 )
 
 (MAPFILES

-  [LAMBDA (FILESPEC FN ATTRIBUTES DEFAULTEXT DEFAULTVERS INCLUDE-DIRECTORIES ENUMERATE-FIRST)

-                                                            (* ; "Edited  6-Apr-2018 21:14 by rmk:")

+  [LAMBDA (FILESPEC FN ATTRIBUTES DEFAULTEXT DEFAULTVERS INCLUDE-DIRECTORIES ENUMERATE-FIRST)
 
-    (* ;; "Run thru all the files that match FILESPEC, calling FN on each such file name, with remaining args being the value of each of the ATTRIBUTES of the file")

+    (* ;; "Edited 26-Mar-2022 11:43 by rmk: Respect DEFAULTEXT/VERS in singleton no-stars case")

+
+    (* ;; "Edited  6-Apr-2018 21:14 by rmk:")

+
+    (* ;; "Run thru all the files that match FILESPEC, calling FN on each such file name, with remaining args being the value of each of the ATTRIBUTES of the file")

 
     (if
 (LISTP FILESPEC)
-        then
 (for
 X in
 FILESPEC do
 (MAPFILES
 X FN DEFAULTEXT DEFAULTVERS 
-                                                          ATTRIBUTES INCLUDE-DIRECTORIES 
-                                                          ENUMERATE-FIRST))
+        then
 (for
 X in
 FILESPEC do
 (MAPFILES
 X FN DEFAULTEXT DEFAULTVERS ATTRIBUTES 
+                                          INCLUDE-DIRECTORIES ENUMERATE-FIRST))
       elseif
 [OR (STRPOS "*" FILESPEC)
-                     (FMEMB (NTHCHARCODE FILESPEC -1)
-                            (CHARCODE (/ > %) %] } %:]
-        then
                                             (* ; "Pattern or directory spec")

-              (SETQ FILESPEC (DIRECTORY.FILL.PATTERN FILESPEC DEFAULTEXT DEFAULTVERS))
-              (if
 ENUMERATE-FIRST
-                  then
                                   (* ; 
-
                                                      "Generate all the files first, then apply fn")

-                        (for
 PAIR in
 [XCL:WITH-COLLECTION (MAPFILES1

-                                                                   FILESPEC ATTRIBUTES 
-                                                                   INCLUDE-DIRECTORIES
-                                                                   (FUNCTION (CL:LAMBDA
-                                                                              (NAME &REST ATTRS)
-                                                                              (XCL:COLLECT
-                                                                               (CONS NAME ATTRS]
-                           do
 (CL:APPLY FN (CAR PAIR)
-                                         (CDR PAIR)))
-                else
                                     (* ; "Call on each one as we go")

-                      (MAPFILES1
 FILESPEC ATTRIBUTES INCLUDE-DIRECTORIES FN))
-      elseif
 (SETQ FILESPEC (INFILEP FILESPEC))
-        then
 (CL:APPLY FN FILESPEC (for
 ATTR inside
 ATTRIBUTES
-                                          collect
 (GETFILEINFO FILESPEC ATTR])
+                 (FMEMB (NTHCHARCODE FILESPEC -1)
+                        (CHARCODE (/ > %) %] } %:]
+        then
                                                 (* ; "Pattern or directory spec")

+             (SETQ FILESPEC (DIRECTORY.FILL.PATTERN FILESPEC DEFAULTEXT DEFAULTVERS))
+             (if
 ENUMERATE-FIRST
+                 then
                                        (* ; 
+
                                                        "Generate all the files first, then apply fn")

+                      (for
 PAIR in
 [XCL:WITH-COLLECTION (MAPFILES1
 FILESPEC ATTRIBUTES 
+                                                               INCLUDE-DIRECTORIES
+                                                               (FUNCTION (CL:LAMBDA
+                                                                          (NAME &REST ATTRS)
+                                                                          (XCL:COLLECT (CONS NAME 
+                                                                                             ATTRS]
+                         do
 (CL:APPLY FN (CAR PAIR)
+                                   (CDR PAIR)))
+               else
                                          (* ; "Call on each one as we go")

+                    (MAPFILES1
 FILESPEC ATTRIBUTES INCLUDE-DIRECTORIES FN))
+      elseif
 (SETQ FILESPEC (INFILEP (PACKFILENAME.STRING 'BODY FILESPEC 'EXTENSION DEFAULTEXT
+                                            'VERSION DEFAULTVERS)))
+        then
 
+             (* ;; "rmk:  Singleton, no stars.  We don't want to coerce NIL DEFAULTVERS/EXT to *, but still we want to pay attention to them.  Hence, do the packfilename")

+
+             (CL:APPLY FN FILESPEC (for
 ATTR inside
 ATTRIBUTES collect
 (GETFILEINFO FILESPEC ATTR])
 
 (MAPFILES1

 (LAMBDA (FILESPEC ATTRIBUTES INCLUDE-DIRECTORIES FN) (* ; "Edited 27-Sep-89 14:49 by bvm") (* ;; "Enumerate FILESPEC (pattern must already be filled) and apply FN to each file and its ATTRIBUTES") (RESETLST (LET ((FILEGROUP (\GENERATEFILES FILESPEC (SETQ ATTRIBUTES (MKLIST ATTRIBUTES)) (QUOTE (SORT RESETLST)))) NAME LEN) (while (SETQ NAME (\GENERATENEXTFILE FILEGROUP)) unless (PROGN (* ; "Skip IFS's <dir>.;1 file.  Also other dir files unless INCLUDE-DIRECTORIES is true.") (OR (AND (>= (SETQ LEN (NCHARS NAME)) 4) (STRING-EQUAL NAME ".;1" :START1 (- LEN 4))) (AND (NOT INCLUDE-DIRECTORIES) (FMEMB (NTHCHARCODE NAME LEN) (CHARCODE (/ >)))))) do (if (NULL (CDR ATTRIBUTES)) then (* ; "Optimize slightly for the case of one attribute") (CL:FUNCALL FN NAME (\GENERATEFILEINFO FILEGROUP (CAR ATTRIBUTES))) else (CL:APPLY FN NAME (for ATTR in ATTRIBUTES collect (\GENERATEFILEINFO FILEGROUP ATTR))))))))
@@ -213,16 +217,16 @@ Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation.  All ri
                               'GENVAR
                               '(BIND
 GENVAR _ (\GENERATEFILES BODY NIL '(SORT))
                                   EACHTIME
 (PROGN (OR (SETQ I.V. (\GENERATENEXTFILE GENVAR))
-                                                          (GO $$OUT))
-                                                      (IF
 (LISTP I.V.)
-                                                          THEN
 (SETQ I.V. (CONCATCODES I.V.]
+                                                      (GO $$OUT))
+                                                  (IF
 (LISTP I.V.)
+                                                      THEN
 (SETQ I.V. (CONCATCODES I.V.]
        T)
 )
 (PUTPROPS COPYFILES COPYRIGHT ("Venue & Xerox Corporation" 1989 1990 1991 1993 2018))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1047 20469 (COPYFILES 1057 . 9186) (MAPFILES 9188 . 11549) (MAPFILES1 11551 . 12470) (
-COPIEDFILENAME 12472 . 13818) (COPIEDFILEPATTERN 13820 . 14874) (COPIEDFILEMATCH 14876 . 15368) (
-COPIEDFROMSPEC 15370 . 16169) (COPIEDTOSPEC 16171 . 16831) (ESPATTERN 16833 . 17114) (NOHOST 17116 . 
-17277) (COMPAREFILES 17279 . 20467)) (20536 20846 (CONCATFILES 20546 . 20844)) (20909 22086 (SPLITFILE
- 20919 . 22084)) (22132 23009 (DOSLINKER 22142 . 22919) (SHORTEN 22921 . 23007)))))
+  (FILEMAP (NIL (1019 20598 (COPYFILES 1029 . 9158) (MAPFILES 9160 . 11678) (MAPFILES1 11680 . 12599) (
+COPIEDFILENAME 12601 . 13947) (COPIEDFILEPATTERN 13949 . 15003) (COPIEDFILEMATCH 15005 . 15497) (
+COPIEDFROMSPEC 15499 . 16298) (COPIEDTOSPEC 16300 . 16960) (ESPATTERN 16962 . 17243) (NOHOST 17245 . 
+17406) (COMPAREFILES 17408 . 20596)) (20665 20975 (CONCATFILES 20675 . 20973)) (21038 22215 (SPLITFILE
+ 21048 . 22213)) (22261 23138 (DOSLINKER 22271 . 23048) (SHORTEN 23050 . 23136)))))
 STOP

library/SAMEDIR

@@ -1,14 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 1-Sep-2020 11:40:26" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>SAMEDIR.;9
 5511   
 
-      changes to%:  (FNS CHECKSAMEDIR)
+
(FILECREATED "25-Apr-2022 09:23:16" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SAMEDIR.;3
 5583   
 
-      previous date%: "25-Aug-2020 07:42:08" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>SAMEDIR.;6)
+      :CHANGES-TO (FNS HOST&DIRECTORYFIELD CHECKSAMEDIR)
+
+      :PREVIOUS-DATE " 1-Sep-2020 11:40:26" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SAMEDIR.;1)
 
 
 (* ; "
-Copyright (c) 1982, 1984, 1985, 1986, 1987, 1990, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT SAMEDIRCOMS)
@@ -24,41 +25,40 @@ Copyright (c) 1982, 1984, 1985, 1986, 1987, 1990, 2018, 2020 by Venue & Xerox Co
 (DEFINEQ
 
 (CHECKSAMEDIR

-  [LAMBDA (FILE)
                                        (* ; "Edited  1-Sep-2020 11:40 by rmk:")

+  [LAMBDA (FILE)
                                             (* ; "Edited 25-Apr-2022 09:16 by rmk")


+                                                            (* ; "Edited  1-Sep-2020 11:40 by rmk:")

 
-    (* ;; "Check (a) that we are writing FILE to the same directory we last read/wrote it and (b) that a version newer than the current one has not since appeared.")

+    (* ;; "Check (a) that we are writing FILE to the same directory we last read/wrote it and (b) that a version newer than the current one has not since appeared.")

 
-    (* ;; " OKHOST/DIRS is a list of places it's OK for the file to be winding up, so if your'e migrating code from one place ot another, you can do it gracefully.")

+    (* ;; " OKHOST/DIRS is a list of places it's OK for the file to be winding up, so if your'e migrating code from one place ot another, you can do it gracefully.")

 
     [RESETSAVE (DIRECTORYNAME T)
-           '(PROGN (CNDIR OLDVALUE]                          (* ; 
-
                                                           "Assumes that MAKEFILE has  RESETLST")

+           '(PROGN (CNDIR OLDVALUE]                          (* ; 
+
                                                             "Assumes that MAKEFILE has  RESETLST")

     (PROG ((*UPPER-CASE-FILE-NAMES* NIL)
-           (DATES (GET (SETQ FILE (MKATOM (U-CASE FILE)))
+           (DATES (GET (SETQ FILE (ROOTFILENAME FILE))
                        'FILEDATES))
            HOST/DIR HOST DIR NEWV OKHOST/DIRS)
       AGAIN
           (OR (LISTP DATES)
-              (RETURN))                                      (* ; 
-
                   "RMK: Use HOST&DIRECTORYFIELD to canonicalize both file and connected directory")

+              (RETURN))                                      (* ; 
+
                     "RMK: Use HOST&DIRECTORYFIELD to canonicalize both file and connected directory")

           [SETQ OKHOST/DIRS (CONS (SETQ HOST/DIR (HOST&DIRECTORYFIELD
 (DIRECTORYNAME T)))
                                   (MKLIST (CDR (ASSOC HOST/DIR MIGRATIONS :TEST 'STRING-EQUAL]
           (COND
-             ((for
 OLDFILE in
 DATES bind
 HOST DIR never
 (CL:MEMBER
-                                                                         (HOST&DIRECTORYFIELD

-                                                                          (CDR OLDFILE))
-                                                                         OKHOST/DIRS :TEST
-                                                                         'STRING-EQUAL))
+             ((for
 OLDFILE in
 DATES bind
 HOST DIR never
 (CL:MEMBER (HOST&DIRECTORYFIELD
 (CDR OLDFILE)
+                                                                          )
+                                                               OKHOST/DIRS :TEST 'STRING-EQUAL))
 
-              (* ;; "The file is going somewhere it has never been before.  ")

+              (* ;; "The file is going somewhere it has never been before.  ")

 
-              (* ;; "Check that that is really what the user wants.")

+              (* ;; "Check that that is really what the user wants.")

 
               (SELECTQ (ASKUSER SAMEDIRWAIT SAMEDIRDEFAULT (LIST "You haven't loaded or written" FILE
                                                                  "in your connected directory" 
                                                                  HOST/DIR "-- write it out anyway")
                               `[[O ,(CONCAT "Oops!  Make file on " (SETQ HOST/DIR (
-
                                                                                HOST&DIRECTORYFIELD

+
                                                                                  HOST&DIRECTORYFIELD

                                                                                    (CDAR DATES]
                                 (C "Make file on other directory: ")
                                 (Y ,(CONCAT "Yes, write it here")
@@ -76,13 +76,13 @@ Copyright (c) 1982, 1984, 1985, 1986, 1987, 1990, 2018, 2020 by Venue & Xerox Co
              ([AND [SETQ NEWV (INFILEP (PACKFILENAME.STRING 'VERSION NIL 'BODY (CDAR DATES]
                    (NOT (STRING-EQUAL NEWV (CDAR DATES]
 
-              (* ;; "A newer version appeared while the user was editing this file.")

+              (* ;; "A newer version appeared while the user was editing this file.")

 
-              (* ;; "Ask if he should over-write it.")

+              (* ;; "Ask if he should over-write it.")

 
               (SELECTQ (ASKUSER 15 'Y (LIST (CDAR DATES)
                                             "is not the most recent version (version"
-                                            (MKSTRING (FILENAMEFIELD NEWV 'VERSION))
+                                            (FILENAMEFIELD.STRING NEWV 'VERSION)
                                             "has since appeared)." 
                                             "Do you want to make the file anyway"))
                   (Y)
@@ -90,15 +90,16 @@ Copyright (c) 1982, 1984, 1985, 1986, 1987, 1990, 2018, 2020 by Venue & Xerox Co
                   (SHOULDNT])
 
 (HOST&DIRECTORYFIELD

-  [LAMBDA (FILENAME)
                                    (* ; "Edited 15-Apr-2018 19:05 by rmk:")

+  [LAMBDA (FILENAME)
                                         (* ; "Edited 25-Apr-2022 09:22 by rmk")


+                                                            (* ; "Edited 15-Apr-2018 19:05 by rmk:")

 
-    (* ;; "Returns the host&dir fields packed together.  HOST and device are upper cased")

+    (* ;; "Returns the host&dir fields packed together.  HOST and device are upper cased")

 
-    (PACKFILENAME.STRING 'DEVICE (U-CASE (FILENAMEFIELD FILENAME 'DEVICE))
+    (PACKFILENAME.STRING 'DEVICE (U-CASE (FILENAMEFIELD.STRING FILENAME 'DEVICE))
            'HOST
-           (U-CASE (FILENAMEFIELD FILENAME 'HOST))
+           (U-CASE (FILENAMEFIELD.STRING FILENAME 'HOST))
            'DIRECTORY
-           (FILENAMEFIELD FILENAME 'DIRECTORY])
+           (FILENAMEFIELD.STRING FILENAME 'DIRECTORY])
 )
 
 (RPAQ? SAMEDIRWAIT
 10)
@@ -106,7 +107,7 @@ Copyright (c) 1982, 1984, 1985, 1986, 1987, 1990, 2018, 2020 by Venue & Xerox Co
 (RPAQ? SAMEDIRDEFAULT
 'O)
 
 (ADDTOVAR MAKEFILEFORMS
 (OR (NLSETQ (CHECKSAMEDIR FILE))
-                                (RETFROM 'MAKEFILE)))
+                            (RETFROM 'MAKEFILE)))
 
 (ADDTOVAR MIGRATIONS
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -115,5 +116,5 @@ Copyright (c) 1982, 1984, 1985, 1986, 1987, 1990, 2018, 2020 by Venue & Xerox Co
 )
 (PUTPROPS SAMEDIR COPYRIGHT ("Venue & Xerox Corporation" 1982 1984 1985 1986 1987 1990 2018 2020))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (817 5124 (CHECKSAMEDIR 827 . 4681) (HOST&DIRECTORYFIELD 4683 . 5122)))))
+  (FILEMAP (NIL (802 5200 (CHECKSAMEDIR 812 . 4623) (HOST&DIRECTORYFIELD 4625 . 5198)))))
 STOP

library/TEDIT

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-Dec-2021 20:50:54" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDIT.;30
 142870 
+
(FILECREATED " 6-Jun-2022 00:36:53" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEDIT.;40
 143378 
 
-      :CHANGES-TO (FNS TEDIT TEDIT-SEE)
+      :CHANGES-TO (FNS TEDIT)
 
-      :PREVIOUS-DATE "28-Dec-2021 11:02:43" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDIT.;24)
+      :PREVIOUS-DATE " 4-Jun-2022 15:43:05" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEDIT.;39)
 
 
 (* ; "
@@ -31,12 +32,12 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 
                                                    "Changed by yabu.fx, for SUNLOADUP without DWIM.")

               )
         (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
-        (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)
+        (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDITSTRING 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?.")

@@ -250,22 +251,35 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
                       NIL])
 
 (TEDIT

-  [LAMBDA (TEXT WINDOW DONTSPAWN PROPS)                      (* ; "Edited 30-Dec-2021 20:50 by rmk")

-                                                             (* ; "Edited 28-Dec-2021 00:12 by rmk")

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

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

-                                                             (* ; "Edited  3-Jun-88 14:27 by jds")

+  [LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
+
+    (* ;; "Edited  6-Jun-2022 00:35 by rmk")

+
+    (* ;; "Edited  4-Jun-2022 15:42 by rmk")

+
+    (* ;; "Edited 31-Jan-2022 17:19 by rmk: String TEXT is a file name")

+
+    (* ;; "Edited 30-Dec-2021 20:50 by rmk")

+
+    (* ;; "Edited 28-Dec-2021 00:12 by rmk")

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

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

+
+    (* ;; "Edited  3-Jun-88 14:27 by jds")

 
     (* ;; "User entry to the text editor.  Takes an optional window to be used for editing")

 
     (* ;; "DONTSPAWN => Don't try to create a new process for this edit.")

 
-    (PROG (PROC TEDITCREATEDWINDOW)                          (* ; 
-
                                                        "Include the default properties in the list.")

+    (PROG (PROC TEDITCREATEDWINDOW)
           [COND
-             ((AND TEXT (ATOM TEXT))                         (* ; 
+             ((AND TEXT (OR (LITATOM TEXT)
+                            (STRINGP TEXT)
+                            (CL:PATHNAMEP TEXT)))            (* ; 
 
                                        "Make sure the file exists before trying to open the window.")

-              (SETQ TEXT (OPENFILE TEXT 'INPUT 'OLD '((TYPE TEXT]
+              (SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '((TYPE TEXT]
           (CL:WHEN (AND WINDOW (OR (LITATOM WINDOW)
                                    (REGIONP WINDOW)))
 
@@ -284,10 +298,9 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
                                            (NOT TEDIT.DEFAULT.WINDOW)
                                            (\TEDIT.ACTIVE.WINDOWP TEDIT.DEFAULT.WINDOW))
                                        (TEDIT.CREATEW (COND
-                                                         ((AND TEXT (ATOM TEXT))
-                                                          (CONCAT 
+                                                         (TEXT (CONCAT 
                                                               "Please specify an editing window for "
-                                                                 TEXT))
+                                                                      (FULLNAME TEXT)))
                                                          (T 
                                                     "Please specify a region for the editing window."
                                                             ))
@@ -336,11 +349,24 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
                     (TTY.PROCESS PROC)))
                 (RETURN PROC])
 
+(TEDITSTRING

+  [LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
+
+(* ;;; "Edited 23-May-2022 15:52 by rmk")

+
+(* ;;; "Edited 19-May-2022 22:46 by rmk: An interface function to replace calls to TEDIT when the text argument may be the string to be edited rather than the name of a file.  This enables the transition that gets TEDIT aligned with the convention that strings, as well as litatoms, are file names")

+
+    (TEDIT
 (IF
 (STRINGP TEXT)
+               THEN
 (OPENSTRINGSTREAM TEXT)
+             ELSE
 TEXT)
+           WINDOW DONTSPAWN PROPS])
+
 (TEDIT-SEE

-  [LAMBDA (FILE WINDOW FORMAT TITLE)                         (* ; "Edited 30-Dec-2021 18:03 by rmk")

-                                                             (* ; "Edited 16-Dec-2021 12:33 by rmk")

-                                                             (* ; "Edited 13-Oct-2021 10:00 by rmk:")

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

+  [LAMBDA (FILE WINDOW FORMAT TITLE)
                         (* ; "Edited  5-May-2022 15:18 by rmk")


+                                                             (* ; "Edited 30-Dec-2021 18:03 by rmk")


+                                                             (* ; "Edited 16-Dec-2021 12:33 by rmk")


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

@@ -359,8 +385,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
                          (* ;; "Lisp source file")

 
                          (SETQ SEESTREAM (OPENTEXTSTREAM))
-                         (DSPFONT DEFAULTFONT SEESTREAM)
-                         (COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
+                         (APPLY* (FUNCTION SEE)
+                                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.")

 
@@ -2243,7 +2269,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (* ; "TEDIT Support information")

 
 
-(RPAQQ TEDITSYSTEMDATE
 "30-Dec-2021 20:50:54")
+(RPAQQ TEDITSYSTEMDATE
 " 6-Jun-2022 00:36:53")
 
 (RPAQ TEDITSUPPORT
 "TEditSupport.PA")
 (DEFINEQ
@@ -2269,19 +2295,20 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
 1992 1993 1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4336 118040 (\TEDIT2 4346 . 7097) (COERCETEXTOBJ 7099 . 15875) (TEDIT 15877 . 21230) (
-TEDIT-SEE 21232 . 23716) (TEDIT.CHARWIDTH 23718 . 25742) (TEDIT.COPY 25744 . 34180) (TEDIT.DELETE 
-34182 . 34872) (TEDIT.DO.BLUEPENDINGDELETE 34874 . 37941) (TEDIT.INSERT 37943 . 43473) (TEDIT.KILL 
-43475 . 45032) (TEDIT.MAPLINES 45034 . 46433) (TEDIT.MAPPIECES 46435 . 47391) (TEDIT.MOVE 47393 . 
-57177) (TEDIT.QUIT 57179 . 59179) (TEDIT.STRINGWIDTH 59181 . 59852) (TEDIT.\INSERT 59854 . 61879) (
-TEXTOBJ 61881 . 63006) (TEXTSTREAM 63008 . 64623) (\TEDIT.INCLUDE 64625 . 68525) (\TEDIT.INSERT.PIECES
- 68527 . 78442) (\TEDIT.MOVE.PIECEMAPFN 78444 . 80523) (\TEDIT.OBJECT.SHOWSEL 80525 . 84154) (
-\TEDIT.RESTARTFN 84156 . 86151) (\TEDIT.CHARDELETE 86153 . 90115) (\TEDIT.COPY.PIECEMAPFN 90117 . 
-93342) (\TEDIT.DELETE 93344 . 100862) (\TEDIT.DIFFUSE.PARALOOKS 100864 . 103628) (\TEDIT.FOREIGN.COPY?
- 103630 . 107357) (\TEDIT.QUIT 107359 . 110505) (\TEDIT.WORDDELETE 110507 . 115340) (\TEDIT1 115342 . 
-118038)) (118154 118270 (\CREATE.TEDIT.RESTART.MENU 118164 . 118268)) (118369 122058 (PLCHAIN 118379
- . 118653) (PRINTLINE 118655 . 121419) (SEEFILE 121421 . 122056)) (122099 141742 (TEDIT.INSERT.OBJECT 
-122109 . 131186) (TEDIT.EDIT.OBJECT 131188 . 133444) (TEDIT.FIND.OBJECT 133446 . 134339) (
-TEDIT.FIND.OBJECT.SUBTREE 134341 . 135147) (TEDIT.PUT.OBJECT 135149 . 136808) (TEDIT.GET.OBJECT 136810
- . 140009) (TEDIT.OBJECT.CHANGED 140011 . 141740)) (142020 142383 (MAKETEDITFORM 142030 . 142381)))))
+  (FILEMAP (NIL (4349 118548 (\TEDIT2 4359 . 7110) (COERCETEXTOBJ 7112 . 15888) (TEDIT 15890 . 21072) (
+TEDITSTRING 21074 . 21633) (TEDIT-SEE 21635 . 24224) (TEDIT.CHARWIDTH 24226 . 26250) (TEDIT.COPY 26252
+ . 34688) (TEDIT.DELETE 34690 . 35380) (TEDIT.DO.BLUEPENDINGDELETE 35382 . 38449) (TEDIT.INSERT 38451
+ . 43981) (TEDIT.KILL 43983 . 45540) (TEDIT.MAPLINES 45542 . 46941) (TEDIT.MAPPIECES 46943 . 47899) (
+TEDIT.MOVE 47901 . 57685) (TEDIT.QUIT 57687 . 59687) (TEDIT.STRINGWIDTH 59689 . 60360) (TEDIT.\INSERT 
+60362 . 62387) (TEXTOBJ 62389 . 63514) (TEXTSTREAM 63516 . 65131) (\TEDIT.INCLUDE 65133 . 69033) (
+\TEDIT.INSERT.PIECES 69035 . 78950) (\TEDIT.MOVE.PIECEMAPFN 78952 . 81031) (\TEDIT.OBJECT.SHOWSEL 
+81033 . 84662) (\TEDIT.RESTARTFN 84664 . 86659) (\TEDIT.CHARDELETE 86661 . 90623) (
+\TEDIT.COPY.PIECEMAPFN 90625 . 93850) (\TEDIT.DELETE 93852 . 101370) (\TEDIT.DIFFUSE.PARALOOKS 101372
+ . 104136) (\TEDIT.FOREIGN.COPY? 104138 . 107865) (\TEDIT.QUIT 107867 . 111013) (\TEDIT.WORDDELETE 
+111015 . 115848) (\TEDIT1 115850 . 118546)) (118662 118778 (\CREATE.TEDIT.RESTART.MENU 118672 . 118776
+)) (118877 122566 (PLCHAIN 118887 . 119161) (PRINTLINE 119163 . 121927) (SEEFILE 121929 . 122564)) (
+122607 142250 (TEDIT.INSERT.OBJECT 122617 . 131694) (TEDIT.EDIT.OBJECT 131696 . 133952) (
+TEDIT.FIND.OBJECT 133954 . 134847) (TEDIT.FIND.OBJECT.SUBTREE 134849 . 135655) (TEDIT.PUT.OBJECT 
+135657 . 137316) (TEDIT.GET.OBJECT 137318 . 140517) (TEDIT.OBJECT.CHANGED 140519 . 142248)) (142528 
+142891 (MAKETEDITFORM 142538 . 142889)))))
 STOP

library/TEXTOFD

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "22-Dec-2021 10:29:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;12
 182752 
+
(FILECREATED " 4-Jun-2022 15:43:05" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEXTOFD.;19
 183223 
 
-      :CHANGES-TO (FNS \TEXTBIN \TEXTPEEKBIN)
+      :CHANGES-TO (FNS OPENTEXTSTREAM)
 
-      :PREVIOUS-DATE "22-Dec-2021 10:01:53" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;11)
+      :PREVIOUS-DATE " 5-May-2022 15:12:26" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEXTOFD.;18)
 
 
 (* ; "
@@ -107,20 +108,23 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
           (RETURN NEWSTREAM])
 
 (OPENTEXTSTREAM

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

+  [LAMBDA (TEXT WINDOW START END PROPS)
                      (* ; "Edited  4-Jun-2022 15:42 by rmk")


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


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

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

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

     (PROG* ([WAS-TEXTSTREAM (AND (type?
 STREAM TEXT)
                                  (type?
 TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT]
             [TEXTOBJ (COND
                         (WAS-TEXTSTREAM                      (* ; 
-
                               "If the guy gave us a text stream to edit, use its TEXTOBJ as ours.")

-                               (create
 TEXTOBJ
-                                  reusing
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT)
-                                        \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 \INSERTPCVALID _ NIL))
+
                                 "If the guy gave us a text stream to edit, use its TEXTOBJ as ours.")

+                               (create
 TEXTOBJ reusing
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT)
+                                                     \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 
+                                                     \INSERTPCVALID _ NIL))
                         ((type?
 TEXTOBJ TEXT)
                          (create
 TEXTOBJ using
 TEXT \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 
-                                                   \INSERTPCVALID _ NIL))
+                                               \INSERTPCVALID _ NIL))
                         (T (create
 TEXTOBJ]
             (TEDIT.GET.FINISHEDFORMS NIL)
             [PROPS (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)
@@ -129,18 +133,18 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                        (EQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ]
             FONT SEL PCTB PC TEXTSTREAM OTEXTOBJ PROP CLEARGET? PARALOOKS PWINDOW)
                                                              (* ; 
-
                                                    "Remember if the textobj had a window already.")

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

            (replace
 (TEXTOBJ \WINDOW) of
 TEXTOBJ with
 (AND WINDOW (LIST WINDOW)))
                                                              (* ; 
-
              "Necessary because some incoming object types depend on knowing where the window is.")

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

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

 
-           (for
 PROPNAME in
 PROPS by
 (CDDR PROPNAME) as
 PROPVAL
-              in
 (CDR PROPS) by
 (CDDR PROPVAL) do
 (TEXTPROP
 TEXTOBJ PROPNAME PROPVAL)
-                  )                                          (* ; 
-
                                          "Save the PROPS for later people who'd like to know them")

+           (for
 PROPNAME in
 PROPS by
 (CDDR PROPNAME) as
 PROPVAL in
 (CDR PROPS)
+              by
 (CDDR PROPVAL) do
 (TEXTPROP
 TEXTOBJ PROPNAME PROPVAL))
+                                                             (* ; 
+
                                            "Save the PROPS for later people who'd like to know them")

            [SETQ FONT (COND
                          ((type?
 CHARLOOKS (LISTGET PROPS 'FONT))
                           (LISTGET PROPS 'FONT))
@@ -152,38 +156,36 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                                                 (T (OR (LISTGET PROPS 'FONT)
                                                                        DEFAULTFONT]
                                    NIL TEXTOBJ]              (* ; 
-
"Find the default font for this session -- either what the guy tells us, or the global default font")

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

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

 
-           (replace
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ
-              with
 (\TEDIT.UNIQUIFY.PARALOOKS [SETQ PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
-                                                                   (OR PARALOOKS
-                                                                       (create
 FMTSPEC
-                                                                          using
 
+           (replace
 (TEXTOBJ FMTSPEC) of
 TEXTOBJ with
 (\TEDIT.UNIQUIFY.PARALOOKS
+                                                       [SETQ PARALOOKS
+                                                        (\TEDIT.PARSE.PARALOOKS.LIST
+                                                         (OR PARALOOKS (create
 FMTSPEC using
 
                                                                                 TEDIT.DEFAULT.FMTSPEC
                                                                               ]
-                              TEXTOBJ))
+                                                       TEXTOBJ))
            [COND
               [WAS-TEXTSTREAM                                (* ; 
-
                                                    "We got a TEXTOFD stream to edit;  just use it")

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

                      (SETQ OTEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXT))
                      (SETQ TEXTSTREAM TEXT)
                      (for
 SELN in
 (LIST (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                                                (fetch
 (TEXTOBJ SCRATCHSEL) of
 TEXTOBJ)
-                                                (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ)
-                                                (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ)
-                                                (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
+                                        (fetch
 (TEXTOBJ SCRATCHSEL) of
 TEXTOBJ)
+                                        (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ)
+                                        (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ)
+                                        (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
                         do
 
+                           (* ;; "Make all the selections point to the CURRENT textobj!")

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

-
-                              (COND
-                                 ((EQ OTEXTOBJ (fetch
 (SELECTION \TEXTOBJ) of
 SELN))
-                                  (replace
 (SELECTION \TEXTOBJ) of
 SELN with
 TEXTOBJ))
-                                 (T (replace
 (SELECTION SET) of
 SELN with
 NIL)))
-                              (replace
 (SELECTION ONFLG) of
 SELN with
 NIL))
+                           (COND
+                              ((EQ OTEXTOBJ (fetch
 (SELECTION \TEXTOBJ) of
 SELN))
+                               (replace
 (SELECTION \TEXTOBJ) of
 SELN with
 TEXTOBJ))
+                              (T (replace
 (SELECTION SET) of
 SELN with
 NIL)))
+                           (replace
 (SELECTION ONFLG) of
 SELN with
 NIL))
                      (replace
 (TEXTSTREAM TEXTOBJ) of
 TEXTSTREAM with
 TEXTOBJ)
                      (replace
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ with
 TEXTSTREAM)
                      (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
@@ -193,106 +195,107 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                                              (* ; "And mark it not changed.")

                      (COND
                         (FONT                                (* ; 
-
                                                  "If a new default font was specified, set it up.")

-                              (replace
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ
-                                 with
 (\TEDIT.UNIQUIFY.CHARLOOKS FONT TEXTOBJ]
-              ((type?
 TEXTOBJ TEXT)                      (* ; 
-
                     "We got a TEXTOBJ to edit; fill in the stream, since it might have been GC'd.")

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

+                              (replace
 (TEXTOBJ DEFAULTCHARLOOKS) of
 TEXTOBJ with
 (
+                                                                            \TEDIT.UNIQUIFY.CHARLOOKS
+                                                                                   FONT TEXTOBJ]
+              ((type?
 TEXTOBJ TEXT)                          (* ; 
+
                       "We got a TEXTOBJ to edit; fill in the stream, since it might have been GC'd.")

                (SETQ TEXTSTREAM (replace
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ
                                    with
 (create
 TEXTSTREAM
-                                                   TEXTOBJ _ TEXTOBJ)))
+                                               TEXTOBJ _ TEXTOBJ)))
                (SETQ PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
                (for
 FORM in
 TEDIT.GET.FINISHEDFORMS do
 (EVAL FORM)))
               (T                                             (* ; 
-
                                 "Otherwise, create a TEXTOFD to describe the text we're editing.-")

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

+                 (CL:WHEN (AND TEXT (OR (LITATOM TEXT)
+                                        (STRINGP TEXT)
+                                        (CL:PATHNAMEP TEXT)))(* ; "rmk: Strings are now file names")

+                     [SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '((TYPE TEXT])
                  (SETQ TEXTSTREAM (replace
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ
                                      with
 (create
 TEXTSTREAM
-                                                     TEXTOBJ _ TEXTOBJ)))
-                 [replace
 (TEXTOBJ PCTB) of
 TEXTOBJ
-                    with
 (SETQ PCTB (TEDIT.BUILD.PCTB TEXT TEXTOBJ START END FONT PARALOOKS
-                                               (LISTGET PROPS 'CLEARGET]
+                                                 TEXTOBJ _ TEXTOBJ)))
+                 [replace
 (TEXTOBJ PCTB) of
 TEXTOBJ with
 (SETQ PCTB
+                                                          (TEDIT.BUILD.PCTB TEXT TEXTOBJ START END 
+                                                                 FONT PARALOOKS (LISTGET PROPS
+                                                                                       'CLEARGET]
 
                  (* ;; "(setq pc (\\editelt pctb (add1 |\\FirstPieceOffset|)))")

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

-                                                                 TEDITCARET
-                                                                 TCCARETDS _
-                                                                 (AND WINDOW (WINDOWPROP WINDOW
-                                                                                    'DSP))
-                                                                 TCFORCEUP _ T))
+                                                                               FONT TEXTOBJ)))
+                                                          TEXTOBJ))
+           (replace
 (TEXTOBJ CARET) of
 TEXTOBJ with
 (create
 TEDITCARET
+                                                           TCCARETDS _ (AND WINDOW
+                                                                            (WINDOWPROP WINDOW
+                                                                                   'DSP))
+                                                           TCFORCEUP _ T))
            (replace
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ with
 (LISTGET PROPS 'READONLY))
-           (replace
 (TEXTOBJ TXTTERMSA) of
 TEXTOBJ with
 (AND (SETQ PROP
-                                                                          (LISTGET PROPS 'TERMTABLE))
-                                                                         (fetch
 TERMSA
-                                                                            of
 PROP)))
+           (replace
 (TEXTOBJ TXTTERMSA) of
 TEXTOBJ with
 (AND (SETQ PROP (LISTGET PROPS 'TERMTABLE))
+                                                             (fetch
 TERMSA of
 PROP)))
            (replace
 (TEXTOBJ TXTRTBL) of
 TEXTOBJ with
 (LISTGET PROPS 'READTABLE))
            (replace
 (TEXTOBJ TXTWTBL) of
 TEXTOBJ with
 (LISTGET PROPS 'BOUNDTABLE))
            [COND
               ((LISTGET PROPS 'PAGEFORMAT)                   (* ; 
-
                              "A default page formatting was supplied.  Impose it on the document.")

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

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

            (COND
               ((EQ PROP 'DON'T)                              (* ; 
-
                                        "A SEL prop of DON'T means don't make an initial selection")

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

                (replace
 (SELECTION SET) of
 SEL with
 NIL))
-              ((type?
 SELECTION PROP)                    (* ; 
-
                                             "We came in with an explicit initial sel.  Set it up.")

+              ((type?
 SELECTION PROP)                        (* ; 
+
                                               "We came in with an explicit initial sel.  Set it up.")

                (\COPYSEL PROP SEL)
                (replace
 (SELECTION SET) of
 SEL with
 T)
                (replace
 (SELECTION \TEXTOBJ) of
 SEL with
 TEXTOBJ))
               ((AND (fetch
 (SELECTION SET) of
 SEL)
                     (NOT PROP))                              (* ; 
-
                                       "If we came into this with a valid selection, highlight it.")

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

                (replace
 (SELECTION \TEXTOBJ) of
 SEL with
 TEXTOBJ))
               (T                                             (* ; 
-
    "Starting without a selection;  let's start with a point selection before the first character.")

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

                  (replace
 (SELECTION CH#) of
 SEL with
 (COND
-                                                                     ((FIXP PROP))
-                                                                     (PROP (CAR PROP))
-                                                                     (1)))
+                                                         ((FIXP PROP))
+                                                         (PROP (CAR PROP))
+                                                         (1)))
                  (replace
 (SELECTION CHLIM) of
 SEL with
 (COND
-                                                                       ((FIXP PROP))
-                                                                       (PROP (IPLUS (CAR PROP)
-                                                                                    (CADR PROP)))
-                                                                       (1)))
+                                                           ((FIXP PROP))
+                                                           (PROP (IPLUS (CAR PROP)
+                                                                        (CADR PROP)))
+                                                           (1)))
                  (replace
 (SELECTION DCH) of
 SEL with
 (COND
-                                                                     ((FIXP PROP)
-                                                                      0)
-                                                                     (PROP (CADR PROP))
-                                                                     (0)))
+                                                         ((FIXP PROP)
+                                                          0)
+                                                         (PROP (CADR PROP))
+                                                         (0)))
                  (replace
 (SELECTION DX) of
 SEL with
 0)
                  (replace
 (SELECTION POINT) of
 SEL with
 'LEFT)
                  (replace
 (SELECTION SELKIND) of
 SEL with
 'CHAR)
-                 (replace
 (SELECTION SET) of
 SEL with
 (NOT (fetch
 (TEXTOBJ 
-                                                                                         TXTREADONLY)
-                                                                          of
 TEXTOBJ)))
+                 (replace
 (SELECTION SET) of
 SEL with
 (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
                  (replace
 (SELECTION \TEXTOBJ) of
 SEL with
 TEXTOBJ)))
            [COND
-              ((fetch
 (SELECTION SET) of
 SEL)        (* ; 
-
                            "If there's an initial selection, it implies initial caret looks, too.")

-               (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ with
 (\TEDIT.GET.INSERT.CHARLOOKS
-                                                                          TEXTOBJ SEL]
+              ((fetch
 (SELECTION SET) of
 SEL)                (* ; 
+
                              "If there's an initial selection, it implies initial caret looks, too.")

+               (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ with
 (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL
+                                                                    ]
            (COND
               ((AND WINDOW (NOT TEXTOBJ.WINDOW.VALID))       (* ; 
-
                                                       "Only if there's a window to display it in:")

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

                (replace
 (TEXTOBJ \WINDOW) of
 TEXTOBJ with
 NIL)
                (\TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS)
                                                              (* ; 
-
                                                 "Set up the window, and display the initial text.")

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

                )
               ((SETQ PWINDOW (LISTGET PROPS 'PROMPTWINDOW))
 
@@ -300,10 +303,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
 
                (replace
 (TEXTOBJ PROMPTWINDOW) of
 TEXTOBJ with
 PWINDOW)))
            (\SETUPGETCH
 (create
 EDITMARK
-                                   PC _ (\GETBASEPTR (\FIRSTNODE PCTB)
-                                               0)
-                                   PCOFF _ 0
-                                   PCNO _ 1)
+                               PC _ (\GETBASEPTR (\FIRSTNODE PCTB)
+                                           0)
+                               PCOFF _ 0
+                               PCNO _ 1)
                   TEXTOBJ)                                   (* ; "Set the file ptr to 0")

            (RETURN TEXTSTREAM])
 
@@ -676,9 +679,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
           (RETURN PC])
 
 (\TEXTINIT

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

+  [LAMBDA NIL
                                                (* ; "Edited  5-May-2022 15:12 by rmk")


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

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

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

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

 
@@ -700,7 +704,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
 
     (* ;; "(FW8 WORD)")

 
-    (SETQ \TEXTIMAGEOPS (create
 IMAGEOPS
+    [SETQ \TEXTIMAGEOPS (create
 IMAGEOPS
                                IMAGETYPE _ 'TEXT
                                IMXPOSITION _ (FUNCTION \TEXTDSPXPOSITION)
                                IMYPOSITION _ (FUNCTION \TEXTDSPYPOSITION)
@@ -711,7 +715,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                IMFONTCREATE _ 'DISPLAY
                                IMLINEFEED _ (FUNCTION \TEXTDSPLINEFEED)
                                IMCHARWIDTH _ (FUNCTION \TEXTDSPCHARWIDTH)
-                               IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH)))
+                               IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH)
+                               IMSCALE _ (FUNCTION (LAMBDA NIL 1]
     (SETQ \TEXTFDEV (create
 FDEV
                            DEVICENAME _ 'TEXT
                            RESETABLE _ T
@@ -780,9 +785,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                        (LET ((STREAM (STREAM-ERROR-STREAM CONDITION)))
                             (COND
                                [(AND (BOUNDP 'ERRORPOS)
-                                     (TEXTSTREAMP
 STREAM))
-                                                             (* ; 
-
           "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")

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

                                 (LET ((XCL::RESULT (REOPENTEXTSTREAM
 STREAM)))
                                      (CL:WHEN XCL::RESULT
                                          (ENVAPPLY (STKNAME ERRORPOS)
@@ -791,7 +795,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                                 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

@@ -2721,25 +2725,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 (2992 53117 (COPYTEXTSTREAM 3002 . 6124) (OPENTEXTSTREAM 6126 . 21003) (REOPENTEXTSTREAM
- 21005 . 21427) (TEDIT.STREAMCHANGEDP 21429 . 21727) (TEXTSTREAMP 21729 . 22043) (TXTFILE 22045 . 
-22490) (\DELETECH 22492 . 33748) (\SETUPGETCH 33750 . 41029) (\TEDIT.REOPEN.STREAM 41031 . 42881) (
-\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42883 . 45321) (\TEXTINIT 45323 . 51010) (\TEXTMARK 51012 . 51760) (
-\TEXTTTYBOUT 51762 . 53115)) (53118 78550 (\INSERTCH 53128 . 76854) (\INSERTCR 76856 . 78548)) (78616 
-98932 (\CHTOPC 78626 . 79815) (\CHTOPCNO 79817 . 81079) (\CLEARPCTB 81081 . 81877) (
-\CREATEPIECEORSTREAM 81879 . 84853) (\DELETEPIECE 84855 . 85768) (\FINDPIECE 85770 . 86136) (
-\INSERTPIECE 86138 . 89148) (\MAKEPCTB 89150 . 91065) (\SPLITPIECE 91067 . 98026) (\INSERT.FIRST.PIECE
- 98028 . 98930)) (98984 123222 (\TEXTCLOSEF 98994 . 100221) (\TEXTCLOSEF-SUBTREE 100223 . 100929) (
-\TEXTDSPFONT 100931 . 101923) (\TEXTEOFP 101925 . 103284) (\TEXTGETEOFPTR 103286 . 103496) (
-\TEXTGETFILEPTR 103498 . 105561) (\TEXTOPENF 105563 . 106393) (\TEXTOPENF-SUBTREE 106395 . 107196) (
-\TEXTOUTCHARFN 107198 . 107546) (\TEXTBACKFILEPTR 107548 . 113449) (\TEXTBOUT 113451 . 116799) (
-\TEDITOUTCCODEFN 116801 . 118067) (\TEXTSETEOF 118069 . 118578) (\TEXTSETFILEPTR 118580 . 119805) (
-\TEXTDSPXPOSITION 119807 . 120664) (\TEXTDSPYPOSITION 120666 . 121211) (\TEXTLEFTMARGIN 121213 . 
-121696) (\TEXTRIGHTMARGIN 121698 . 122634) (\TEXTDSPCHARWIDTH 122636 . 122874) (\TEXTDSPSTRINGWIDTH 
-122876 . 123116) (\TEXTDSPLINEFEED 123118 . 123220)) (123223 161060 (\TEXTBIN 123233 . 144112) (
-\TEDIT.TEXTBIN.STRINGSETUP 144114 . 149827) (\TEDIT.TEXTBIN.FILESETUP 149829 . 156215) (
-\TEDIT.TEXTBIN.NEW.PAGE 156217 . 161058)) (161061 176823 (\TEXTPEEKBIN 161071 . 172564) (
-\TEDIT.PEEKBIN.NEW.PAGE 172566 . 176821)) (176861 182079 (CGETTEXTPROP 176871 . 177347) (CTEXTPROP 
-177349 . 179693) (GETTEXTPROP 179695 . 180290) (PUTTEXTPROP 180292 . 181617) (TEXTPROP 181619 . 182077
+  (FILEMAP (NIL (2996 53588 (COPYTEXTSTREAM 3006 . 6128) (OPENTEXTSTREAM 6130 . 21350) (REOPENTEXTSTREAM
+ 21352 . 21774) (TEDIT.STREAMCHANGEDP 21776 . 22074) (TEXTSTREAMP 22076 . 22390) (TXTFILE 22392 . 
+22837) (\DELETECH 22839 . 34095) (\SETUPGETCH 34097 . 41376) (\TEDIT.REOPEN.STREAM 41378 . 43228) (
+\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43230 . 45668) (\TEXTINIT 45670 . 51481) (\TEXTMARK 51483 . 52231) (
+\TEXTTTYBOUT 52233 . 53586)) (53589 79021 (\INSERTCH 53599 . 77325) (\INSERTCR 77327 . 79019)) (79087 
+99403 (\CHTOPC 79097 . 80286) (\CHTOPCNO 80288 . 81550) (\CLEARPCTB 81552 . 82348) (
+\CREATEPIECEORSTREAM 82350 . 85324) (\DELETEPIECE 85326 . 86239) (\FINDPIECE 86241 . 86607) (
+\INSERTPIECE 86609 . 89619) (\MAKEPCTB 89621 . 91536) (\SPLITPIECE 91538 . 98497) (\INSERT.FIRST.PIECE
+ 98499 . 99401)) (99455 123693 (\TEXTCLOSEF 99465 . 100692) (\TEXTCLOSEF-SUBTREE 100694 . 101400) (
+\TEXTDSPFONT 101402 . 102394) (\TEXTEOFP 102396 . 103755) (\TEXTGETEOFPTR 103757 . 103967) (
+\TEXTGETFILEPTR 103969 . 106032) (\TEXTOPENF 106034 . 106864) (\TEXTOPENF-SUBTREE 106866 . 107667) (
+\TEXTOUTCHARFN 107669 . 108017) (\TEXTBACKFILEPTR 108019 . 113920) (\TEXTBOUT 113922 . 117270) (
+\TEDITOUTCCODEFN 117272 . 118538) (\TEXTSETEOF 118540 . 119049) (\TEXTSETFILEPTR 119051 . 120276) (
+\TEXTDSPXPOSITION 120278 . 121135) (\TEXTDSPYPOSITION 121137 . 121682) (\TEXTLEFTMARGIN 121684 . 
+122167) (\TEXTRIGHTMARGIN 122169 . 123105) (\TEXTDSPCHARWIDTH 123107 . 123345) (\TEXTDSPSTRINGWIDTH 
+123347 . 123587) (\TEXTDSPLINEFEED 123589 . 123691)) (123694 161531 (\TEXTBIN 123704 . 144583) (
+\TEDIT.TEXTBIN.STRINGSETUP 144585 . 150298) (\TEDIT.TEXTBIN.FILESETUP 150300 . 156686) (
+\TEDIT.TEXTBIN.NEW.PAGE 156688 . 161529)) (161532 177294 (\TEXTPEEKBIN 161542 . 173035) (
+\TEDIT.PEEKBIN.NEW.PAGE 173037 . 177292)) (177332 182550 (CGETTEXTPROP 177342 . 177818) (CTEXTPROP 
+177820 . 180164) (GETTEXTPROP 180166 . 180761) (PUTTEXTPROP 180763 . 182088) (TEXTPROP 182090 . 182548
 )))))
 STOP

library/WHERE-IS

@@ -1,13 +1,13 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
-
(IL:FILECREATED "13-Jun-90 01:24:39" IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;2|
 17489  
+(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
 
-      IL:|changes| IL:|to:|  (IL:VARS IL:WHERE-ISCOMS)
+
(IL:FILECREATED "11-Mar-2022 22:40:32" 
+IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;2|
 17501  
 
-      IL:|previous| IL:|date:| " 6-Jun-88 18:42:35" 
-IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
+      :PREVIOUS-DATE "13-Jun-90 01:24:39" 
+IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;1|)
 
 
-; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation.
 
 (IL:PRETTYCOMPRINT IL:WHERE-ISCOMS)
 
@@ -17,7 +17,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                  (REQUIRE "CASH-FILE" "CASH-FILE.DFASL"))
            (IL:COMS 
 
-                  (IL:* IL:|;;| "run time code")

+                  (IL:* IL:|;;| "run time code")

 
                   (IL:FUNCTIONS HASH-FILE-WHERE-IS HASH-FILE-TYPES-OF GET-WHERE-IS-ENTRIES 
                          WHERE-IS-READ-FN ADD-WHERE-IS-DATABASES ADD-WHERE-IS-DATABASE 
@@ -26,7 +26,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                   (IL:VARIABLES *WHERE-IS-CASH-FILES* *WHERE-IS-CASH-SIZE*))
            (IL:COMS 
 
-                  (IL:* IL:|;;| "notice time code")

+                  (IL:* IL:|;;| "notice time code")

 
                   (IL:FUNCTIONS WHERE-IS-NOTICE WHERE-IS-NOTICE-INTERNAL WHERE-IS-FILES 
                          WHERE-IS-DEFAULT-DEFINE-TYPES WHERE-IS-NAMESTRING WHERE-IS-READ-COMS 
@@ -48,16 +48,16 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 (DEFUN HASH-FILE-WHERE-IS
 (NAME TYPE)
 
-   (IL:* IL:|;;| "return a list of file names containing NAME of TYPE ")

+   (IL:* IL:|;;| "return a list of file names containing NAME of TYPE ")

 
    (REMOVE-DUPLICATES (MAPCAN #'(LAMBDA (ENTRY)
                                        (CDR (ASSOC TYPE ENTRY)))
-                             (GET-WHERE-IS-ENTRIES NAME))
+                             (GET-WHERE-IS-ENTRIES
 NAME))
           :TEST
           'STRING=))
 
-(DEFUN HASH-FILE-TYPES-OF
 (NAME &OPTIONAL (POSSIBLE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES)))
-   (LET ((ENTRIES (GET-WHERE-IS-ENTRIES NAME))
+(DEFUN HASH-FILE-TYPES-OF
 (NAME &OPTIONAL (POSSIBLE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES
)))
+   (LET ((ENTRIES (GET-WHERE-IS-ENTRIES
 NAME))
          (TYPES NIL))
         (DOLIST (TYPE POSSIBLE-TYPES)
             (DOLIST (ENTRY ENTRIES)
@@ -68,7 +68,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 (DEFUN GET-WHERE-IS-ENTRIES
 (NAME)
 
-   (IL:* IL:|;;| "return a list of all entries for name in *WHERE-IS-CASH-FILES*")

+   (IL:* IL:|;;| "return a list of all entries for name in *WHERE-IS-CASH-FILES*")

 
    (MAPLIST #'(LAMBDA (TAIL)
                      (LET ((DATABASE (CAR TAIL)))
@@ -81,8 +81,8 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                                                           (HASH-FILE (CASH-FILE:CASH-FILE-HASH-FILE
                                                                       CASH-FILE)))
 
-                                                         (IL:* IL:|;;| 
-
                                                       "install our read function in hash file")

+                                                         (IL:* IL:|;;| 
+
                                                         "install our read function in hash file")

 
                                                          (SETF (HASH-FILE::HASH-FILE-KEY-READ-FN
                                                                 HASH-FILE)
@@ -91,29 +91,29 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                                                                 HASH-FILE)
                                                                #'WHERE-IS-READ-FN)
 
-                                                         (IL:* IL:|;;| 
-
                                                       "smash CASH-FILE into *WHERE-IS-CASH-FILES*")

+                                                         (IL:* IL:|;;| 
+
                                                         "smash CASH-FILE into *WHERE-IS-CASH-FILES*")

 
                                                          (SETF (CAR TAIL)
                                                                CASH-FILE))))
                                  (NIL NIL :REPORT "Delete from the databases known to WHERE-IS?"
-                                      (DEL-WHERE-IS-DATABASE DATABASE)
+                                      (DEL-WHERE-IS-DATABASE
 DATABASE)
                                       NIL))))
           *WHERE-IS-CASH-FILES*))
 
 (DEFUN WHERE-IS-READ-FN
 (STREAM)
 
-(IL:* IL:|;;;| "the :KEY-READ-FN & :VALUE-READ-FN for WHERE-IS hash files.")

+(IL:* IL:|;;;| "the :KEY-READ-FN & :VALUE-READ-FN for WHERE-IS hash files.")

 
    (HANDLER-CASE 
 
-          (IL:* IL:|;;| "use the default read function")

+          (IL:* IL:|;;| "use the default read function")

 
           (HASH-FILE::DEFAULT-READ-FN STREAM)
 
-          (IL:* IL:|;;| "Quietly handle MISSING-PACKAGE errors by returning the condition.")

+          (IL:* IL:|;;| "Quietly handle MISSING-PACKAGE errors by returning the condition.")

 
-          (IL:* IL:|;;| "This allows us to have files in our database which we havn't loaded.")

+          (IL:* IL:|;;| "This allows us to have files in our database which we havn't loaded.")

 
           (MISSING-PACKAGE (CONDITION)
                  CONDITION)))
@@ -126,18 +126,18 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
    "add PATHNAME to the databases known to WHERE-IS"
    (LET ((NEW-PATHNAME (PATHNAME PATHNAME)))
 
-        (IL:* IL:|;;| "first delete & close the old one (if any)")

+        (IL:* IL:|;;| "first delete & close the old one (if any)")

 
-        (DEL-WHERE-IS-DATABASE NEW-PATHNAME)
+        (DEL-WHERE-IS-DATABASE
 NEW-PATHNAME)
 
-        (IL:* IL:|;;| "now add the new one")

+        (IL:* IL:|;;| "now add the new one")

 
         (PUSH NEW-PATHNAME *WHERE-IS-CASH-FILES*)
         NEW-PATHNAME))
 
 (DEFUN DEL-WHERE-IS-DATABASE
 (DATABASE)
    (LET ((FOUND (FIND-IF #'(LAMBDA (ELEMENT)
-                                  (SAME-WHERE-IS-DATABASE DATABASE ELEMENT))
+                                  (SAME-WHERE-IS-DATABASE
 DATABASE ELEMENT))
                        *WHERE-IS-CASH-FILES*)))
         (WHEN FOUND
             (SETQ *WHERE-IS-CASH-FILES* (DELETE FOUND *WHERE-IS-CASH-FILES* :TEST 'EQ))
@@ -154,7 +154,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
          (LET ((PATHNAME-X (COERCE-TO-PATHAME X))
                (PATHNAME-Y (COERCE-TO-PATHAME Y)))
 
-              (IL:* IL:|;;| "do a case & version insensitive comparison")

+              (IL:* IL:|;;| "do a case & version insensitive comparison")

 
               (AND (EQUALP (PATHNAME-HOST PATHNAME-X)
                           (PATHNAME-HOST PATHNAME-Y))
@@ -174,8 +174,8 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                                        (LET ((CASH-FILE:CASH-FILE (FIRST TAIL)))
                                             (IF (CASH-FILE:CASH-FILE-P CASH-FILE:CASH-FILE)
 
-                                                (IL:* IL:|;;| 
-
                                              "make sure we'll get latest version on re-boot")

+                                                (IL:* IL:|;;| 
+
                                                "make sure we'll get latest version on re-boot")

 
                                                 (SETF (FIRST TAIL)
                                                       (MAKE-PATHNAME :VERSION :NEWEST :DEFAULTS
@@ -200,11 +200,11 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 
 (DEFUN WHERE-IS-NOTICE
 (DATABASE-FILE &KEY (FILES "*.;")
-                                  (NEW NIL)
-                                  (DEFINE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES))
-                                  (HASH-FILE-SIZE *WHERE-IS-HASH-FILE-SIZE*)
-                                  (QUIET NIL)
-                                  (TEMP-FILE NIL))
+                              (NEW NIL)
+                              (DEFINE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES
))
+                              (HASH-FILE-SIZE *WHERE-IS-HASH-FILE-SIZE*)
+                              (QUIET NIL)
+                              (TEMP-FILE NIL))
    (LET* ((FILE (IF TEMP-FILE
                     (IF NEW
                         TEMP-FILE
@@ -215,22 +215,22 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                                    (HASH-FILE:OPEN-HASH-FILE FILE :DIRECTION :IO)))
           (HASH-FILE::*DELETE-OLD-VERSION-ON-REHASH* T))
          (UNWIND-PROTECT
-             (DOLIST (PATHNAME (WHERE-IS-FILES FILES))
+             (DOLIST (PATHNAME (WHERE-IS-FILES
 FILES))
                  (UNLESS QUIET
                      (FORMAT T ";;; ~A ." (NAMESTRING PATHNAME)))
-                 (LET ((NAMESTRING (WHERE-IS-NAMESTRING PATHNAME)))
+                 (LET ((NAMESTRING (WHERE-IS-NAMESTRING
 PATHNAME)))
                       (IF (AND (NOT NEW)
-                               (LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE NAMESTRING 
+                               (LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE
 NAMESTRING 
                                                             HASH-FILE:HASH-FILE)))
                                     (AND OLD-WRITE-DATE (= (FILE-WRITE-DATE PATHNAME)
                                                            OLD-WRITE-DATE))))
                           (UNLESS QUIET (FORMAT T " up to date.~%"))
                           (MULTIPLE-VALUE-BIND
                            (FILE-VARS VALUES)
-                           (WHERE-IS-READ-COMS PATHNAME)
+                           (WHERE-IS-READ-COMS
 PATHNAME)
                            (WHEN FILE-VARS
 
-                               (IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")

+                               (IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")

 
                                (PROGV FILE-VARS VALUES
                                    (UNLESS QUIET (PRINC "."))
@@ -238,12 +238,12 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                                        (LET ((NAMES (IL:INFILECOMS? NIL TYPE (FIRST FILE-VARS))))
                                             (WHEN (CONSP NAMES)
 
-                                                (IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")

+                                                (IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")

 
                                                 (DOLIST (NAME NAMES)
-                                                    (WHERE-IS-NOTICE-INTERNAL NAME TYPE NAMESTRING 
+                                                    (WHERE-IS-NOTICE-INTERNAL
 NAME TYPE NAMESTRING 
                                                            HASH-FILE:HASH-FILE))))))
-                               (WHERE-IS-SET-WRITE-DATE NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
+                               (WHERE-IS-SET-WRITE-DATE
 NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
                                (UNLESS QUIET
                                    (PRINC ". done.")
                                    (TERPRI)))))))
@@ -261,16 +261,16 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 (DEFUN WHERE-IS-NOTICE-INTERNAL
 (NAME TYPE FILE-NAME HASH-FILE:HASH-FILE)
 
-   (IL:* IL:|;;| "note that NAME is defined as TYPE on FILE-NAME in HASH-FILE ")

+   (IL:* IL:|;;| "note that NAME is defined as TYPE on FILE-NAME in HASH-FILE ")

 
-   (IL:* IL:|;;| "we keep an ALIST for each name, indexed by type")

+   (IL:* IL:|;;| "we keep an ALIST for each name, indexed by type")

 
    (LET* ((ALIST (HASH-FILE:GET-HASH-FILE NAME HASH-FILE:HASH-FILE))
           (OLD-ENTRY (ASSOC TYPE ALIST :TEST 'EQUAL))
           (OLD-FILES (CDR OLD-ENTRY)))
          (UNLESS (MEMBER FILE-NAME OLD-FILES)
 
-             (IL:* IL:|;;| "this optimization helps a lot when re-noticing a file ")

+             (IL:* IL:|;;| "this optimization helps a lot when re-noticing a file ")

 
              (SETF (HASH-FILE:GET-HASH-FILE NAME HASH-FILE:HASH-FILE)
                    (CONS (CONS TYPE (CONS FILE-NAME OLD-FILES))
@@ -278,9 +278,9 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 (DEFUN WHERE-IS-FILES
 (FILES)
 
-   (IL:* IL:|;;| "expand the FILES argument to WHERE-IS-NOTICE")

+   (IL:* IL:|;;| "expand the FILES argument to WHERE-IS-NOTICE")

 
-   (IL:* IL:|;;| "allow: non-LIST, file names & file patterns")

+   (IL:* IL:|;;| "allow: non-LIST, file names & file patterns")

 
    (MAPCAN #'(LAMBDA (PATTERN)
                     (LET ((PATHNAME (PROBE-FILE PATTERN)))
@@ -289,7 +289,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
                              (CASE IL:MAKESYSNAME
                                  (:LYRIC 
 
-                                    (IL:* IL:|;;| "CL:DIRECTORY is broken in Lyric")

+                                    (IL:* IL:|;;| "CL:DIRECTORY is broken in Lyric")

 
                                     (IL:DIRECTORY PATTERN))
                                  (OTHERWISE (DIRECTORY PATTERN))))))
@@ -300,7 +300,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 (DEFUN WHERE-IS-DEFAULT-DEFINE-TYPES
 ()
    (MAPCAN #'(LAMBDA (TYPE)
 
-                    (IL:* IL:|;;| "ignore aliases and types on *WHERE-IS-IGNORE-DEFINE-TYPES*")

+                    (IL:* IL:|;;| "ignore aliases and types on *WHERE-IS-IGNORE-DEFINE-TYPES*")

 
                     (UNLESS (OR (CONSP TYPE)
                                 (MEMBER TYPE *WHERE-IS-IGNORE-DEFINE-TYPES*))
@@ -309,7 +309,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 (DEFUN WHERE-IS-NAMESTRING
 (PATHNAME)
 
-   (IL:* IL:|;;| "return a namestring for PATHNAME containing only the NAME & TYPE fields ")

+   (IL:* IL:|;;| "return a namestring for PATHNAME containing only the NAME & TYPE fields ")

 
    (NAMESTRING (MAKE-PATHNAME :HOST NIL :NAME (PATHNAME-NAME PATHNAME)
                       :TYPE
@@ -320,11 +320,11 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 
 (DEFUN WHERE-IS-READ-COMS
 (PATHNAME)
 
-(IL:* IL:|;;;| "returns as first value a list of the filevars on PATHNAME, as second value a list of the values for these filevars.")

+(IL:* IL:|;;;| "returns as first value a list of the filevars on PATHNAME, as second value a list of the values for these filevars.")

 
    (IL:RESETLST
 
-       (IL:* IL:|;;| "make sure all IL:LOADVARS get undone")

+       (IL:* IL:|;;| "make sure all IL:LOADVARS get undone")

 
        (IL:RESETSAVE (IL:RESETUNDO))
        (DO ((IL:LOAD-VERBOSE-STREAM 'NIL)
@@ -354,20 +354,20 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
          (DOLIST (FILE-VAR QUEUE)
              (IF (MEMBER FILE-VAR ALL-FILE-VARS :TEST 'EQ)
 
-                 (IL:* IL:|;;| "don't want to load any twice")

+                 (IL:* IL:|;;| "don't want to load any twice")

 
                  (SETF QUEUE (DELETE FILE-VAR QUEUE :TEST 'EQ)))))))
 
 (DEFUN WHERE-IS-SET-WRITE-DATE
 (NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
 
-   (IL:* IL:|;;| "store the write date as a bogus entry on the file")

+   (IL:* IL:|;;| "store the write date as a bogus entry on the file")

 
-   (WHERE-IS-NOTICE-INTERNAL NAMESTRING 'SI::WRITE-DATE (FILE-WRITE-DATE PATHNAME)
+   (WHERE-IS-NOTICE-INTERNAL
 NAMESTRING 'SI::WRITE-DATE (FILE-WRITE-DATE PATHNAME)
           HASH-FILE:HASH-FILE))
 
 (DEFUN WHERE-IS-GET-WRITE-DATE
 (NAMESTRING HASH-FILE:HASH-FILE)
 
-   (IL:* IL:|;;| "retrieve write date stored for NAMESTRING in HASH-FILE:HASH-FILE")

+   (IL:* IL:|;;| "retrieve write date stored for NAMESTRING in HASH-FILE:HASH-FILE")

 
    (CADR (ASSOC 'SI::WRITE-DATE (HASH-FILE:GET-HASH-FILE NAMESTRING HASH-FILE:HASH-FILE))))
 
@@ -381,5 +381,13 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
 (IL:PUTPROPS IL:WHERE-IS
 IL:FILETYPE
 :COMPILE-FILE)
 (IL:PUTPROPS IL:WHERE-IS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL)))
+  (IL:FILEMAP (NIL (1758 2090 (HASH-FILE-WHERE-IS 1758 . 2090)) (2092 2485 (HASH-FILE-TYPES-OF 2092 . 
+2485)) (2487 4652 (GET-WHERE-IS-ENTRIES 2487 . 4652)) (4654 5169 (WHERE-IS-READ-FN 4654 . 5169)) (5171
+ 5327 (ADD-WHERE-IS-DATABASES 5171 . 5327)) (5329 5716 (ADD-WHERE-IS-DATABASE 5329 . 5716)) (5718 6197
+ (DEL-WHERE-IS-DATABASE 5718 . 6197)) (6199 7351 (SAME-WHERE-IS-DATABASE 6199 . 7351)) (7353 8560 (
+CLOSE-WHERE-IS-FILES 7353 . 8560)) (8818 12235 (WHERE-IS-NOTICE 8818 . 12235)) (12237 12981 (
+WHERE-IS-NOTICE-INTERNAL 12237 . 12981)) (12983 13719 (WHERE-IS-FILES 12983 . 13719)) (13721 14086 (
+WHERE-IS-DEFAULT-DEFINE-TYPES 13721 . 14086)) (14088 14507 (WHERE-IS-NAMESTRING 14088 . 14507)) (14509
+ 16521 (WHERE-IS-READ-COMS 14509 . 16521)) (16523 16794 (WHERE-IS-SET-WRITE-DATE 16523 . 16794)) (
+16796 17046 (WHERE-IS-GET-WRITE-DATE 16796 . 17046)))))
 IL:STOP

lispusers/ACE/ACE

@@ -1,33 +1,28 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "16-Nov-93 14:13:50" {DSK}<king>export>lispcore>lispusers>ACE.;3
 148254 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS ACE.BITMAP.MASK ACE-EDITCOMS ACELOGOMAP)
-                    (FNS ACE ACE.ANIMATE ACE.RUN ACEGETFRAME# ACERUNLOOP ACE.NEW.SEQUENCE 
-                         ACE.NEW.FRAME ACE.QUIT.ACE ACE.RESET.SEQ ACE.RUN.CURRENT.SEQ ACE.DELAY 
-                         ACE.DELAY.FRAME ACE.DELAY.SEQ ACE.DECREMENT.FRAME ACE.INCREMENT.FRAME 
-                         ACE.DELETE.FRAME ACE.SET.DEVICE ACE.QUICKDRAW&UPD ACE.RECONSTRUCT.FRAME 
-                         SUBLIST ACE.TRILLIUM ACE.TRILLIUM.LOOP ACE.RUN.TRILLIUM ACE.QUIT.TRILLIUM 
-                         ACE.CREATE.EDITING.BORDER ACE.GET.SEQ.FILE ACE.PUT.SEQ.FILE 
-                         ACE.GET.A.FILE.NAME ACE.ASKEM ACE.TELLEM ACE.CONFIRMIT ACE.DEFINE.SEQ.WINDOW
-                         ACE.FIGURE.OUT.WINDOW ACE.RETURN.CLOSEST.VERTEX ACE.NEW.SEQ.ASST 
-                         ACE.DELAY.FRAME.ASST ACE.SETUP.CW.CLIPPING.REGIONS ACE.CHECKSTUFF 
-                         ACE.UPD.CONTROL.WINDOW ACE.UPD.CW.MULE ACE.UPD.CLEAR.SET.LINE 
-                         ACE.CREATE.CONTROL.MENU ACE.SEQ.FETCH.WIDTH ACE.SEQ.FETCH.HEIGHT 
-                         ACE.SET.SEQ.CLIP.REGION ACE.ASKEM2 ACE.TELLEM2 ACE.UPD.CONTROL.WINDOW2 
-                         ACE.COMPILE.FRAME ACE.EXTRACT ACESETTHRESHOLD ACE.MAX.REGIONS 
-                         ACE.PICK.BEST.REGION ACE.COMPUTE.AREA ACE.SCAN.BITMAPS ACE.SCAN.PRIMBLOCKS 
-                         ACE.FETCH.BLOCK)
+
(FILECREATED "16-Mar-2022 08:06:56" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>ACE>ACE.;2
 146646 
 
-      previous date%: "16-Nov-93 13:52:56" {DSK}<king>export>lispcore>lispusers>ACE.;2)
+      :CHANGES-TO (VARS ACECOMS ACE-MAINCOMS ACE-PRIMCOMS ACE.PIXPERWORD ACE.BITMAP.MASK ACE-EDITCOMS
+                        )
+                  (RECORDS ACE.FRAME ACE.BLIT)
+                  (MACROS ACE.MT.SCRX.SEQX ACE.MT.SCRY.SEQY ACE.MT.SCRX.AWX ACE.MT.SCRY.AWY 
+                         ACE.MT.SEQ.SCR.REGION ACE.MT.SEQ.AW.REGION ACE.MT.AW.SCR.POINT 
+                         ACE.MT.AWX.SCRX ACE.MT.AWY.SCRY ACE.MT.AWX.SEQX ACE.MT.AWY.SEQY 
+                         ACE.MT.SEQX.SCRX ACE.MT.SEQY.SCRY ACE.MT.SEQX.AWX ACE.MT.SEQY.AWY 
+                         ACE.MAC.CW.INFO.CLIP ACE.MAC.CW.PROMPT.CLIP ACE.MAC.SEQ.CLIP 
+                         ACE.MAC.FETCH.WIDTH ACE.MAC.FETCH.HEIGHT)
+
+      :PREVIOUS-DATE "16-Nov-93 14:13:50" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>ACE>ACE.;1)
 
 
 (* ; "
-Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
+Copyright (c) 1988, 1993 by Michel Denber.
 ")
 
 (PRETTYCOMPRINT ACECOMS)
 
-(RPAQQ ACECOMS
 
+(RPAQQ ACECOMS

        (
         (* ;; "Animation Compiler and Environment")

 
@@ -65,63 +60,63 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS ACE.MT.SCRX.SEQX MACRO ((SCREENXCOOR)
+(PUTPROPS ACE.MT.SCRX.SEQX
 MACRO
 ((SCREENXCOOR)
                                   (IDIFFERENCE [IDIFFERENCE SCREENXCOOR (DSPXOFFSET
                                                                          NIL
                                                                          (WINDOWPROP ACE.SEQ.WINDOW
                                                                                 'DSP]
                                          ACE.SEQ.WINDOW.XOFF)))
 
-(PUTPROPS ACE.MT.SCRY.SEQY MACRO ((SCREENYCOOR)
+(PUTPROPS ACE.MT.SCRY.SEQY
 MACRO
 ((SCREENYCOOR)
                                   (IDIFFERENCE [IDIFFERENCE SCREENYCOOR (DSPYOFFSET
                                                                          NIL
                                                                          (WINDOWPROP ACE.SEQ.WINDOW
                                                                                 'DSP]
                                          ACE.SEQ.WINDOW.YOFF)))
 
-[PUTPROPS ACE.MT.SCRX.AWX MACRO ((SCREENXCOOR)
+(PUTPROPS ACE.MT.SCRX.AWX
 MACRO
 [(SCREENXCOOR)
                                  (IDIFFERENCE SCREENXCOOR (DSPXOFFSET NIL (WINDOWPROP ACE.SEQ.WINDOW
-                                                                                 'DSP]
+                                                                                 'DSP])
 
-[PUTPROPS ACE.MT.SCRY.AWY MACRO ((SCREENYCOOR)
+(PUTPROPS ACE.MT.SCRY.AWY
 MACRO
 [(SCREENYCOOR)
                                  (IDIFFERENCE SCREENYCOOR (DSPYOFFSET NIL (WINDOWPROP ACE.SEQ.WINDOW
-                                                                                 'DSP]
+                                                                                 'DSP])
 
-(PUTPROPS ACE.MT.SEQ.SCR.REGION MACRO (NIL (CREATEREGION (ACE.MT.SEQX.SCRX 0)
+(PUTPROPS ACE.MT.SEQ.SCR.REGION
 MACRO
 (NIL (CREATEREGION (ACE.MT.SEQX.SCRX 0)
                                                   (ACE.MT.SEQY.SCRY 0)
                                                   ACE.SEQ.WIDTH ACE.SEQ.HEIGHT)))
 
-(PUTPROPS ACE.MT.SEQ.AW.REGION MACRO (NIL (CREATEREGION ACE.SEQ.WINDOW.XOFF ACE.SEQ.WINDOW.YOFF 
+(PUTPROPS ACE.MT.SEQ.AW.REGION
 MACRO
 (NIL (CREATEREGION ACE.SEQ.WINDOW.XOFF ACE.SEQ.WINDOW.YOFF 
                                                  ACE.SEQ.WIDTH ACE.SEQ.HEIGHT)))
 
-[PUTPROPS ACE.MT.AW.SCR.POINT MACRO ((POINT)
+(PUTPROPS ACE.MT.AW.SCR.POINT
 MACRO
 [(POINT)
                                      (CONS (ACE.MT.AWX.SCRX (CAR POINT))
-                                           (ACE.MT.AWY.SCRY (CDR POINT]
+                                           (ACE.MT.AWY.SCRY (CDR POINT])
 
-[PUTPROPS ACE.MT.AWX.SCRX MACRO ((WINDOWXCOOR)
+(PUTPROPS ACE.MT.AWX.SCRX
 MACRO
 [(WINDOWXCOOR)
                                  (IPLUS WINDOWXCOOR (DSPXOFFSET NIL (WINDOWPROP ACE.SEQ.WINDOW
-                                                                           'DSP]
+                                                                           'DSP])
 
-[PUTPROPS ACE.MT.AWY.SCRY MACRO ((WINDOWYCOOR)
+(PUTPROPS ACE.MT.AWY.SCRY
 MACRO
 [(WINDOWYCOOR)
                                  (IPLUS WINDOWYCOOR (DSPYOFFSET NIL (WINDOWPROP ACE.SEQ.WINDOW
-                                                                           'DSP]
+                                                                           'DSP])
 
-(PUTPROPS ACE.MT.AWX.SEQX MACRO ((WINDOWX)
+(PUTPROPS ACE.MT.AWX.SEQX
 MACRO
 ((WINDOWX)
                                  (IDIFFERENCE WINDOWX ACE.SEQ.WINDOW.XOFF)))
 
-(PUTPROPS ACE.MT.AWY.SEQY MACRO ((WINDOWY)
+(PUTPROPS ACE.MT.AWY.SEQY
 MACRO
 ((WINDOWY)
                                  (IDIFFERENCE WINDOWY ACE.SEQ.WINDOW.YOFF)))
 
-[PUTPROPS ACE.MT.SEQX.SCRX MACRO ((SEQXCOOR)
-                                  (IPLUS ACE.SEQ.WINDOW.XOFF (ACE.MT.AWX.SCRX SEQXCOOR]
+(PUTPROPS ACE.MT.SEQX.SCRX
 MACRO
 ((SEQXCOOR)
+                                  (IPLUS ACE.SEQ.WINDOW.XOFF (ACE.MT.AWX.SCRX SEQXCOOR))))
 
-[PUTPROPS ACE.MT.SEQY.SCRY MACRO ((SEQYCOOR)
-                                  (IPLUS ACE.SEQ.WINDOW.YOFF (ACE.MT.AWY.SCRY SEQYCOOR]
+(PUTPROPS ACE.MT.SEQY.SCRY
 MACRO
 ((SEQYCOOR)
+                                  (IPLUS ACE.SEQ.WINDOW.YOFF (ACE.MT.AWY.SCRY SEQYCOOR))))
 
-(PUTPROPS ACE.MT.SEQX.AWX MACRO ((SEQXCOOR)
+(PUTPROPS ACE.MT.SEQX.AWX
 MACRO
 ((SEQXCOOR)
                                  (IPLUS SEQXCOOR ACE.SEQ.WINDOW.XOFF)))
 
-(PUTPROPS ACE.MT.SEQY.AWY MACRO ((SEQYCOOR)
+(PUTPROPS ACE.MT.SEQY.AWY
 MACRO
 ((SEQYCOOR)
                                  (IPLUS SEQYCOOR ACE.SEQ.WINDOW.YOFF)))
 )
 )
@@ -131,7 +126,7 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
 (* ;; "ANIMATION FILES")

 
 
-(RPAQQ ACE-MAINCOMS
 
+(RPAQQ ACE-MAINCOMS

        [(* MAIN TOP LEVEL STUFF)
         (FNS ACE ACE.ANIMATE ACE.RUN ACEGETFRAME# ACERUNLOOP ACE.NEW.SEQUENCE ACE.NEW.FRAME 
              ACE.QUIT.ACE ACE.RESET.SEQ ACE.RUN.CURRENT.SEQ ACE.DELAY ACE.DELAY.FRAME ACE.DELAY.SEQ 
@@ -1293,17 +1288,16 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS ACE.MAC.CW.INFO.CLIP MACRO ((FORM)
+(PUTPROPS ACE.MAC.CW.INFO.CLIP
 MACRO
 ((FORM)
                                       (RESETLST
                                           [RESETSAVE (PROGN (DSPCLIPPINGREGION (WINDOWPROP
                                                                                 ACE.CONTROL.WINDOW
                                                                                 'INFO.CLIP.REGION)
                                                                    ACE.CONTROL.WINDOW)
                                                             (DSPLEFTMARGIN (fetch
 (REGION LEFT)
-                                                                              of

-                                                                              (WINDOWPROP
-                                                                               ACE.CONTROL.WINDOW
-                                                                               'INFO.CLIP.REGION))
+                                                                              of
 (WINDOWPROP
+                                                                                  ACE.CONTROL.WINDOW
+                                                                                  'INFO.CLIP.REGION))
                                                                    ACE.CONTROL.WINDOW))
                                                  '(PROGN (DSPCLIPPINGREGION (WINDOWPROP 
                                                                                    ACE.CONTROL.WINDOW
@@ -1314,36 +1308,29 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
                                                                 ACE.CONTROL.WINDOW)
                                                          (DSPLEFTMARGIN (fetch
 (REGION LEFT)
                                                                            of
 (WINDOWPROP
-                                                                                   ACE.CONTROL.WINDOW
-                                                                                   
-                                                                                   '
-                                                                                   NORMAL.CLIP.REGION
-                                                                                   ))
+                                                                               ACE.CONTROL.WINDOW
+                                                                               'NORMAL.CLIP.REGION))
                                                                 ACE.CONTROL.WINDOW]
                                           FORM)))
 
-(PUTPROPS ACE.MAC.CW.PROMPT.CLIP MACRO
-       ((FORM)
-        (RESETLST
-            [RESETSAVE (PROGN (DSPCLIPPINGREGION (WINDOWPROP ACE.CONTROL.WINDOW 'PROMPT.CLIP.REGION)
+(PUTPROPS ACE.MAC.CW.PROMPT.CLIP
 MACRO

+          ((FORM)
+           (RESETLST
+               [RESETSAVE (PROGN (DSPCLIPPINGREGION (WINDOWPROP ACE.CONTROL.WINDOW 
+                                                           'PROMPT.CLIP.REGION)
+                                        ACE.CONTROL.WINDOW)
+                                 (DSPLEFTMARGIN (fetch
 (REGION LEFT) of
 (WINDOWPROP 
+                                                                               ACE.CONTROL.WINDOW
+                                                                               'PROMPT.CLIP.REGION))
+                                        ACE.CONTROL.WINDOW))
+                      '(PROGN (DSPCLIPPINGREGION (WINDOWPROP ACE.CONTROL.WINDOW 'NORMAL.CLIP.REGION)
                                      ACE.CONTROL.WINDOW)
-                              (DSPLEFTMARGIN (fetch
 (REGION LEFT) of
 (WINDOWPROP 
-                                                                                   ACE.CONTROL.WINDOW
-                                                                                    
-                                                                                    '
-                                                                                   PROMPT.CLIP.REGION
-                                                                                    ))
-                                     ACE.CONTROL.WINDOW))
-                   '(PROGN (DSPCLIPPINGREGION (WINDOWPROP ACE.CONTROL.WINDOW 'NORMAL.CLIP.REGION)
-                                  ACE.CONTROL.WINDOW)
-                           (DSPLEFTMARGIN (fetch
 (REGION LEFT) of
 (WINDOWPROP 
-                                                                                 ACE.CONTROL.WINDOW
-                                                                                 'NORMAL.CLIP.REGION)
-                                                 )
-                                  ACE.CONTROL.WINDOW]
-            FORM)))
+                              (DSPLEFTMARGIN (fetch
 (REGION LEFT) of
 (WINDOWPROP ACE.CONTROL.WINDOW
+                                                                            'NORMAL.CLIP.REGION))
+                                     ACE.CONTROL.WINDOW]
+               FORM)))
 
-[PUTPROPS ACE.MAC.SEQ.CLIP MACRO ((FORM)
+(PUTPROPS ACE.MAC.SEQ.CLIP
 MACRO
 ((FORM)
                                   (COND
                                      ((WINDOWPROP ACE.CONTROL.WINDOW 'SEQUENCE.CLIPPING.REGION)
                                       (RESETLST
@@ -1358,22 +1345,19 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
                                                                                  ACE.SEQ.WINDOW)
                                                        ACE.SEQ.WINDOW))
                                           FORM))
-                                     (T FORM]
+                                     (T FORM))))
 )
 (DECLARE%: EVAL@COMPILE 
 
-[PUTPROPS ACE.MAC.FETCH.WIDTH MACRO (NIL (fetch
 (BITMAP BITMAPWIDTH)
+(PUTPROPS ACE.MAC.FETCH.WIDTH
 MACRO
 [NIL (fetch
 (BITMAP BITMAPWIDTH)
                                             of
 (fetch
 (ACE.BLIT BITMAP)
-                                                      of
 (CAR (fetch
 (ACE.FRAME BLITS)
-                                                                     of
 (CAR ACE.CURRENT.SEQUENCE
-                                                                                 ]
+                                                  of
 (CAR (fetch
 (ACE.FRAME BLITS)
+                                                             of
 (CAR ACE.CURRENT.SEQUENCE])
 
-[PUTPROPS ACE.MAC.FETCH.HEIGHT MACRO (NIL (fetch
 (BITMAP BITMAPHEIGHT)
+(PUTPROPS ACE.MAC.FETCH.HEIGHT
 MACRO
 [NIL (fetch
 (BITMAP BITMAPHEIGHT)
                                              of
 (fetch
 (ACE.BLIT BITMAP)
-                                                       of
 (CAR (fetch
 (ACE.FRAME BLITS)
-                                                                      of
 (CAR 
-                                                                                 ACE.CURRENT.SEQUENCE
-                                                                                  ]
+                                                   of
 (CAR (fetch
 (ACE.FRAME BLITS)
+                                                              of
 (CAR ACE.CURRENT.SEQUENCE])
 )
 (RPAQ ACE.LEFTMOUSE.CURSOR (CURSORCREATE (QUOTE #*(16 16)GOOLD@@DELIDELIDELIDELIDELIDELIDELIDD@@DD@@DD@@DD@@DD@@DD@@DGOOL
 ) (QUOTE NIL) 8 8))
@@ -1417,14 +1401,15 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
 (ADDTOVAR LAMA
 )
 )
 
-(RPAQQ ACE-PRIMCOMS
 ((* COMPILER STUFF)
-                         (VARS ACE.PIXPERWORD ACE.BITMAP.MASK)
-                         (* LOW LEVEL COMPILER FNS)
-                         (FNS ACE.COMPILE.FRAME ACE.EXTRACT ACESETTHRESHOLD)
-                         (* REGION MAXING ROUTINES)
-                         (FNS ACE.MAX.REGIONS ACE.PICK.BEST.REGION ACE.COMPUTE.AREA)
-                         (* LOW LEVEL BITMAP COMPARISON)
-                         (FNS ACE.SCAN.BITMAPS ACE.SCAN.PRIMBLOCKS ACE.FETCH.BLOCK)))
+(RPAQQ ACE-PRIMCOMS

+       ((* COMPILER STUFF)
+        (VARS ACE.PIXPERWORD ACE.BITMAP.MASK)
+        (* LOW LEVEL COMPILER FNS)
+        (FNS ACE.COMPILE.FRAME ACE.EXTRACT ACESETTHRESHOLD)
+        (* REGION MAXING ROUTINES)
+        (FNS ACE.MAX.REGIONS ACE.PICK.BEST.REGION ACE.COMPUTE.AREA)
+        (* LOW LEVEL BITMAP COMPARISON)
+        (FNS ACE.SCAN.BITMAPS ACE.SCAN.PRIMBLOCKS ACE.FETCH.BLOCK)))
 
 
 
@@ -1687,10 +1672,8 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
            WORDOFFSET])
 )
 
-(RPAQQ ACE-EDITCOMS
 
-       [(FILES (LOADCOMP)
-               ACE)
-        (* TOP LEVEL EDITING STUFF)
+(RPAQQ ACE-EDITCOMS

+       [(* TOP LEVEL EDITING STUFF)
         (FNS ACE.EDIT ACE.EDIT.FRAME ACE.EDIT.SETUP.EDIT.MENU ACEGETREGIONFACTOR ACEROTATEREGION 
              ACESCALEREGION)
         (* LINEART FNS)
@@ -1715,9 +1698,6 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
                ACE.EDIT.TEXT.FACE.MENU ACE.EDIT.TEXTURE.MENU ACE.EDIT.PUTDOWN.MENU)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (ACE.EDIT.CLEAR.ALL.MENUS])
 
-(FILESLOAD (LOADCOMP)
-       ACE)
-
 
 
 (* TOP LEVEL EDITING STUFF)

@@ -1822,13 +1802,13 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
           (SETQ WINDOW ACE.SEQ.WINDOW)
           (SETQ WINDOW (\INSUREWINDOW WINDOW))
           (RESETLST
-              (RESETSAVE NIL (LIST 'CURSOR (CURSOR)))
+              (RESETSAVE NIL (LIST 'CURSOR (CURSOR)))
               (PROG (DS HOTX HOTY)
                     (TOTOPW WINDOW)                          (* look for a previously stored 
-
                                                           brush.)

+
                                                           brush.)

                     [COND
-                       ((SETQ BRUSH (WINDOWPROP WINDOW 'PAINTBRUSH))
-                        (SETQ PAINTCOMMANDMODE (CAR BRUSH))
+                       ((SETQ BRUSH (WINDOWPROP WINDOW 'PAINTBRUSH))
+                        (SETQ PAINTCOMMANDMODE (CAR BRUSH))
                         (SETQ PAINTCOMMANDSHADE (CADR BRUSH))
                         (SETQ PAINTCOMMANDBRUSH (CADDR BRUSH]
                     (SETQ DS (WINDOWPROP WINDOW 'DSP))
@@ -1854,40 +1834,40 @@ Copyright (c) 1988, 1993 by Michel Denber.  All rights reserved.
                     [CURSORHOTSPOT (create
 POSITION
                                           XCOORD _ (SETQ HOTX (IDIFFERENCE (IMIN (fetch
 
                                                                                         BITMAPWIDTH
-                                                                                    of
 BRUSH)
-                                                                                 16)
-                                                                     2))
-                                          YCOORD _ (SETQ HOTY (IDIFFERENCE (IMIN (fetch
 
-                                                                                        BITMAPHEIGHT
-                                                                                    of
 BRUSH)
-                                                                                 16)
-                                                                     2]
-                PAINTLP
-                    (ACE.GET.DEVICE.STATE&CURSOR
)
-                    [COND
-                       ((KEYDOWNP 'RSHIFT)
-                        (RETURN))
-                       ((OR (LASTMOUSESTATE RIGHT)
-                            (KEYDOWNP 'LSHIFT))
-                        (COND
-                           ((OR (INSIDE? (DSPCLIPPINGREGION NIL DS)
-                                       (LASTMOUSEX DS)
-                                       (LASTMOUSEY DS))
-                                (NOT (WHICHW LASTMOUSEX LASTMOUSEY)))
-                                                             (* inside the interior, give command 
-
                                                           menu)

-                            (SELECTQ [MENU (COND
-                                              ((type?
 MENU PAINTCOMMANDMENU)
-                                               PAINTCOMMANDMENU)
-                                              (T (SETQ PAINTCOMMANDMENU
-                                                  (create
 MENU
-                                                         ITEMS _ '((HardCopy 'HARDCOPY 
-                                                     "Makes a press file of the window and prints it"
-                                                                          )
-                                                                   (SetMode 'MODE 
-                                                    "Allows specification of how new bits are merged"
-                                                                          )
-                                                                   (SetShade 'SHADE 
-                                                                 "Allows specification of new shade."
-                                                                          )
+                                                                                    of
 BRUSH)
+                                                                                 16)
+                                                                     2))
+                                          YCOORD _ (SETQ HOTY (IDIFFERENCE (IMIN (fetch
 
+                                                                                        BITMAPHEIGHT
+                                                                                    of
 BRUSH)
+                                                                                 16)
+                                                                     2]
+                PAINTLP
+                    (ACE.GET.DEVICE.STATE&CURSOR
)
+                    [COND
+                       ((KEYDOWNP 'RSHIFT)
+                        (RETURN))
+                       ((OR (LASTMOUSESTATE RIGHT)
+                            (KEYDOWNP 'LSHIFT))
+                        (COND
+                           ((OR (INSIDE? (DSPCLIPPINGREGION NIL DS)
+                                       (LASTMOUSEX DS)
+                                       (LASTMOUSEY DS))
+                                (NOT (WHICHW LASTMOUSEX LASTMOUSEY)))
+                                                             (* inside the interior, give command 
+
                                                           menu)

+                            (SELECTQ [MENU (COND
+                                              ((type?
 MENU PAINTCOMMANDMENU)
+                                               PAINTCOMMANDMENU)
+                                              (T (SETQ PAINTCOMMANDMENU
+                                                  (create
 MENU
+                                                         ITEMS _ '((HardCopy 'HARDCOPY 
+                                                     "Makes a press file of the window and prints it"
+                                                                          )
+                                                                   (SetMode 'MODE 
+                                                    "Allows specification of how new bits are merged"
+                                                                          )
+                                                                   (SetShade 'SHADE 
+                                                                 "Allows specification of new shade."
+                                                                          )
                                                                    (SetShape 'SHAPE 

lispusers/COMPAREDIRECTORIES

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Mar-2022 19:53:40" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;214
 123835 
+
(FILECREATED "25-May-2022 08:44:46" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;234
 125334 
 
-      :CHANGES-TO (FNS CD.COMMANDSELECTEDFN)
+      :CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
 
-      :PREVIOUS-DATE " 5-Mar-2022 15:10:31" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;213)
+      :PREVIOUS-DATE "24-May-2022 15:49:54" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;233)
 
 
 (* ; "
@@ -52,8 +52,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                                                       TABLEBROWSER))
               (FNS CD.TABLEITEM CD.TABLEITEM.PRINTFN CD.TABLEITEM.COPYFN 
                    CDTABLEBROWSER.HEADING.REPAINTFN)
-              (FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CDBROWSER-COPY 
-                   CDBROWSER-DELETE-FILE CD-SWAPDIRS)
+              (FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CD-COMPARE-FILES 
+                   CDBROWSER-COPY CDBROWSER-DELETE-FILE CD-SWAPDIRS)
               (VARS CDTABLEBROWSER.MENUITEMS)
               (FILES (SYSLOAD)
                      COMPARESOURCES COMPARETEXT))))
@@ -66,10 +66,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
 
 (COMPAREDIRECTORIES

   [LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS 
-                FIXDIRECTORYDATES)
                           (* ; "Edited 23-Feb-2022 21:10 by rmk")


-                                                             (* ; "Edited  4-Feb-2022 13:44 by rmk")


-                                                             (* ; "Edited 31-Jan-2022 21:52 by rmk")


-                                                             (* ; "Edited 26-Jan-2022 13:33 by rmk")


+                FIXDIRECTORYDATES)
                           (* ; "Edited 29-Mar-2022 11:50 by rmk")


+                                                             (* ; "Edited 23-Feb-2022 21:10 by rmk")


                                                              (* ; "Edited  4-Jan-2022 12:09 by rmk")


                                                             (* ; "Edited 31-Oct-2021 11:01 by rmk:")


                                                             (* ; "Edited  7-Jan-2021 23:21 by rmk:")

@@ -121,12 +119,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
               (FIX-DIRECTORY-DATES
 DIR2))
           (CDPRINT.HEADER
 DIR1 DIR2 SELECT DATE T)
           (PRINTOUT T " ... ")
-          (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS
 (CDFILES
 DIR1 INCLUDEDFILES EXCLUDEDFILES 
-                                                        ALLVERSIONS DEPTH1)
-                              USEDIRECTORYDATE DIR1 ALLVERSIONS))
-          (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS
 (CDFILES
 DIR2 INCLUDEDFILES EXCLUDEDFILES 
-                                                        ALLVERSIONS DEPTH2)
-                              USEDIRECTORYDATE DIR2 ALLVERSIONS))
+          (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS
 DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1
+                              USEDIRECTORYDATE))
+          (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS
 DIR2 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH2
+                              USEDIRECTORYDATE))
 
      (* ;; "The CAR of each info is the atomic match-name, the CDR is a list of infos with that matchname, only 1 unless AllVERSIONS. ")

 
@@ -152,22 +148,26 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
           (RETURN (CDPRINT
 CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT])
 
 (COMPAREDIRECTORIES.INFOS

-  [LAMBDA (FILES USEDIRECTORYDATE DIR ALLVERSIONS)
+  [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE)
 
-    (* ;; "Edited 24-Feb-2022 09:19 by rmk: is a list of CDINFOS with the match-name consed on to the front. If ALLVERSIONS")

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

 
-    (* ;; "Value is a list  of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ")

+    (* ;; "Edited 29-Mar-2022 11:53 by rmk: Produces a list of CDINFOS with the match-name consed on to the front.")

 
-    (FOR
 FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) IN
 FILES
+    (* ;; "Each entry is a list  of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ")

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

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

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

-             (SETQ LDATE (OR (FILEDATE STREAM T)
-                             (FILEDATE STREAM)))
+                                                             (* ; 
+
                                            "Is it a Lisp file? Get it's internal filecreated date. ")

+             (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE)
+                    (COMPAREDIRECTORIES.INFOS.TYPE
 STREAM))
              (PROG1 (LIST (MATCHNAME
 FULLNAME STARTPOS)
                           (CREATE
 CDINFO
                                  FULLNAME _ (FULLNAME STREAM)
@@ -177,7 +177,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                                                              LDATE)))
                                  LENGTH _ (GETFILEINFO STREAM 'LENGTH)
                                  AUTHOR _ (GETFILEINFO STREAM 'AUTHOR)
-                                 TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE
 STREAM LDATE)
+                                 TYPE _ TYPE
                                  EOL _ (EOLTYPE
 STREAM)))
                     (CLOSEF? STREAM))
        FINALLY
 
@@ -322,18 +322,20 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                                             CDE])
 
 (COMPAREDIRECTORIES.INFOS.TYPE

-  [LAMBDA (FULLNAME LDATE)                                   (* ; "Edited  4-Jan-2022 13:10 by rmk")

+  [LAMBDA (FILE)
                                             (* ; "Edited 22-May-2022 14:27 by rmk")


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


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


                                                              (* ; "Edited 12-Dec-2021 22:50 by rmk")

-    (IF
 LDATE
-        THEN
 (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION)
-                          *COMPILED-EXTENSIONS*)
-                 'COMPILED
-                 'SOURCE)
-      ELSEIF
 (PRINTFILETYPE FULLNAME)
-      ELSE
 (SELECTQ (U-CASE (FILENAMEFIELD FULLNAME 'EXTENSION))
-               ((TXT TEXT SH MD C) 
-                    'TEXT)
-               'OTHER])
+    (LET (TYPE DATE)
+         (CL:MULTIPLE-VALUE-SETQ (TYPE DATE)
+                (LISPFILETYPE FILE))
+         (CL:UNLESS TYPE
+             (SETQ TYPE (IF
 (PRINTFILETYPE FILE)
+                          ELSEIF
 (MEMB (FILENAMEFIELD FILE 'EXTENSION)
+                                       '(TXT TEXT SH MD C))
+                            THEN
 'TEXT
+                          ELSE
 'OTHER)))
+         (CL:VALUES TYPE DATE])
 
 (MATCHNAME

   [LAMBDA (NAME STARTPOS)
                                    (* ; "Edited 24-Feb-2022 09:10 by rmk")


@@ -386,7 +388,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
 (DEFINEQ
 
 (CDFILES

-  [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)
(* ; "Edited  5-Mar-2022 15:05 by rmk")


+  [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)
(* ; "Edited 25-Apr-2022 08:42 by rmk")


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


                                                             (* ; "Edited 16-Oct-2020 13:42 by rmk:")

 
     (* ;; "Returns a list of fullnames for files that satisfy the criteria.  We generate all candidates that match INCLUDEDFILES but not EXCLUDEDFILES in DIR.")

@@ -414,8 +417,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
     (LET ([INCLUDES (CDFILES.PATS
 (OR INCLUDEDFILES '*.*]
           (EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS
 EXCLUDEDFILES)))
           HOST ENUMPAT)
-         (SETQ HOST (FILENAMEFIELD DIR 'HOST))
-         (SETQ DIR (FILENAMEFIELD DIR 'DIRECTORY))
+         (SETQ HOST (FILENAMEFIELD.STRING DIR 'HOST))
+         (SETQ DIR (FILENAMEFIELD.STRING DIR 'DIRECTORY))
          (CL:UNLESS DEPTH
 
              (* ;; "DEPTH is the number of internal > or /")

@@ -439,7 +442,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                                            (* ;; 
 
   "If We don't prefix TOPDIR with <, then if TOPDIR contains a colon it is interpreted as a device.")

 
-                                           (SETQ ENUMPAT (PACKFILENAME 'HOST HOST 'DIRECTORY
+                                           (SETQ ENUMPAT (PACKFILENAME.STRING 'HOST HOST 'DIRECTORY
                                                                 (CONCAT "<" DIR ">" (OR SD ""))
                                                                 'NAME N 'EXTENSION E 'VERSION
                                                                 (CL:IF ALLVERSIONS
@@ -1144,154 +1147,144 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                                                                         CF SCREATION])
 
 (FIND-UNSOURCED-FILES

-  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)
               (* ; "Edited 15-Sep-2020 15:32 by rmk:")

-                                                             (* ; "Edited  3-Nov-94 15:17 by jds")

+  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)
                    (* ; "Edited 25-Apr-2022 08:43 by rmk")


+                                                            (* ; "Edited 15-Sep-2020 15:32 by rmk:")


+                                                             (* ; "Edited  3-Nov-94 15:17 by jds")

 
-    (* ;; 
-
  "Produces a list of compiled FILES for which no source file can be found in the same directory.")

+    (* ;; 
+
    "Produces a list of compiled FILES for which no source file can be found in the same directory.")

 
-    (* ;; "The source date in at least one DFASL was off by a second, maybe some sort of IDATE rounding?  So, give a margin.")

+    (* ;; "The source date in at least one DFASL was off by a second, maybe some sort of IDATE rounding?  So, give a margin.")

 
-    (* ;; 
-
"We want the most recent version only.  Check CREATED-AS to make sure it really is a compiled file.")

+    (* ;; 
+
 "We want the most recent version only.  Check CREATED-AS to make sure it really is a compiled file.")

 
-    (* ;; "Sort to get lcoms and dfasls next to each other.")

+    (* ;; "Sort to get lcoms and dfasls next to each other.")

 
     (LET (CCREATEDS)
-         (SETQ CCREATEDS (FOR
 CEXT FOUND CCREATED INSIDE
 (OR COMPILEEXTS 
-                                                                     *COMPILED-EXTENSIONS*)
+         (SETQ CCREATEDS (FOR
 CEXT FOUND CCREATED INSIDE
 (OR COMPILEEXTS *COMPILED-EXTENSIONS*)
                             JOIN
 (FOR
 CF IN
 [OR (LISTP FILES)
-                                                            (FILDIR (PACKFILENAME 'EXTENSION CEXT
-                                                                           'VERSION "" 'BODY
-                                                                           '*]
-                                        WHEN
 (CDDR (SETQ CCREATED (CREATED-AS
 CF)))
-                                        UNLESS
 (MEMBER CCREATED $$VAL) COLLECT
 CCREATED)))
+                                                (FILDIR (PACKFILENAME.STRING 'EXTENSION CEXT
+                                                               'VERSION "" 'BODY '*]
+                                    WHEN
 (CDDR (SETQ CCREATED (CREATED-AS
 CF)))
+                                    UNLESS
 (MEMBER CCREATED $$VAL) COLLECT
 CCREATED)))
 
-         (* ;; "CCREATEDS is now a list of CREATED-AS items")

+         (* ;; "CCREATEDS is now a list of CREATED-AS items")

 
-         (FOR
 CC SF IN
 CCREATEDS UNLESS
 (AND [SETQ SF (INFILEP (PACKFILENAME 'EXTENSION 
-                                                                                  NIL 'VERSION NIL
-                                                                                  'BODY
-                                                                                  (CAR CC]
-                                                         (SOURCE-FOR-COMPILED-P
 (SETQ SF
-                                                                                     (CREATED-AS

-                                                                                      SF))
-                                                                CC DFASLMARGIN))
+         (FOR
 CC SF IN
 CCREATEDS UNLESS
 (AND [SETQ SF (INFILEP (PACKFILENAME.STRING 'EXTENSION NIL
+                                                                      'VERSION NIL 'BODY (CAR CC]
+                                             (SOURCE-FOR-COMPILED-P
 (SETQ SF (CREATED-AS
 SF))
+                                                    CC DFASLMARGIN))
             COLLECT
 [LIST (CAR CC)
-                              (AND SF (LIST (CAR SF)
-                                            (ROUND (COMPILE-SOURCE-DATE-DIFF
 CC SF]
+                          (AND SF (LIST (CAR SF)
+                                        (ROUND (COMPILE-SOURCE-DATE-DIFF
 CC SF]
             FINALLY
 (RETURN (SORT $$VAL (FUNCTION (LAMBDA (CF1 CF2)
-                                                        (ALPHORDER (FILENAMEFIELD (CAR CF1)
-                                                                          'NAME)
-                                                               (FILENAMEFIELD (CAR CF2)
-                                                                      'NAME])
+                                                    (ALPHORDER (FILENAMEFIELD.STRING (CAR CF1)
+                                                                      'NAME)
+                                                           (FILENAMEFIELD.STRING (CAR CF2)
+                                                                  'NAME])
 
 (FIND-SOURCE-FILES

-  [LAMBDA (CFILES SDIRS DFASLMARGIN)
                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")

+  [LAMBDA (CFILES SDIRS DFASLMARGIN)
                         (* ; "Edited 25-Apr-2022 08:43 by rmk")


+                                                            (* ; "Edited  9-Sep-2020 12:26 by rmk:")

 
-    (* ;; "Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES SFILES is a list of source files in SDIRS that CFILE was compiled on.")

+    (* ;; "Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES SFILES is a list of source files in SDIRS that CFILE was compiled on.")

 
-    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

+    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

 
     (SETQ SDIRS (FOR
 SD INSIDE
 (OR SDIRS T) COLLECT
 (DIRECTORYNAME SD)))
     (SORT (FOR
 CF SFILES CNAME CCREATED IN
 (OR (LISTP CFILES)
-                                                       (FILDIR CFILES))
+                                               (FILDIR CFILES))
              WHEN
 (AND (SETQ CNAME (INFILEP CF))
-                           (CDDR (SETQ CCREATED (CREATED-AS
 CF)))
-                           (SETQ SFILES (FOR
 SD SF IN
 SDIRS
-                                           WHEN
 (AND (SETQ SF (INFILEP (PACKFILENAME
-                                                                            'NAME
-                                                                            (FILENAMEFIELD
-                                                                             CF
-                                                                             'NAME)
-                                                                            'BODY SD)))
-                                                         (SOURCE-FOR-COMPILED-P
 SF CCREATED 
-                                                                DFASLMARGIN)) COLLECT
 SF)))
-             COLLECT
 (CONS CNAME SFILES))
+                       (CDDR (SETQ CCREATED (CREATED-AS
 CF)))
+                       (SETQ SFILES (FOR
 SD SF IN
 SDIRS
+                                       WHEN
 (AND (SETQ SF (INFILEP (PACKFILENAME.STRING
+                                                                    'NAME
+                                                                    (FILENAMEFIELD.STRING
+                                                                     CF
+                                                                     'NAME)
+                                                                    'BODY SD)))
+                                                 (SOURCE-FOR-COMPILED-P
 SF CCREATED DFASLMARGIN))
+                                       COLLECT
 SF))) COLLECT
 (CONS CNAME SFILES))
           (FUNCTION (LAMBDA (P1 P2)
-                      (ALPHORDER (FILENAMEFIELD (CAR P1))
-                             (FILENAMEFIELD (CAR P2])
+                      (ALPHORDER (FILENAMEFIELD.STRING (CAR P1))
+                             (FILENAMEFIELD.STRING (CAR P2])
 
 (FIND-COMPILED-FILES

-  [LAMBDA (SFILES CDIRS DFASLMARGIN)
                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")

+  [LAMBDA (SFILES CDIRS DFASLMARGIN)
                         (* ; "Edited 25-Apr-2022 08:44 by rmk")


+                                                            (* ; "Edited  9-Sep-2020 12:26 by rmk:")

 
-    (* ;; "Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES CFILES is a list of compiled files in CDIRS that were compiled on SFILE.")

+    (* ;; "Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES CFILES is a list of compiled files in CDIRS that were compiled on SFILE.")

 
-    (* ;; "FILEDATE is true for source files and compiled files")

+    (* ;; "FILEDATE is true for source files and compiled files")

 
-    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

+    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

 
     (SETQ CDIRS (FOR
 CD INSIDE
 (OR CDIRS T) COLLECT
 (DIRECTORYNAME CD)))
     (SORT (FOR
 SF CFILES SNAME SCREATED IN
 (OR (LISTP SFILES)
-                                                       (FILDIR SFILES))
+                                               (FILDIR SFILES))
              WHEN
 [AND (SETQ SNAME (INFILEP SF))
-                           (SETQ SCREATED (CREATED-AS
 SF))
-                           (NOT (CDDR SCREATED))
-                           (SETQ CFILES (FOR
 CEXT (ROOT _ (FILENAMEFIELD SNAME 'NAME))
-                                           IN
 *COMPILED-EXTENSIONS*
-                                           JOIN
 (FOR
 CD CF IN
 CDIRS
-                                                       WHEN
 (AND (SETQ CF
-                                                                      (INFILEP (PACKFILENAME
-                                                                                'NAME ROOT
-                                                                                'EXTENSION CEXT
-                                                                                'BODY CD)))
-                                                                     (SOURCE-FOR-COMPILED-P

-                                                                      SCREATED CF DFASLMARGIN))
-                                                       COLLECT
 CF] COLLECT
 (CONS SNAME CFILES
-                                                                                         ))
+                       (SETQ SCREATED (CREATED-AS
 SF))
+                       (NOT (CDDR SCREATED))
+                       (SETQ CFILES (FOR
 CEXT (ROOT _ (FILENAMEFIELD.STRING SNAME 'NAME))
+                                       IN
 *COMPILED-EXTENSIONS*
+                                       JOIN
 (FOR
 CD CF IN
 CDIRS
+                                               WHEN
 (AND (SETQ CF (INFILEP (PACKFILENAME.STRING
+                                                                            'NAME ROOT 'EXTENSION 
+                                                                            CEXT 'BODY CD)))
+                                                         (SOURCE-FOR-COMPILED-P
 SCREATED CF 
+                                                                DFASLMARGIN)) COLLECT
 CF]
+             COLLECT
 (CONS SNAME CFILES))
           (FUNCTION (LAMBDA (P1 P2)
-                      (ALPHORDER (FILENAMEFIELD (CAR P1))
-                             (FILENAMEFIELD (CAR P2])
+                      (ALPHORDER (FILENAMEFIELD.STRING (CAR P1))
+                             (FILENAMEFIELD.STRING (CAR P2])
 
 (FIND-UNLOADED-FILES

-  [LAMBDA (FILES)
                                       (* ; "Edited  9-Sep-2020 19:35 by rmk:")

+  [LAMBDA (FILES)
                                            (* ; "Edited 25-Apr-2022 08:49 by rmk")


+                                                            (* ; "Edited  9-Sep-2020 19:35 by rmk:")

 
-    (* ;; "Returns the files in FILES that don't have FILECREATED properties and presumably are therefore not loaded in the current sysout.")

+    (* ;; "Returns the files in FILES that don't have FILECREATED properties and presumably are therefore not loaded in the current sysout.")

 
     (FOR
 F IN
 (OR (LISTP FILES)
-                          (FILDIR FILES)) WHEN
 (AND (SETQ F (INFILEP (CL:IF (LISTP F)
-                                                                             (CAR F)
-                                                                             F)))
-                                                        (FILEDATE F))
-       UNLESS
 (GETP (FILENAMEFIELD F 'NAME)
-                        'FILEDATES) COLLECT
 F])
+                  (FILDIR FILES)) WHEN
 (AND (SETQ F (INFILEP (CL:IF (LISTP F)
+                                                                 (CAR F)
+                                                                 F)))
+                                            (FILEDATE F)) UNLESS
 (GETP (FILENAMEFIELD F 'NAME)
+                                                                       'FILEDATES) COLLECT
 F])
 
 (FIND-LOADED-FILES

-  [LAMBDA (ROOTFILENAMES)
                               (* ; "Edited 19-Sep-2020 07:20 by rmk:")

+  [LAMBDA (ROOTFILENAMES)
                                    (* ; "Edited 25-Apr-2022 09:04 by rmk")


+                                                            (* ; "Edited 19-Sep-2020 07:20 by rmk:")

     (FOR
 RN INSIDE
 ROOTFILENAMES WHEN
 (GETP RN 'FILEDATES)
-       COLLECT
 (CONS RN (FOR
 F IN
 LOADEDFILELST WHEN
 (EQ RN (FILENAMEFIELD
-                                                                             F
-                                                                             'NAME)) COLLECT

-                                                                                     F])
+       COLLECT
 (CONS RN (FOR
 F IN
 LOADEDFILELST WHEN
 (EQ RN (FILENAMEFIELD F 'NAME)) COLLECT
 F])
 
 (FIND-MULTICOMPILED-FILES

-  [LAMBDA (FILES SHOWINFO)
                              (* ; "Edited 20-Sep-2020 20:57 by rmk:")

+  [LAMBDA (FILES SHOWINFO)
                                   (* ; "Edited 25-Apr-2022 09:07 by rmk")


+                                                            (* ; "Edited 20-Sep-2020 20:57 by rmk:")

 
-    (* ;; "Returns a list of names for files in FILES that have multiple compilations")

+    (* ;; "Returns a list of names for files in FILES that have multiple compilations")

 
     (LET (SFILES)
          (FOR
 F EXT NAME IN
 (OR (LISTP FILES)
-                                        (FILDIR FILES)) WHEN
 (MEMB (SETQ EXT (FILENAMEFIELD
-                                                                                  F
-                                                                                  'EXTENSION))
-                                                                       *COMPILED-EXTENSIONS*)
+                                (FILDIR FILES)) WHEN
 (MEMB (SETQ EXT (FILENAMEFIELD F 'EXTENSION))
+                                                           *COMPILED-EXTENSIONS*)
             DO
 (SETQ NAME (FILENAMEFIELD F 'NAME)) 
 
-                  (* ;; "PUSHNEW because we haven't filtered out versions")

+               (* ;; "PUSHNEW because we haven't filtered out versions")

 
-                  (PUSHNEW
 [CDR (OR (ASSOC NAME SFILES)
-                                        (CAR (PUSH
 SFILES (CONS NAME]
-                         EXT))
+               (PUSHNEW
 [CDR (OR (ASSOC NAME SFILES)
+                                 (CAR (PUSH
 SFILES (CONS NAME]
+                      EXT))
          (FOR
 S IN
 SFILES WHEN
 (CDDR S)
             COLLECT
 (IF
 SHOWINFO
-                            THEN
 `[,(CAR S)
-                                       ,(CADAR (FIND-LOADED-FILES
 (CAR S)))
-                                       ,(CREATED-AS
 (CAR S))
-                                       ,@(FOR
 EXT IN
 (SORT (CDR S))
-                                            COLLECT
 (CREATED-AS
 (PACKFILENAME 'EXTENSION EXT
-                                                                               'BODY
-                                                                               (CAR S]
-                          ELSE
 (CAR S])
+                        THEN
 `[,(CAR S)
+                               ,(CADAR (FIND-LOADED-FILES
 (CAR S)))
+                               ,(CREATED-AS
 (CAR S))
+                               ,@(FOR
 EXT IN
 (SORT (CDR S)) COLLECT
 (CREATED-AS
 (PACKFILENAME.STRING
+                                                                                 'EXTENSION EXT
+                                                                                 'BODY
+                                                                                 (CAR S]
+                      ELSE
 (CAR S])
 )
 (DEFINEQ
 
@@ -1386,21 +1379,23 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
               (LIST SOURCENAME (GDATE (IDATE SOURCEDATE))))])
 
 (SOURCE-FOR-COMPILED-P

-  [LAMBDA (SOURCE COMPILED DFASLMARGIN)
                 (* ; "Edited 31-Oct-2020 09:12 by rmk:")

+  [LAMBDA (SOURCE COMPILED DFASLMARGIN)
                      (* ; "Edited  9-May-2022 20:28 by rmk")


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


+                                                            (* ; "Edited 31-Oct-2020 09:12 by rmk:")

 
-    (* ;; "There seems to be some variation between the source dates in dfasl files and the filecreated date in the sources, they often don't match exactly.  But if they are within DFASLMARGIN, we assume a match.  We require exact date match for LCOMS")

+    (* ;; "There seems to be some variation between the source dates in dfasl files and the filecreated date in the sources, they often don't match exactly.  But if they are within DFASLMARGIN, we assume a match.  We require exact date match for LCOMS")

 
-    (* ;; "This is needed for dfasl files created before they recorded the source filecreated name and date instead of the directory source name and date when compile took place.")

+    (* ;; "This is needed for dfasl files created before they recorded the source filecreated name and date instead of the directory source name and date when compile took place.")

 
-    (* ;; "")

+    (* ;; "")

 
-    (* ;; "DFASLMARGIN is a pair (after before) where we assume a match if the compiled date is no more than after minutes after the source date and no more than before minuts before (the diff is negative then).")

+    (* ;; "DFASLMARGIN is a pair (after before) where we assume a match if the compiled date is no more than after minutes after the source date and no more than before minuts before (the diff is negative then).")

 
-    (* ;; "A single positive integer x is interpreted as (x 0).  A single negative integer x is interpreted as (-x x) (before or after x).")

+    (* ;; "A single positive integer x is interpreted as (x 0).  A single negative integer x is interpreted as (-x x) (before or after x).")

 
-    (* ;; "Default is (20 0).")

+    (* ;; "Default is (20 0).")

 
-    (* ;; "T is positive or negative infinity")

+    (* ;; "T is positive or negative infinity")

 
     (CL:UNLESS (LISTP SOURCE)
         (SETQ SOURCE (CREATED-AS
 SOURCE)))
@@ -1408,11 +1403,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
         (SETQ COMPILED (CREATED-AS
 COMPILED)))
     (SETQ DFASLMARGIN (IF
 (NULL DFASLMARGIN)
                           THEN
 
+                               (* ;; 
+
                         "If compiled is later than source by less than 20 minutes, it's probably OK")

 
-                                (* ;; 
-
                       "If compiled is later than source by less than 20 minutes, it's probably OK")

-
-                                '(20 0)
+                               '(20 0)
                         ELSEIF
 (EQ T DFASLMARGIN)
                           THEN
 '(T 0)
                         ELSEIF
 (LISTP DFASLMARGIN)
@@ -1420,17 +1414,17 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                           THEN
 (ERROR "ILLEGAL DFASLMARGIN" DFASLMARGIN)
                         ELSEIF
 (MINUSP DFASLMARGIN)
                           THEN
 (LIST (MINUS DFASLMARGIN)
-                                         DFASLMARGIN)
+                                     DFASLMARGIN)
                         ELSE
 (LIST DFASLMARGIN 0)))
     (OR (EQUAL (CAR SOURCE)
                (CADDR COMPILED))
         (EQUAL (CADR SOURCE)
                (CADDDR COMPILED))
-        (AND [EQ 'DFASL (U-CASE (FILENAMEFIELD (CAR COMPILED)
-                                       'EXTENSION]
+        (AND (STRING.EQUAL 'DFASL (FILENAMEFIELD.STRING (CAR COMPILED)
+                                         'EXTENSION))
              (LET ((TIMEDIFF (COMPILE-SOURCE-DATE-DIFF
 COMPILED SOURCE)))
 
-                  (* ;; "If compiled was no more than 20 minutes later, it's probably OK.  Of no more than DFASLMARGIN earlier, if it is negative.")

+                  (* ;; "If compiled was no more than 20 minutes later, it's probably OK.  Of no more than DFASLMARGIN earlier, if it is negative.")

 
                   (AND (OR (EQ T (CAR DFASLMARGIN))
                            (LEQ TIMEDIFF (CAR DFASLMARGIN)))
@@ -1877,105 +1871,124 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
 (CD-MENUFN

   [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
 
-    (* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")

+    (* ;; "Edited 21-May-2022 21:59 by rmk")

 
-    (* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")

+    (* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")

 
     (* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo).  The selector for the selectq is either the CAR of the extrainfo or the display atom.")

 
-    (DECLARE
 (USEDFREE CDENTRY LABEL1 LABLE2 FILE1 FILE2 WINDOW))
+    (DECLARE
 (USEDFREE LABEL1 LABEL2 FILE1 FILE2 WINDOW TYPE))
     (SETQ MENUITEM (OR (CADDR MENUITEM)
                        (CAR MENUITEM)))
     (CL:WHEN (MEMB MENUITEM '(Compare See See% right See% both See% left))
                                                              (* ; "Close the previous ones")

         (CLOSEWITH.DOIT WINDOW))
-    (LET
-     (CHILDREN)
-     (SETQ CHILDREN
-      (SELECTQ MENUITEM
-          (Compare (IF
 (AND FILE1 FILE2)
-                       THEN
 [SELECTQ TYPE
-                                (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
-                                               (RELCREATEREGION
-                                                [FIXR (TIMES 0.75 (FETCH
 (REGION WIDTH)
-                                                                     OF
 (WINDOWPROP WINDOW
-                                                                               'REGION]
-                                                200
-                                                'LEFT
-                                                'TOP
-                                                `(,WINDOW 0.125)
-                                                (IPLUS (FETCH
 (REGION BOTTOM)
-                                                          OF
 (WINDOWPROP WINDOW 'REGION))
-                                                       20)
-                                                NIL)))
-                                (COMPILED (FLASHWINDOW T)
-                                          (PRIN3 "Cannot compare compiled files" T))
-                                ((TEXT TEDIT OTHER) 
-                                                    (* ;; 
-
                                       "Works for TEDIT, but doesn't detect image object differences")

-
-                                     (LET ((COMPARETEXT.ALLCHUNKS))
-                                          (DECLARE
 (SPECVARS COMPARETEXT.ALLCHUNKS))
-                                          (COMPARETEXT FILE1 FILE2 'LINE
-                                                 (RELCREATEPOSITION `(,WINDOW 0.5)
-                                                        (IPLUS (FETCH
 (REGION BOTTOM)
-                                                                  OF
 (WINDOWPROP WINDOW 'REGION))
-                                                               20))
-                                                 (LIST LABEL1 LABEL2))))
-                                (PROGN (FLASHWINDOW T)
-                                       (PRIN3 "Unable to compare, showing both" T)
-                                       (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
-                                              (RELCREATEREGION 1400 700 'LEFT 'TOP
-                                                     `(,WINDOW 0.5 -701)
-                                                     (IPLUS (FETCH
 (REGION BOTTOM)
-                                                               OF
 (WINDOWPROP WINDOW 'REGION))
-                                                            -1)
-                                                     NIL]
-                     ELSE
 (FLASHWINDOW T)
-                          (PRIN3 "Only one file" T)))
-          (See% left (IF
 FILE1
-                         THEN
 (TEDIT-SEE FILE1 (RELCREATEREGION 700 700 'RIGHT 'TOP
-                                                      `(,WINDOW 0.5)
-                                                      (IPLUS (FETCH
 (REGION BOTTOM)
-                                                                OF
 (WINDOWPROP WINDOW 'REGION))
-                                                             -1)
-                                                      T)
-                                     NIL
-                                     (CONCAT "SEE window for " LABEL1))
-                       ELSE
 (FLASHWINDOW T)
-                            (PRIN3 "No file to print" T)))
-          (See% right (IF
 FILE2
-                          THEN
 (TEDIT-SEE FILE2 (RELCREATEREGION 700 700 'LEFT 'TOP
-                                                       `(,WINDOW 0.5)
-                                                       (IPLUS (FETCH
 (REGION BOTTOM)
-                                                                 OF
 (WINDOWPROP WINDOW 'REGION))
-                                                              -1)
-                                                       NIL)
-                                      NIL
-                                      (CONCAT "SEE window for " LABEL2))
-                        ELSE
 (FLASHWINDOW T)
-                             (PRIN3 "No file to print" T)))
-          ((See See% both) 
-               (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 (RELCREATEREGION
-                                                        1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
+    (LET (CHILDREN)
+         (SETQ CHILDREN (SELECTQ MENUITEM
+                            (Compare (IF
 (AND FILE1 FILE2)
+                                         THEN
 (CD-COMPARE-FILES
 FILE1 FILE2 LABEL1 LABEL2 TYPE
+                                                     (WINDOWPROP WINDOW 'REGION))
+                                       ELSE
 (FLASHWINDOW T)
+                                            (PRIN3 "Only one file" T)))
+                            (See% left (IF
 FILE1
+                                           THEN
 (TEDIT-SEE FILE1
+                                                       (RELCREATEREGION
+                                                        700 700 'RIGHT 'TOP `(,WINDOW 0.5)
                                                         (IPLUS (FETCH
 (REGION BOTTOM)
                                                                   OF
 (WINDOWPROP WINDOW 'REGION))
                                                                -1)
-                                                        NIL)))
-          (Copy% -> (CDBROWSER-COPY
 CDBROWSER TBITEM 'LEFT))
-          (Copy% <- (CDBROWSER-COPY
 CDBROWSER TBITEM 'RIGHT))
-          (Delete% <- (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT T))
-          (|Delete ALL <-| 
-               (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT NIL))
-          (Delete% -> (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT T))
-          (|Delete ALL ->| 
-               (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT NIL))
-          (SHOULDNT)))
-     (CLOSEWITH CHILDREN WINDOW)
-     (MOVEWITH CHILDREN WINDOW])
+                                                        T)
+                                                       NIL
+                                                       (CONCAT "SEE window for " LABEL1))
+                                         ELSE
 (FLASHWINDOW T)
+                                              (PRIN3 "No file to print" T)))
+                            (See% right (IF
 FILE2
+                                            THEN
 (TEDIT-SEE FILE2
+                                                        (RELCREATEREGION
+                                                         700 700 'LEFT 'TOP `(,WINDOW 0.5)
+                                                         (IPLUS (FETCH
 (REGION BOTTOM)
+                                                                   OF
 (WINDOWPROP WINDOW 'REGION))
+                                                                -1)
+                                                         NIL)
+                                                        NIL
+                                                        (CONCAT "SEE window for " LABEL2))
+                                          ELSE
 (FLASHWINDOW T)
+                                               (PRIN3 "No file to print" T)))
+                            ((See See% both) 
+                                 (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
+                                        (RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
+                                               (IPLUS (FETCH
 (REGION BOTTOM)
+                                                         OF
 (WINDOWPROP WINDOW 'REGION))
+                                                      -1)
+                                               NIL)))
+                            (Copy% -> (CDBROWSER-COPY
 CDBROWSER TBITEM 'LEFT))
+                            (Copy% <- (CDBROWSER-COPY
 CDBROWSER TBITEM 'RIGHT))
+                            (Delete% <- (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT T))
+                            (|Delete ALL <-| 
+                                 (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT NIL))
+                            (Delete% -> (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT T))
+                            (|Delete ALL ->| 
+                                 (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT NIL))
+                            (SHOULDNT)))
+         (CLOSEWITH CHILDREN WINDOW)
+         (MOVEWITH CHILDREN WINDOW])
+
+(CD-COMPARE-FILES

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

+    (PROG NIL
+          (SETQ FILE1 (OR (STREAMP FILE1)
+                          (INFILEP FILE1)))
+          (SETQ FILE2 (OR (STREAMP FILE2)
+                          (INFILEP FILE2)))
+          (CL:UNLESS TYPE
+              (SETQ TYPE (COMPAREDIRECTORIES.INFOS.TYPE
 FILE1))
+              (CL:UNLESS (EQ TYPE (COMPAREDIRECTORIES.INFOS.TYPE
 FILE2))
+                  (FLASHWINDOW T)
+                  (PRIN3 "Can't compare files of different types" T)
+                  (RETURN)))
+          (RETURN (SELECTQ TYPE
+                      (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
+                                     (AND PARENTREGION (RELCREATEREGION
+                                                        (FIXR (TIMES 0.75 (FETCH
 (REGION WIDTH)
+                                                                             OF
 PARENTREGION)))
+                                                        200
+                                                        'LEFT
+                                                        'TOP
+                                                        `(,PARENTREGION 0.125)
+                                                        (IPLUS (FETCH
 (REGION BOTTOM) OF
 PARENTREGION
+                                                                      )
+                                                               20)
+                                                        NIL))))
+                      (COMPILED (FLASHWINDOW T)
+                                (PRIN3 "Cannot compare compiled files" T))
+                      ((TEXT TEDIT OTHER) 
+                                          (* ;; 
+
                                       "Works for TEDIT, but doesn't detect image object differences")

+
+                           (LET ((COMPARETEXT.ALLCHUNKS))
+                                (DECLARE
 (SPECVARS COMPARETEXT.ALLCHUNKS))
+                                (COMPARETEXT FILE1 FILE2 'LINE
+                                       (AND PARENTREGION (RELCREATEPOSITION
+                                                          `(,PARENTREGION 0.5)
+                                                          (IPLUS (FETCH
 (REGION BOTTOM) OF
 
+                                                                                         PARENTREGION
+                                                                        )
+                                                                 20)))
+                                       (LIST LABEL1 LABEL2))))
+                      (PROGN (FLASHWINDOW T)
+                             (PRIN3 "Unable to compare, showing both" T)
+                             (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
+                                    (AND PARENTREGION (RELCREATEREGION 1400 700 'LEFT 'TOP
+                                                             `(,PARENTREGION 0.5 -701)
+                                                             (IPLUS (FETCH
 (REGION BOTTOM)
+                                                                       OF
 PARENTREGION)
+                                                                    -1)
+                                                             NIL])
 
 (CDBROWSER-COPY

-  [LAMBDA (CDBROWSER
 TBITEM SOURCE)
                          (* ; "Edited  5-Feb-2022 17:27 by rmk")


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


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


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


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

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

@@ -2011,8 +2024,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                                                   "Target is newer than source.  Really copy? "]
                       (RETURN NIL))
                (CL:WHEN [AND (SETQ SOURCEVER (FILENAMEFIELD SOURCE 'VERSION))
-                             (ILESSP SOURCEVER (FILENAMEFIELD (INFILEP (PACKFILENAME 'VERFSION NIL
-                                                                              'BODY SOURCEFILE))
+                             (ILESSP SOURCEVER (FILENAMEFIELD (INFILEP (PACKFILENAME.STRING
+                                                                        'VERSION NIL 'BODY SOURCEFILE
+                                                                        ))
                                                       'VERSION))
                              (PROGN (FLASHWINDOW T)
                                     (EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE 
@@ -2022,7 +2036,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                (CLEARW T)
                (CL:UNLESS DESTFILE
                    (SETQ DESTFILE (CD-SWAPDIRS
 SOURCEFILE SOURCEDIR DESTDIR)))
-               (SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME 'VERSION NIL 'BODY DESTFILE)))
+               (SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL 'BODY DESTFILE)))
                (PRIN3 (IF
 RESULT
                           THEN
 (TB.DELETE.ITEM CDBROWSER TBITEM)
                                (CONCAT "Copied to " RESULT)
@@ -2032,7 +2046,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                (RETURN RESULT)))])
 
 (CDBROWSER-DELETE-FILE

-  [LAMBDA (CDBROWSER
 TBITEM SIDE ONLYONE SAVE)
               (* ; "Edited  5-Feb-2022 17:46 by rmk")


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


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


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


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

 
@@ -2052,10 +2067,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
              (CL:WHEN (EQ SIDE 'RIGHT)
                     (SWAP
 FILE OTHERFILE))
              (CL:WHEN FILE
-                 (FOR
 F INSIDE
 (IF
 (FILENAMEFIELD FILE 'VERSION)
+                 (FOR
 F INSIDE
 (IF
 (FILENAMEFIELD.STRING FILE 'VERSION)
                                    THEN
 [IF
 ONLYONE
                                             THEN
 FILE
-                                          ELSE
 (DREVERSE (FILDIR (PACKFILENAME 'VERSION '*
+                                          ELSE
 (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*"
                                                                         'BODY FILE]
                                  ELSE
 FILE)
                     COLLECT
 
@@ -2063,11 +2078,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
                           (* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist.  This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).")

 
                           (IF
 SAVE
-                              THEN
 (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY
-                                                                   (CONCAT "deleted>"
-                                                                          (FILENAMEFIELD F
+                              THEN
 (CL:UNLESS (RENAMEFILE F (PACKFILENAME.STRING
+                                                             'DIRECTORY
+                                                             (CONCAT "deleted>" (FILENAMEFIELD.STRING
+                                                                                 F
                                                                                  'DIRECTORY))
-                                                                   'BODY F))
+                                                             'BODY F))
                                           (ERROR "Could not delete " F))
                             ELSE
 (DELFILE FILE))
                           F FINALLY
 
@@ -2102,24 +2118,25 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
 (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
  2018 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2610 22171 (COMPAREDIRECTORIES 2620 . 7847) (COMPAREDIRECTORIES.INFOS 7849 . 10611) (
-COMPAREDIRECTORIES.CANDIDATES 10613 . 13998) (CDENTRIES.SELECT 14000 . 18775) (
-COMPAREDIRECTORIES.INFOS.TYPE 18777 . 19405) (MATCHNAME 19407 . 20087) (CD.INSURECDVALUE 20089 . 21703
-) (CD.UPDATEWIDTHS 21705 . 22169)) (22172 31711 (CDFILES 22182 . 27805) (CDFILES.MATCH 27807 . 29432) 
-(CDFILES.PATS 29434 . 31709)) (31712 46797 (CDPRINT 31722 . 34067) (CDPRINT.HEADER 34069 . 34966) (
-CDPRINT.LINE 34968 . 37524) (CDPRINT.MAXWIDTHS 37526 . 41641) (CDPRINT.COLHEADERS 41643 . 42281) (
-CDPRINT.COLUMNS 42283 . 46162) (CDTEDIT 46164 . 46795)) (46798 55167 (CDMAP 46808 . 48240) (CDENTRY 
-48242 . 48551) (CDSUBSET 48553 . 49992) (CDMERGE 49994 . 53848) (CDMERGE.COMMON 53850 . 55165)) (55168
- 62706 (BINCOMP 55178 . 59467) (EOLTYPE 59469 . 62031) (EOLTYPE.SHOW 62033 . 62704)) (63234 76441 (
-FIND-UNCOMPILED-FILES 63244 . 66887) (FIND-UNSOURCED-FILES 66889 . 69698) (FIND-SOURCE-FILES 69700 . 
-71404) (FIND-COMPILED-FILES 71406 . 73484) (FIND-UNLOADED-FILES 73486 . 74230) (FIND-LOADED-FILES 
-74232 . 74786) (FIND-MULTICOMPILED-FILES 74788 . 76439)) (76442 84644 (CREATED-AS 76452 . 81249) (
-SOURCE-FOR-COMPILED-P 81251 . 83949) (COMPILE-SOURCE-DATE-DIFF 83951 . 84642)) (84645 94951 (
-FIX-DIRECTORY-DATES 84655 . 87648) (FIX-EQUIV-DATES 87650 . 89175) (COPY-COMPARED-FILES 89177 . 90998)
- (COPY-MISSING-FILES 91000 . 93157) (COMPILED-ON-SAME-SOURCE 93159 . 94949)) (95145 102491 (CDBROWSER 
-95155 . 99082) (CDBROWSER.STRINGS 99084 . 102489)) (102653 104389 (CD.TABLEITEM 102663 . 102883) (
-CD.TABLEITEM.PRINTFN 102885 . 103084) (CD.TABLEITEM.COPYFN 103086 . 104144) (
-CDTABLEBROWSER.HEADING.REPAINTFN 104146 . 104387)) (104390 123251 (CDTABLEBROWSER.WHENSELECTEDFN 
-104400 . 104868) (CD.COMMANDSELECTEDFN 104870 . 109971) (CD-MENUFN 109973 . 116336) (CDBROWSER-COPY 
-116338 . 119709) (CDBROWSER-DELETE-FILE 119711 . 122730) (CD-SWAPDIRS 122732 . 123249)))))
+  (FILEMAP (NIL (2640 22197 (COMPAREDIRECTORIES 2650 . 7483) (COMPAREDIRECTORIES.INFOS 7485 . 10359) (
+COMPAREDIRECTORIES.CANDIDATES 10361 . 13746) (CDENTRIES.SELECT 13748 . 18523) (
+COMPAREDIRECTORIES.INFOS.TYPE 18525 . 19431) (MATCHNAME 19433 . 20113) (CD.INSURECDVALUE 20115 . 21729
+) (CD.UPDATEWIDTHS 21731 . 22195)) (22198 31867 (CDFILES 22208 . 27961) (CDFILES.MATCH 27963 . 29588) 
+(CDFILES.PATS 29590 . 31865)) (31868 46953 (CDPRINT 31878 . 34223) (CDPRINT.HEADER 34225 . 35122) (
+CDPRINT.LINE 35124 . 37680) (CDPRINT.MAXWIDTHS 37682 . 41797) (CDPRINT.COLHEADERS 41799 . 42437) (
+CDPRINT.COLUMNS 42439 . 46318) (CDTEDIT 46320 . 46951)) (46954 55323 (CDMAP 46964 . 48396) (CDENTRY 
+48398 . 48707) (CDSUBSET 48709 . 50148) (CDMERGE 50150 . 54004) (CDMERGE.COMMON 54006 . 55321)) (55324
+ 62862 (BINCOMP 55334 . 59623) (EOLTYPE 59625 . 62187) (EOLTYPE.SHOW 62189 . 62860)) (63390 75917 (
+FIND-UNCOMPILED-FILES 63400 . 67043) (FIND-UNSOURCED-FILES 67045 . 69429) (FIND-SOURCE-FILES 69431 . 
+71169) (FIND-COMPILED-FILES 71171 . 73048) (FIND-UNLOADED-FILES 73050 . 73903) (FIND-LOADED-FILES 
+73905 . 74333) (FIND-MULTICOMPILED-FILES 74335 . 75915)) (75918 84349 (CREATED-AS 75928 . 80725) (
+SOURCE-FOR-COMPILED-P 80727 . 83654) (COMPILE-SOURCE-DATE-DIFF 83656 . 84347)) (84350 94656 (
+FIX-DIRECTORY-DATES 84360 . 87353) (FIX-EQUIV-DATES 87355 . 88880) (COPY-COMPARED-FILES 88882 . 90703)
+ (COPY-MISSING-FILES 90705 . 92862) (COMPILED-ON-SAME-SOURCE 92864 . 94654)) (94850 102196 (CDBROWSER 
+94860 . 98787) (CDBROWSER.STRINGS 98789 . 102194)) (102358 104094 (CD.TABLEITEM 102368 . 102588) (
+CD.TABLEITEM.PRINTFN 102590 . 102789) (CD.TABLEITEM.COPYFN 102791 . 103849) (
+CDTABLEBROWSER.HEADING.REPAINTFN 103851 . 104092)) (104095 124750 (CDTABLEBROWSER.WHENSELECTEDFN 
+104105 . 104573) (CD.COMMANDSELECTEDFN 104575 . 109676) (CD-MENUFN 109678 . 113989) (CD-COMPARE-FILES 
+113991 . 117343) (CDBROWSER-COPY 117345 . 121014) (CDBROWSER-DELETE-FILE 121016 . 124229) (CD-SWAPDIRS
+ 124231 . 124748)))))
 STOP

lispusers/COMPARESOURCES

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Feb-2022 18:02:24" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;121
 41359  
+
(FILECREATED "22-May-2022 18:46:01" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPARESOURCES.;128
 39655  
 
-      :CHANGES-TO (FNS \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.REC.NAME \CS.ISRECFORM)
-                  (VARS COMPARESOURCETYPES COMPARESOURCESCOMS)
+      :CHANGES-TO (FNS COMPARESOURCES CSBROWSER \CS.EXAMINE)
+                  (VARS COMPARESOURCESCOMS)
 
-      :PREVIOUS-DATE "28-Jan-2022 18:22:40" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118)
+      :PREVIOUS-DATE "12-May-2022 10:17:13" 
+{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPARESOURCES.;123)
 
 
 (* ; "
@@ -30,7 +30,6 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
                                                         'CSOBJ.COPYBUTTONEVENTINFN]
         (VARS COMPARESOURCETYPES DEFAULT.DECLARE.TAGS)
         (COMS (FNS CSBROWSER)
-              (INITVARS (COMPARESOURCES-BROWSER-TYPE 'OBJECTWINDOW))
               (FILES (SYSLOAD)
                      OBJECTWINDOW EXAMINEDEFS REGIONMANAGER))
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CSTYPE)
@@ -38,18 +37,15 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
 (DEFINEQ
 
 (COMPARESOURCES

-  [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM)
               (* ; "Edited 28-Jan-2022 17:10 by rmk")


-                                                             (* ; "Edited 26-Dec-2021 21:32 by rmk")


-                                                            (* ; "Edited 19-Apr-2018 10:49 by rmk:")

+  [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM IGNORECOMMENTS LABELX LABELY)

+                                                             (* ; "Edited 22-May-2022 18:45 by rmk")

 
-(* ;;; "Compare two lisp source files, reporting differences.  LISTSTREAM if given is an open stream")

+(* ;;; "Compare two lisp source files, reporting differences.  LISTSTREAM if given is an open stream, or an object window")

 
     (DECLARE
 (SPECVARS FILEX FILEY EXAMINE DIFFERENCES))
-    (PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY DATECOL
-                 [INSERTOBJECTS (AND EXAMINE (IF
 (TEXTSTREAMP LISTSTREAM)
-                                                 THEN
 'TEDIT
-                                               ELSEIF
 (OBJWINDOWP LISTSTREAM)
-                                                 THEN
 'OBJECTWINDOW]
+    (PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY DATECOL (INSERTOBJECTS
+                                                                        (AND EXAMINE (OBJWINDOWP
+                                                                                      LISTSTREAM)))
                  (COMPARESTREAM LISTSTREAM)
                  (CONTEXTSTREAM LISTSTREAM)
                  OBJECTS)
@@ -59,10 +55,12 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
               (SETQ CONTEXTSTREAM (CL:MAKE-STRING-OUTPUT-STREAM))
               (LINELENGTH 65535 COMPARESTREAM)               (* ; "Let the receiver do the wrapping")

               (LINELENGTH 65535 CONTEXTSTREAM))
-          (OR (INFILEP FILEX)
+          (OR (STREAMP FILEX)
+              (INFILEP FILEX)
               (SETQ FILEX (FINDFILE FILEX T))
               (RETURN (printout CONTEXTSTREAM FILEX " not found" T)))
-          (OR (INFILEP FILEY)
+          (OR (STREAMP FILEY)
+              (INFILEP FILEY)
               (SETQ FILEY (FINDFILE FILEY T))
               (RETURN (printout CONTEXTSTREAM FILEY " not found" T)))
 
@@ -74,15 +72,23 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
           (CL:MULTIPLE-VALUE-SETQ (BODYY ENVY)
                  (READFILE FILEY))
           (SETQ BODYY (\CS.FILTER.GARBAGE
 BODYY))
+          (CL:WHEN IGNORECOMMENTS
+              (LET ((*REMOVE-INTERLISP-COMMENTS* T))
+                   (DECLARE
 (SPECVARS *REMOVE-INTERLISP-COMMENTS*))
+                   (SETQ BODYX (REMOVE-COMMENTS BODYX))
+                   (SETQ BODYY (REMOVE-COMMENTS BODYY))))
+          (CL:UNLESS LABELX (SETQ LABELX FILEX))
+          (CL:UNLESS LABELY (SETQ LABELY FILEY))
           [SETQ DATECOL (PLUS 2 (CONSTANT (NCHARS "Comparing"))
-                              (IMAX (NCHARS FILEX)
-                                    (NCHARS FILEY]
-          (printout CONTEXTSTREAM "Comparing " FILEX .TAB0 DATECOL "dated " (GETFILEINFO FILEX
-                                                                                   'CREATIONDATE)
+                              (IMAX (NCHARS LABELX)
+                                    (NCHARS LABELY]
+          (printout CONTEXTSTREAM "Comparing " LABELX .TAB0 DATECOL "dated " (GETFILEINFO
+                                                                              FILEX
+                                                                              'CREATIONDATE)
                  .TAB
                  [SUB1 (CONSTANT (IDIFFERENCE (NCHARS "Comparing ")
                                         (NCHARS "and "]
-                 " and " FILEY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE)
+                 " and " LABELY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE)
                  T T)
           [SETQ DECLAREX (for
 EXPR in
 BODYX collect
 EXPR when
 (EQ (CAR EXPR)
                                                                   'DECLARE%:]
@@ -126,15 +132,11 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
                                (REVERSE Y)
                                DW?]
               (TERPRI CONTEXTSTREAM))
-          (SELECTQ INSERTOBJECTS
-              (OBJECTWINDOW (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
-                                (PUSH
 OBJECTS (CSOBJ.CREATE
 (CL:GET-OUTPUT-STREAM-STRING 
-                                                                   CONTEXTSTREAM))))
-                            (SETQ OBJECTS (DREVERSE OBJECTS))
-                            (OBJ.ADDMANYTOW LISTSTREAM OBJECTS))
-              (TEDIT (HELP "Don't know about TEDIT"))
-              (NIL)
-              (HELP))
+          (CL:WHEN INSERTOBJECTS
+              (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
+                  (PUSH
 OBJECTS (CSOBJ.CREATE
 (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))))
+              (SETQ OBJECTS (DREVERSE OBJECTS))
+              (OBJ.ADDMANYTOW LISTSTREAM OBJECTS))
           (RETURN (OR (REVERSE DIFFERENCES)
                       'SAME])
 
@@ -299,13 +301,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
              RESULT)])
 
 (\CS.EXAMINE

-  [LAMBDA (X Y ONLYONE NAME TYPE)                            (* ; "Edited 24-Dec-2021 22:48 by rmk")

-                                                             (* ; "Edited 19-Dec-2021 22:46 by rmk")

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

-                                                             (* ; "Edited  4-Dec-2021 16:43 by rmk")

-                                                             (* ; "Edited  2-Dec-2021 15:23 by rmk:")

-                                                             (* ; "Edited 29-Nov-2021 20:37 by rmk:")

-                                                             (* ; "Edited 27-Nov-2021 11:21 by rmk:")

+  [LAMBDA (X Y ONLYONE NAME TYPE)
                            (* ; "Edited 22-May-2022 16:28 by rmk")


+                                                            (* ; "Edited 27-Nov-2021 11:21 by rmk:")

     (DECLARE
 (USEDFREE EXAMINE INSERTOBJECTS COMPARESTREAM CONTEXTSTREAM OBJECTS))
 
     (* ;; "ONLYONE as a flag, because we don't want to test X or Y for NIL, that could be the contrasting value.")

@@ -319,34 +316,30 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
     (* ;; "Context gets printed to the CONTEXTSTREAM, diffs go to the COMPARESTREAM. If we aren't doing objects, those are the same streams, and the output gets printed in the right order.  Nothing to do here.")

 
     (IF
 INSERTOBJECTS
-        THEN
 (SELECTQ INSERTOBJECTS
-                 (OBJECTWINDOW [LET (STRING)
+        THEN
 [LET (STRING)
 
-                                    (* ;; "Take out last EOL, let SEPDIST space things out.")

+                  (* ;; "Take out last EOL, let SEPDIST space things out.")

 
-                                    (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
-                                        (SETQ STRING (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))
-                                        (CL:WHEN (EQ (CHARCODE EOL)
-                                                     (NTHCHARCODE STRING -1))
-                                            (SETQ STRING (OR (SUBSTRING STRING 1 -2)
-                                                             "")))
-                                        (PUSH
 OBJECTS (CSOBJ.CREATE
 STRING)))
-                                    (CL:UNLESS (EQ 0 (GETFILEPTR COMPARESTREAM))
-                                        (SETQ STRING (CL:GET-OUTPUT-STREAM-STRING COMPARESTREAM))
+                  (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
+                      (SETQ STRING (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))
+                      (CL:WHEN (EQ (CHARCODE EOL)
+                                   (NTHCHARCODE STRING -1))
+                          (SETQ STRING (OR (SUBSTRING STRING 1 -2)
+                                           "")))
+                      (PUSH
 OBJECTS (CSOBJ.CREATE
 STRING)))
+                  (CL:UNLESS (EQ 0 (GETFILEPTR COMPARESTREAM))
+                      (SETQ STRING (CL:GET-OUTPUT-STREAM-STRING COMPARESTREAM))
 
-                                 (* ;; "Don't know why, but SEPTDIST doesn't work if there if there isn't at least one EOL. Magically, this gets the right appearance and behavior.")

+                      (* ;; "Don't know why, but SEPTDIST doesn't work if there if there isn't at least one EOL. Magically, this gets the right appearance and behavior.")

 
-                                        (CL:WHEN (AND (EQ (CHARCODE EOL)
-                                                          (NTHCHARCODE STRING -1))
-                                                      (EQ (CHARCODE EOL)
-                                                          (NTHCHARCODE STRING -2)))
-                                            (SETQ STRING (OR (SUBSTRING STRING 1 -2)
-                                                             "")))
-                                        (PUSH
 OBJECTS (CSOBJ.CREATE
 STRING
-                                                             (LIST NAME TYPE X Y LABEL1 LABEL2)
-                                                             ONLYONE)))])
-                 (TEDIT (HELP "TEDIT NOT IMPLEMENTED"))
-                 NIL)
+                      (CL:WHEN (AND (EQ (CHARCODE EOL)
+                                        (NTHCHARCODE STRING -1))
+                                    (EQ (CHARCODE EOL)
+                                        (NTHCHARCODE STRING -2)))
+                          (SETQ STRING (OR (SUBSTRING STRING 1 -2)
+                                           "")))
+                      (PUSH
 OBJECTS (CSOBJ.CREATE
 STRING (LIST NAME TYPE X Y LABEL1 LABEL2)
+                                           ONLYONE)))]
       ELSEIF
 (OR (LISTP X)
                  (LISTP Y))
         THEN
                                                 (* ; 
@@ -629,7 +622,11 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
 (DEFINEQ
 
 (CSBROWSER

-  [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION)
+  [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION IGNORECOMMENTS TITLE)
+
+    (* ;; "Edited 22-May-2022 18:42 by rmk")

+
+    (* ;; "Edited 12-May-2022 10:16 by rmk")

 
     (* ;; "Edited 24-Jan-2022 23:11 by rmk: EXAMINE is non-NIL, we run the compare twice.  Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.")

 
@@ -640,44 +637,33 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
     (* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers.  If the file can be found that way, then lower functions will find it.")

 
     (DECLARE
 (SPECVARS LABEL1 LABEL2))
-    (OR (INFILEP FILEX)
-        (SETQ FILEX (FINDFILE FILEX NIL DIRECTORIES))
-        (ERROR "FILE NOT FOUND" FILEX))
-    (OR (INFILEP FILEY)
-        (SETQ FILEY (FINDFILE FILEY NIL DIRECTORIES))
-        (ERROR "FILE NOT FOUND" FILEY))
+    (SETQ FILEX (OR (STREAMP FILEX)
+                    (INFILEP FILEX)
+                    (FINDFILE FILEX NIL DIRECTORIES)
+                    (ERROR "FILE NOT FOUND" FILEX)))
+    (SETQ FILEY (OR (STREAMP FILEY)
+                    (INFILEP FILEY)
+                    (FINDFILE FILEY NIL DIRECTORIES)
+                    (ERROR "FILE NOT FOUND" FILEY)))
     (CL:UNLESS (LISPSOURCEFILEP FILEX)
            (ERROR FILEX " is not a Medley source file"))
     (CL:UNLESS (LISPSOURCEFILEP FILEY)
            (ERROR FILEX " is not a Medley source file"))
-    (LET [(TITLE (CONCAT "COMPARESOURCES of " (OR LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
-                                                                'BODY FILEX))
-                        " and "
-                        (OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY]
-         (SELECTQ COMPARESOURCES-BROWSER-TYPE
-             (OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T
-                                                (FONTPROP DEFAULTFONT 'HEIGHT]
-                                (WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
-                                (GETPROMPTWINDOW WINDOW T)
-                                (WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
-                                (COMPARESOURCES
 FILEX FILEY '(T 2WINDOWS)
-                                       DW? WINDOW)
-                                (OPENW WINDOW)
-                                WINDOW))
-             (TEDIT (LET ((TSTREAM (OPENTEXTSTREAM)))
-                         (DSPFONT DEFAULTFONT TSTREAM)
-                         (COMPARESOURCES
 FILEX FILEY EXAMINE DW? TSTREAM)
-                         [TEDIT TSTREAM REGION NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT TITLE
-                                                           ,TITLE]
-                         (CL:WHEN NIL
-                             EXAMINE
-                             (COMPARESOURCES
 FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} 'OUTPUT)))
-                         (WFROMDS TSTREAM)))
-             (HELP])
+    (CL:UNLESS TITLE
+        [SETQ TITLE (CONCAT "COMPARESOURCES of " (OR LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
+                                                                   'BODY FILEX))
+                           " and "
+                           (OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY])
+    (LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T (FONTPROP DEFAULTFONT 'HEIGHT]
+         (WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
+         (GETPROMPTWINDOW WINDOW T)
+         (WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
+         (COMPARESOURCES
 FILEX FILEY '(T 2WINDOWS)
+                DW? WINDOW IGNORECOMMENTS LABEL1 LABEL2)
+         (OPENW WINDOW)
+         WINDOW])
 )
 
-(RPAQ? COMPARESOURCES-BROWSER-TYPE
 'OBJECTWINDOW)
-
 (FILESLOAD (SYSLOAD)
        OBJECTWINDOW EXAMINEDEFS REGIONMANAGER)
 (DECLARE%: EVAL@COMPILE DONTCOPY 
@@ -693,16 +679,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
 )
 (PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1970 26690 (COMPARESOURCES 1980 . 8026) (\CS.COMPARE.MASTERS 8028 . 15440) (
-\CS.COMPARE.TYPES 15442 . 18708) (\CS.EXAMINE 18710 . 22937) (\CS.FIXFNS 22939 . 24441) (
-\CS.SORT.DECLARES 24443 . 24786) (\CS.SORT.DECLARE1 24788 . 26208) (\CS.FILTER.GARBAGE 26210 . 26688))
- (26691 31227 (\CS.ISFNFORM 26701 . 26969) (\CS.COMPARE.FNS 26971 . 27213) (\CS.FNSID 27215 . 27359) (
-\CS.ISVARFORM 27361 . 27466) (\CS.COMPARE.VARS 27468 . 28130) (\CS.ISMACROFORM 28132 . 28270) (
-\CS.ISRECFORM 28272 . 28600) (\CS.REC.NAME 28602 . 28921) (\CS.ISCOURIERFORM 28923 . 29023) (
-\CS.ISTEMPLATEFORM 29025 . 29123) (\CS.COMPARE.TEMPLATES 29125 . 29490) (\CS.ISPROPFORM 29492 . 29647)
- (\CS.PROP.NAME 29649 . 29794) (\CS.COMPARE.PROPS 29796 . 29953) (\CS.ISADDVARFORM 29955 . 30048) (
-\CS.COMPARE.ADDVARS 30050 . 30215) (\CS.ISFPKGCOMFORM 30217 . 30424) (\CS.COMPARE.FPKGCOMS 30426 . 
-30633) (\CS.COMPARE.DEFINE-FILE-INFO 30635 . 31225)) (31228 37292 (CSOBJ.CREATE 31238 . 31651) (
-CSOBJ.DISPLAYFN 31653 . 32406) (CSOBJ.IMAGEBOXFN 32408 . 34569) (CSOBJ.BUTTONEVENTINFN 34571 . 37042) 
-(CSOBJ.COPYBUTTONEVENTINFN 37044 . 37290)) (38173 40877 (CSBROWSER 38183 . 40875)))))
+  (FILEMAP (NIL (1864 25616 (COMPARESOURCES 1874 . 8001) (\CS.COMPARE.MASTERS 8003 . 15415) (
+\CS.COMPARE.TYPES 15417 . 18683) (\CS.EXAMINE 18685 . 21863) (\CS.FIXFNS 21865 . 23367) (
+\CS.SORT.DECLARES 23369 . 23712) (\CS.SORT.DECLARE1 23714 . 25134) (\CS.FILTER.GARBAGE 25136 . 25614))
+ (25617 30153 (\CS.ISFNFORM 25627 . 25895) (\CS.COMPARE.FNS 25897 . 26139) (\CS.FNSID 26141 . 26285) (
+\CS.ISVARFORM 26287 . 26392) (\CS.COMPARE.VARS 26394 . 27056) (\CS.ISMACROFORM 27058 . 27196) (
+\CS.ISRECFORM 27198 . 27526) (\CS.REC.NAME 27528 . 27847) (\CS.ISCOURIERFORM 27849 . 27949) (
+\CS.ISTEMPLATEFORM 27951 . 28049) (\CS.COMPARE.TEMPLATES 28051 . 28416) (\CS.ISPROPFORM 28418 . 28573)
+ (\CS.PROP.NAME 28575 . 28720) (\CS.COMPARE.PROPS 28722 . 28879) (\CS.ISADDVARFORM 28881 . 28974) (
+\CS.COMPARE.ADDVARS 28976 . 29141) (\CS.ISFPKGCOMFORM 29143 . 29350) (\CS.COMPARE.FPKGCOMS 29352 . 
+29559) (\CS.COMPARE.DEFINE-FILE-INFO 29561 . 30151)) (30154 36218 (CSOBJ.CREATE 30164 . 30577) (
+CSOBJ.DISPLAYFN 30579 . 31332) (CSOBJ.IMAGEBOXFN 31334 . 33495) (CSOBJ.BUTTONEVENTINFN 33497 . 35968) 
+(CSOBJ.COPYBUTTONEVENTINFN 35970 . 36216)) (37099 39228 (CSBROWSER 37109 . 39226)))))
 STOP

lispusers/GITFNS.TEDIT

@@ -3,50 +3,92 @@ Medley	GITFNS2
 4
 
 1
-
+
 GITFNS
 1
-
-4
-
-By Ron Kaplan
-This document was created in January  2022.
-
+
+4
+
+By Ron Kaplan
+This document was last edited in May  2022.
+
+GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository.  This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file.  This may be particularly helpful in evaluating the changes in a pull request.
+Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions.  GITFNS allows for intelligent comparisons between Lisp source files,Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
+
+Git projects:  Connecting git clones to GITFNS capabilities 
+The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk.  The path to a clone can be used to create a "git project" for  that clone:
+(GIT-MAKE-PROJECT PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS 
+                  DEFAULTSUBDIRS)     [function]
+where
+	PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...) 
+  PROJECTPATH is the local path to the clone
+            (e.g. {dsk}<users>...>git-medley)
+  WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}<users>...>working-medley>)
+When the project has a WORKINGPATH:
+  EXCLUSIONS is a list of files and directories to be excluded from comparisons (beyond what its .GITIGNORE specifies)
+  DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified.
+
+For convenience, if PROJECTPATH is NIL or T (and not a path), then a squence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
+    (UNIX-GETENV PROJECTNAME)
+    (UNIX-GETENV (CONCAT PROJECTNAME 'DIR)
+    (CONCAT MEDLEYDIR "../git-" PROJECTNAME)  
+        (a sister of MEDLEYDIR named git-PROJECTNAME, e.g. git-notecards)
+Thus:
+If MEDLEYDIR is defined,
+   (GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY  project
+If NOTECARDS is defined
+   (GIT-MAKE-PROJECT 'NOTECARDS) will make the NOTECARDS project
+If NOTECARDS is not defined but the clone >git-notecards> is a sister of MEDLEYDIR, then the NOTECARDS project will still be created.
+If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME.  Otherwise,  NIL will be returned if PROJECTPATH is T (= no-error), and PROJECTPATH=NIL will result in an error.
+
+When GITFNS is loaded, GIT-MAKE-PROJECT is called for MEDLEY, NOTECARDS, and LOOPS, with PROJECTPATH=T. Thus, those projects will be created automatically, if MEDLEYDIR is defined and the relevant directories exist in their expected relative positions.
+When they are created, GIT-PROJECTS are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
+The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional projectname argument is not provided.
+GIT-MAKE-PROJECT also creates a pseudohost {Gprojectname} whose path prefix is the prefix for the project's clone.  If WORKINGPATH is provided, then a second pseudohost {Wprojectname} points to the working files for the project.
+GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
 cdg (projectname) (subdir)    [command]
 cdw (projectname) (subdir)    [command
-
+For example, cdg notecards library  connects to {GNOTECARDS}/library/.
+
+Comparing directories and files in different git branches
 In its simplest application, GITFNS is just an off-to-the-side add-on to whatever work practices the user has developed with respect to a locally installed git project.  Its only advantage is to allow for more interpretable git-branch comparisons, especially for pull-request approval. These comparisons are provided by the prc ("pull request compare") Medley executive command:
 prc  (branch)   (DRAFT)  (projectname)   [command]
-The main use-case is the Lisp-oriented file comparisons for pull-request approval.  These comparisons are provided by the prc ("pull request compare") Medley executive command:
+This compares the files in branch against the files in the main branch of the project (origin/master or origin/main).  Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project.  Then
     prc rmk15 
 brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser.
-    prc rmk15
+If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided.  If gh is not available, the menu will offer all known branches.  If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones.
+If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by
      rmk15 > rmk14
 Note that the prc comparison is  read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
-Note that the comparison that this provides is essentially read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
-
+
+prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
+bbc  branch1   branch2  (project)     [command]
 This compares the files in branch1 and branch2, for example
      bbc rmk15 lmm12   (local)
 This will compare the files in origin/rmk15 and origin/lmm12 in the GIT-DEFAULT project.  branch1 defaults to the origin files of the currently checked out branch, the second defaults to origin/master.  If local is non-NIL, then a branch that has neither local/ or origin/ prepended will default to local (e.g. local/rmk15) instead of origin/.  Local refers to the files that are currently in the clone directory, which may not be the same as the origin files, depending on the push/pull status.  
-     bbc rmk15 lmm12   (local)
+Either of the branches can be specified with an atom LOCAL, REMOTE, or ORIGIN, in which case bbc will offer menus listing the currently existing branches of that type.
 
 The command cob ("check out branch") checks out a specified branch:
-The command cob ("check out branch") checks out a specified branch:
-cob  branch        [command]
-This checks out branch and then executes git pull.  The branch parameter may also be a local branch, T (= my current branch), or NEW/NEXT (= my next branch).  My current branch is a the branch named <initials>nnn, e.g. rmk15.  The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials. If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch.  Its number  is one greater than the largest number of previous initialed branches.
-If branch is not provided, a menu of locally available branches pops up.
-
-The currently checked out branch is obtained by the b? command:
-b?      [command]
-
+cob  branch  (nexttitlestring) (project)      [command]
+This checks out branch of project and then executes git pull.  The branch parameter may also be a local branch, T (= the current working branch), or NEW/NEXT (= the next working branch).  The current working branch is the branch named <initials>nnn, e.g. rmk15.  The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials.
+If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch.  Its number  is one greater than the largest number of previous initialed branches. If nexttitlestring is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens.  Spaces in nexttitlestring will also be replaced by hyphens, according to git conventions.
+If branch is not provided, a menu of locally available branches pops up.
+
+The currently checked out branch is obtained by the b? command:
+b?  (project)    [command]
+
+Correlating git source control with separate Medley development
+It is generally unsafe to do Medley development by operating with files in a local clone repository.  Medley provides a residential development environment that integrates tightly with the local file system.  It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from.  This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes.
 GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory.  The location of the Medley development source tree for a project is given by the WORKINGPATH argument to GIT-MAKE-PROJECT.  If WORKINGPATH is T or NIL and there exists a directory >working-projectname> as a sister to the clone, then that is taken to be the WORKINGPATH and thus the prefix for a pseudohost {Wprojectname}.
-It is generally unsafe to do Medley development by operating with files in the local clone repository.  Medley provides a residential development environment that integrates tightly with the local file system.  It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from.  This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes.
+When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR (or {WMEDLEY}) as a prefix.  In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR.
+Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions.  Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention.
 The files in Medley working tree and the git clone of a project can be compared with the gwc ("git-working-compare") command:
 gwc  subdirectories (project)       [command]
 This produces a browser for all the files in the corresponding WORKINGPATH  subdirectories that differ from the files in the currently checked out branch of the git clone.  If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
-gmc  subdirectories       [command]
-This produces a browser for all the files in the corresponding  Medley subdirectories that differ from the files in the currently checked out branch of the git clone.  If subdirectories is omitted, it defaults to sources library lispusers. If it is ALL, then files in all My Medley subdirectories are examined.
-In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {GIT} to My Medley and deleting files from {MM}. If the master branch is current, then the menu has no commands to change the files in the clone. The browser will show those files that have been updated from a recent merge, and they can individually be copied to new My Medley versions in order to realign the two source trees.  If the comparison is with a different branch, say the user's current staging branch, copying files from My Medley to git or deleting git files will set git up for future commits.  
-Note that the menu item for deleting My Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for My Medley files is also accomplished by renaming to a {MM}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
-GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
-(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))4
È


È
4
È


È
.
È.ŠŠ
8.ŠŠ
8J
È

È
PAGEHEADINGRUNNINGHEADMODERN
+In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}. 
+If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers.  If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.  
+Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
+GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
+(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))
+.
È
4
È


È
4
È



È
4
È



È
4
È



È
4
È




È
4
È



È
4
È


È
4
È


È
.
È.ŠŠ
8.ŠŠ
8J
È

È
PAGEHEADINGRUNNINGHEADTERMINAL
+MODERN

lispusers/MODERNIZE.TXT

@@ -1,78 +0,0 @@
-MODERNIZE documentation
- 
-            Ron Kaplan, February 2021
-            
-[A renaming of an earlier MACINTERFACE package]
-
-MODERNIZE is a simple Lispusers package that changes the mouse actions on Medley windows so that moving and shaping can be done in a way that approximates the behavior of windows on modern platforms, Mac, Windows, etc.  It also adds some meta keys to also emulate more conventional behavior.
-
-Thus, for a window that has been created or transformed in this way, you can move the window by left-clicking in the title bar and dragging the window's ghost region.  Or you can reshape by clicking in a corner of the title bar or near the bottom of the window to drag out the ghost region by that corner.  
-
-The menu behavior for other buttons or buttons clicked in other positions is unchanged.
-
-
-For bottom corners, "near" means inside the window within MODERN-WINDOW-MARGIN (initially 25) pixels above or to the left/right of the corner.
-
-For top corners, "near" means within the title bar and within the margin from the left/right edges.
-
-(Windows that don't have a title-bar, like Snap windows, can be set up so that moving can happen by clicking anywhere, and shaping at the top is determined by the margin inside the window region.)
-
-When the package is loaded, this behavior is installed for the following kinds of windows:
-
-	Tedit
-	Debugger/break
-	Sedit
-	Inspector
-	Snap
-	Exec
-	File Browser
-	Grapher
-
-The function MODERNWINDOW.SETUP establishes the new behavior for classes of windows:
-
-(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).
-
-MODERNWINDOW.SETUP moves the definition of ORIGFN to the name (PACK* 'MODERN-ORIG- ORIGFN), and then provides a new definition for ORIGFN that does the moving or reshaping for clicks in the triggering locations, and otherwise passes control through to the original definition.
-
-If ORIGNFN is a button event function, then MODERNWINDOWFN should not be specified.  In that case a new definition for ORIGFN is constructed to provide the desired windowing behavior.
-
-Otherwise, if ORIGFN is the function that creates windows of a class (e.g. SNAPW), then a MODERNWINDOWFN should be provided to create such windows (by calling (PACK* MODERN-ORIG- ORIGFN)). The definition of MODERNWINDOWFN replaces the original definition of ORIGFN.
-
-If the flag ANYWHERE is non-NIL, especially for windows without a title bar, then the moving behavior is triggered by a click anywhere in the window (except the corners).
-
-Because this works by redefining existing functions, it is important that the MODERNIZE package be loaded AFTER Tedit and Sedit, if those are not already in the sysout.  And it should be called to upgrade the proper functions for other window classes that might later be added.
-
-Provided these capabilities are already loaded, the following window classes are "modernized" when MODERNIZE is loaded are:
-
-	TEDIT
-	SEDIT
-	INSPECTOR
-	SNAP
-	DEBUGGER
-	EXEC
-	TABLEBROWSER
-	FILEBROWSER
-	FREEMENU
-	GRAPHER
-	PROMPTWINDOW
-
-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 TITLEPROPORTION)
-
-This saves the windows existing BUTTONEVENTFN as a window property PREMODERN-BUTTONEVENTFN, and installs a simple stub function in its place.
-
-If things go awry:
-
-(UNMODERN.SETUP ORIGFN) is provided to restore the original behavior for windows whose buttonevent function is ORIGIN.
-
-(UNMODERNWINDOW WINDOW) restores a modernized window (via MACWINDOW) to its original state.
-
-Known issues:  
-
-Clicking at the bottom of an EXEC window running TTYIN is effective only when the input line is empty.
-
-
-

lispusers/PRETTYFILEINDEX

@@ -1,10 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-Nov-2021 22:12:37" {DSK}<home>larry>medley>lispusers>PRETTYFILEINDEX.;2
 94399  
+
(FILECREATED " 5-May-2022 23:33:03" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PRETTYFILEINDEX.;10
 96446  
 
-      :CHANGES-TO (FNS PFI.PRINT.FILECREATED)
+      :CHANGES-TO (FNS PFI.PRINT.COMMENTS PFI.MAYBE.NEW.PAGE PFI.MAYBE.PP.DEFINITION 
+                       PFI.PRINT.FILECREATED PFI.MAYBE.SEE.PRETTY PRETTYFILEINDEX PFI.PRINT.TO.TAB)
 
-      :PREVIOUS-DATE " 9-Jul-2021 21:55:15" {DSK}<home>larry>medley>lispusers>PRETTYFILEINDEX.;1)
+      :PREVIOUS-DATE "30-Nov-2021 22:12:37" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PRETTYFILEINDEX.;6)
 
 
 (* ; "
@@ -39,7 +42,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
               (FNS MULTIFILEINDEX MULTIFILEINDEX1 PFI.PRINT.MULTI.INDEX PFI.CHOOSE.BEST 
                    PFI.MERGE.INDICES))
         (COMS                                                (* ; 
-
                                                          "Hooks for seeing files pretty elsewhere")

+
                                                            "Hooks for seeing files pretty elsewhere")

               (FNS PFI.MAYBE.SEE.PRETTY PFI.MAYBE.PP.DEFINITION)
               (INITVARS (*PRINT-PRETTY-FROM-FILES* T)))
         (COMS                                                (* ; "Bitmap hack")

@@ -57,7 +60,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                                                          *KEYWORD-PACKAGE*)))
                                          
                                          (* ;; 
-
                                  "Properties of definers changed between Lyric and Medley (yech).")

+
                                    "Properties of definers changed between Lyric and Medley (yech).")

 
                                          (MAPCAR '("DEFINER-FOR" "DEFINED-BY" "DEFINITION-NAME")
                                                 (FUNCTION CL:INTERN]
@@ -102,7 +105,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                       (READVICE ADVICE))
                (*PFI-FILTERS* (VARIABLES . CONSTANTS)))
         (COMS                                                (* ; 
-
                                        "Prettyprint augmentation to mimic system makefile dumping")

+
                                          "Prettyprint augmentation to mimic system makefile dumping")

               (FNS PUTPROPS.PRETTYPRINT RPAQX.PRETTYPRINT COURIERPROGRAM.PRETTYPRINT 
                    MAYBE.PRETTYPRINT.BOLD)
               (ALISTS (PRETTYPRINTMACROS RPAQ RPAQQ RPAQ? ADDTOVAR PUTPROPS COURIERPROGRAM)))
@@ -119,7 +122,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                       MACROPROPS CLISPRECORDTYPES PROMPTWINDOW *PFI-DEFINER-PROPS* 
                       *COMMON-LISP-READ-ENVIRONMENT*))
         [DECLARE%: EVAL@COMPILE DOCOPY                       (* ; 
-
                                                           "Public variables to declare special")

+
                                                             "Public variables to declare special")

                (P (CL:PROCLAIM '(CL:SPECIAL *PFI-TYPES* *PFI-HANDLERS* *PFI-PREVIEWERS* 
                                        *PFI-DONT-SPAWN* *PFI-PROPERTIES* *PFI-FILTERS* 
                                        *PRINT-PRETTY-FROM-FILES* *PRINT-PRETTY-BITMAPS* 
@@ -130,11 +133,11 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                       (FILESLOAD (SYSLOAD)
                              DEFINERPRINT))
                                                              (* ; 
-
                                                 "Get prettyprinter fixes if running in old sysout")

+
                                                   "Get prettyprinter fixes if running in old sysout")

                   (MOVD? [PROG ((SYMS '("OLDLISTFILES1" "LISTFILES1-ORIGINAL"))
                                 S)
                                                              (* ; 
-
       "Look for LISTFILES1.  These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")

+
         "Look for LISTFILES1.  These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")

                                LP
                                (COND [(AND (SETQ S (CL:FIND-SYMBOL (CAR SYMS)))
                                            (GETD S))
@@ -145,8 +148,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                                                          (MOVD 'PFI.MAYBE.SEE.PRETTY S NIL T))))]
                                      ((SETQ SYMS (CDR SYMS))
                                       (GO LP))
-                                     (T                      (* ; 
-
                                                           "Neither one loaded, take original")

+                                     (T                      (* ; "Neither one loaded, take original")

                                         (RETURN 'LISTFILES1]
                          'PFI.ORIGINAL.LISTFILES1 NIL T)
                   (MOVD 'PFI.NEW.LISTFILES1 'LISTFILES1 NIL T)
@@ -182,11 +184,12 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 (DEFINEQ
 
 (PRETTYFILEINDEX

-  [LAMBDA (FILENAME PRINTOPTIONS OUTSTREAM DONTINDEX)
   (* ; "Edited  9-Jul-2021 21:35 by rmk:")


-                                                             (* ; "Edited 11-Apr-95 00:02 by rmk:")

-                                                             (* ; "Edited 11-Jun-92 15:58 by cat")

+  [LAMBDA (FILENAME PRINTOPTIONS OUTSTREAM DONTINDEX)
        (* ; "Edited  5-May-2022 14:38 by rmk")


+                                                            (* ; "Edited  9-Jul-2021 21:35 by rmk:")


+                                                             (* ; "Edited 11-Apr-95 00:02 by rmk:")


+                                                             (* ; "Edited 11-Jun-92 15:58 by cat")

 
-    (* ;; "Makes an indexed file (default is the line printer pseudo-file).  The index file will have a number of indices, one for each indexable type.  Each type index will list all the items of that type in alphabetical order and the page number of where that item's definition is in the file.  The indices will be printed last, so that this can be one-pass.")

+    (* ;; "Makes an indexed file (default is the line printer pseudo-file).  The index file will have a number of indices, one for each indexable type.  Each type index will list all the items of that type in alphabetical order and the page number of where that item's definition is in the file.  The indices will be printed last, so that this can be one-pass.")

 
     (RESETLST
         [PROG ((*STANDARD-OUTPUT* *STANDARD-OUTPUT*)
@@ -215,146 +218,140 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                (*PFI-PENDING-COMMENTS*)
                FILECREATED ENV WASOPEN MULTIFILEINDEX CRDATE INDICES PART# FIRSTPAGE LASTPAGE CRDATE)
 
-         (* ;; "Specials are as follows:")

+         (* ;; "Specials are as follows:")

 
-         (* ;; "*PRINT-PRETTY-BITMAPS* -- tells prettyprinter to render bitmap as its image")

+         (* ;; "*PRINT-PRETTY-BITMAPS* -- tells prettyprinter to render bitmap as its image")

 
-         (* ;; "*PFI-PAGE-COUNT* -- number of current page")

+         (* ;; "*PFI-PAGE-COUNT* -- number of current page")

 
-         (* ;; "*PFI-TWO-SIDED* -- true if preparing two-sided listing")

+         (* ;; "*PFI-TWO-SIDED* -- true if preparing two-sided listing")

 
-         (* ;; "*PFI-TITLE* -- the file name, NIL to suppress headers")

+         (* ;; "*PFI-TITLE* -- the file name, NIL to suppress headers")

 
-         (* ;; "*PFI-ITEM* -- function, etc currently being printed")

+         (* ;; "*PFI-ITEM* -- function, etc currently being printed")

 
-         (* ;; "*PFI-TYPES* -- list specifying the type associated with an expression")

+         (* ;; "*PFI-TYPES* -- list specifying the type associated with an expression")

 
-         (* ;; "*PFI-FILEVARS* -- alist of filevars we have discovered, along with their values.  The first one is always mumbleCOMS.  Use this in computing *PFI-FNSLST*")

+         (* ;; "*PFI-FILEVARS* -- alist of filevars we have discovered, along with their values.  The first one is always mumbleCOMS.  Use this in computing *PFI-FNSLST*")

 
-         (* ;; 
-
       "*PFI-FNSLST* -- list of functions known on this file.  Used as the FNSLST arg to PRINTDEF")

+         (* ;; 
+
         "*PFI-FNSLST* -- list of functions known on this file.  Used as the FNSLST arg to PRINTDEF")

 
-         (* ;; 
-
       "*PFI-LOCATIONS* -- list of (name type page#) constituting the actual index occurrences")

+         (* ;; 
+
         "*PFI-LOCATIONS* -- list of (name type page#) constituting the actual index occurrences")

 
-         (* ;; "*PFI-MAX-WASTED-LINES* -- the maximum number of lines we're willing to waste in order to get an expression all on one page.")

+         (* ;; "*PFI-MAX-WASTED-LINES* -- the maximum number of lines we're willing to waste in order to get an expression all on one page.")

 
-         (* ;; "*PFI-FUNNY-CHARS* -- alist of chars to translate to other chars")

+         (* ;; "*PFI-FUNNY-CHARS* -- alist of chars to translate to other chars")

 
-         (* ;; "*PFI-BITMAP-BASELINE* -- kludge for printing bitmaps--set to baseline of bitmap we have printed below default")

+         (* ;; "*PFI-BITMAP-BASELINE* -- kludge for printing bitmaps--set to baseline of bitmap we have printed below default")

 
-         (* ;; 
-
      "*PFI-PENDING-COMMENTS* -- (lineguess . bodies) of comments we have read but not yet printed")

+         (* ;; 
+
        "*PFI-PENDING-COMMENTS* -- (lineguess . bodies) of comments we have read but not yet printed")

 
-         (* ;; "PRETTYFLG is bound here to insulate us from parallel (MAKEFILE & 'FAST) calls.")

+         (* ;; "PRETTYFLG is bound here to insulate us from parallel (MAKEFILE & 'FAST) calls.")

 
               [if
 (TYPENAMEP FILENAME 'STREAM)
-                  then
                                   (* ; "Already have input stream")

-                        [SETQ *STANDARD-INPUT* (SETQ WASOPEN (GETSTREAM FILENAME 'INPUT]
+                  then
                                       (* ; "Already have input stream")

+                       [SETQ *STANDARD-INPUT* (SETQ WASOPEN (GETSTREAM FILENAME 'INPUT]
                 else
 (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
-                                              (SETQ *STANDARD-INPUT* (OPENSTREAM
-                                                                      FILENAME
-                                                                      'INPUT
-                                                                      'OLD
-                                                                      '((SEQUENTIAL T]
+                                          (SETQ *STANDARD-INPUT* (OPENSTREAM FILENAME 'INPUT
+                                                                        'OLD
+                                                                        '((SEQUENTIAL T]
               (SETQ FILENAME (FULLNAME *STANDARD-INPUT*))
               [if
 (LISTGET PRINTOPTIONS :COMMON)
-                  then
                                   (* ; "Common Lisp file")

-                        (SETQ ENV *COMMON-LISP-READ-ENVIRONMENT*)
-                else
                                     (* ; 
-
                             "Figure out if this is a file manager file, and if so get environment")

-                      (CL:MULTIPLE-VALUE-SETQ (ENV FILECREATED)
-                             (\PARSE-FILE-HEADER *STANDARD-INPUT* 'RETURN T))
-                      (if
 (NULL FILECREATED)
-                          then
                           (* ; "Not a File Manager file")

-                                (RETURN NIL)
-                        elseif
 (NEQ (CAR (LISTP FILECREATED))
-                                        'FILECREATED)
-                          then
                           (* ; 
-
                                       "File started with open paren, but isn't file manager file.")

-                                (RETURN (if
 WASOPEN
-                                            then
         (* ; "We have already read the first expression, so can't just return now (file may not be randaccessp).  So dump what we read and then finish the copy")

-                                                  (PRINTDEF FILECREATED T T NIL NIL OUTSTREAM)
-                                                  (PFCOPYBYTES *STANDARD-INPUT* OUTSTREAM) 
-                                                             (* ; "non-nil return says we did it")

-                                                  FILENAME))
-                        elseif
 (LISTP (CADDR FILECREATED))
-                          then
                           (* ; 
-
                                     "A compiled file--just use COPYBYTES to avoid binary hassles.")

-                                (RETURN (if
 WASOPEN
-                                            then
         (* ; 
-
                                            "Print environment and filecreated before copying rest")

-                                                  (PRINT-READER-ENVIRONMENT ENV OUTSTREAM)
-                                                  (WITH-READER-ENVIRONMENT ENV (PRINT FILECREATED 
-                                                                                      OUTSTREAM))
-                                                  (COPYBYTES *STANDARD-INPUT* OUTSTREAM) 
-                                                             (* ; "non-nil return says we did it")

-                                                  FILENAME]
+                  then
                                       (* ; "Common Lisp file")

+                       (SETQ ENV *COMMON-LISP-READ-ENVIRONMENT*)
+                else
                                         (* ; 
+
                               "Figure out if this is a file manager file, and if so get environment")

+                     (CL:MULTIPLE-VALUE-SETQ (ENV FILECREATED)
+                            (\PARSE-FILE-HEADER *STANDARD-INPUT* 'RETURN T))
+                     (if
 (NULL FILECREATED)
+                         then
                                (* ; "Not a File Manager file")

+                              (RETURN NIL)
+                       elseif
 (NEQ (CAR (LISTP FILECREATED))
+                                   'FILECREATED)
+                         then
                                (* ; 
+
                                         "File started with open paren, but isn't file manager file.")

+                              (RETURN (if
 WASOPEN
+                                          then
               (* ; "We have already read the first expression, so can't just return now (file may not be randaccessp).  So dump what we read and then finish the copy")

+                                               (PRINTDEF FILECREATED T T NIL NIL OUTSTREAM)
+                                               (PFCOPYBYTES *STANDARD-INPUT* OUTSTREAM) 
+                                                             (* ; "non-nil return says we did it")

+                                               FILENAME))
+                       elseif
 (LISTP (CADDR FILECREATED))
+                         then
                                (* ; 
+
                                       "A compiled file--just use COPYBYTES to avoid binary hassles.")

+                              (RETURN (if
 WASOPEN
+                                          then
               (* ; 
+
                                              "Print environment and filecreated before copying rest")

+                                               (PRINT-READER-ENVIRONMENT ENV OUTSTREAM)
+                                               (WITH-READER-ENVIRONMENT ENV (PRINT FILECREATED 
+                                                                                   OUTSTREAM))
+                                               (COPYBYTES *STANDARD-INPUT* OUTSTREAM) 
+                                                             (* ; "non-nil return says we did it")

+                                               FILENAME]
               (CL:UNLESS DONTINDEX (CL:FORMAT PROMPTWINDOW "~%%Starting index of ~A." FILENAME))
               [if
 OUTSTREAM
                   then
 (SETQ *PFI-TITLE* FILENAME)
-                        (SETQ *STANDARD-OUTPUT* (GETSTREAM OUTSTREAM 'OUTPUT))
+                       (SETQ *STANDARD-OUTPUT* (GETSTREAM OUTSTREAM 'OUTPUT))
                 else
 (OR (SETQ *PFI-TITLE* (LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
-                             (push
 PRINTOPTIONS 'DOCUMENT.NAME (SETQ *PFI-TITLE* FILENAME)))
-                      (SETQ *STANDARD-OUTPUT* (PFI.MAKE.LPT.STREAM
 PRINTOPTIONS))
-                      (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM NOPRINT)
-                                                       (if
 NOPRINT
-                                                           then
 
-                                                             (* ; "We only did this for the index (hack for MULTIFILEINDEX), so keep it from printing.  Kludge: do it by closing the stream manually")

-                                                                 (\CORE.CLOSEFILE STREAM)
-                                                                 (replace
 (STREAM ACCESS)
-                                                                    of
 STREAM with
 NIL)
-                                                                 (\GENERIC-UNREGISTER-STREAM
-                                                                  (fetch
 (STREAM DEVICE)
-                                                                     of
 STREAM)
-                                                                  STREAM)
-                                                                 (\CORE.DELETEFILE
-                                                                  (FULLNAME STREAM)
-                                                                  (fetch
 (STREAM DEVICE)
-                                                                     of
 STREAM))
-                                                         else
 (CLOSEF? STREAM]
-                                           *STANDARD-OUTPUT*
-                                           (LISTGET PRINTOPTIONS :DONTPRINT]
-                                                             (* ; 
-
                                                    "Make sure printer knows original name of file")

+                         (push
 PRINTOPTIONS 'DOCUMENT.NAME (SETQ *PFI-TITLE* FILENAME)))
+                     (SETQ *STANDARD-OUTPUT* (PFI.MAKE.LPT.STREAM
 PRINTOPTIONS))
+                     (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM NOPRINT)
+                                                      (if
 NOPRINT
+                                                          then
 
+                                                             (* ; "We only did this for the index (hack for MULTIFILEINDEX), so keep it from printing.  Kludge: do it by closing the stream manually")

+                                                               (\CORE.CLOSEFILE STREAM)
+                                                               (replace
 (STREAM ACCESS) of
 STREAM
+                                                                  with
 NIL)
+                                                               (\GENERIC-UNREGISTER-STREAM
+                                                                (fetch
 (STREAM DEVICE) of
 STREAM)
+                                                                STREAM)
+                                                               (\CORE.DELETEFILE (FULLNAME STREAM)
+                                                                      (fetch
 (STREAM DEVICE)
+                                                                         of
 STREAM))
+                                                        else
 (CLOSEF? STREAM]
+                                          *STANDARD-OUTPUT*
+                                          (LISTGET PRINTOPTIONS :DONTPRINT]
+                                                             (* ; 
+
                                                      "Make sure printer knows original name of file")

               (RESETSAVE (LINELENGTH (IQUOTIENT (- (DSPRIGHTMARGIN)
                                                    (DSPLEFTMARGIN))
                                             (CHARWIDTH (CHARCODE X)
                                                    *STANDARD-OUTPUT*))
                                 *STANDARD-OUTPUT*))
-              (if
 (NOT (DISPLAYSTREAMP *STANDARD-OUTPUT*))
+              (if
 (NOT (IMAGESTREAMP *STANDARD-OUTPUT*))
                   then
 (PFI.SETUP.TRANSLATIONS
))
               [if
 DONTINDEX
-                  then
                                   (* ; "This is for SEE etc")

-                        (SETQ *PFI-MAX-WASTED-LINES* 0)
-                        (SETQ *PFI-TYPES* NIL)               (* ; "Tell add.to.index not to bother")

-                        (SETQ *PFI-LOCATIONS* :NONE)
-                else
 (STREAMPROP *STANDARD-OUTPUT* 'AFTERNEWPAGEFN (FUNCTION PFI.AFTER.NEW.PAGE))
-                                                             (* ; "Enable header printing")

+                  then
                                       (* ; "This is for SEE etc")

+                       (SETQ *PFI-MAX-WASTED-LINES* 0)
+                       (SETQ *PFI-TYPES* NIL)                (* ; "Tell add.to.index not to bother")

+                       (SETQ *PFI-LOCATIONS* :NONE)
+                else
 (STREAMPROP *STANDARD-OUTPUT* 'AFTERNEWPAGEFN (FUNCTION PFI.AFTER.NEW.PAGE)) 
+                                                             (* ; "Enable header printing")

 
-                      (* ;; "RMK:  NOBIND here seems to be deliberate, it seems somehow to match the NOBIND that appears in PFI.HANDLE.RPAQQ.")

+                     (* ;; "RMK:  NOBIND here seems to be deliberate, it seems somehow to match the NOBIND that appears in PFI.HANDLE.RPAQQ.")

 
-                      [SETQ *PFI-FILEVARS* `((,(FILECOMS FILENAME) . NOBIND] 
-                                                             (* ; "Says to do something with coms")

-                      [if
 (NOT (FIXP *PFI-MAX-WASTED-LINES*))
-                          then
                           (* ; 
-
                                                      "a parameter expressed as a fraction of page")

-                                (SETQ *PFI-MAX-WASTED-LINES* (FIXR (TIMES *PFI-MAX-WASTED-LINES*
-                                                                          (- (PFI.LINES.REMAINING

-                                                                              )
-                                                                             2]
-                      [SETQ *PFI-TYPES* (APPEND *PFI-TYPES* (CONS `(RECORD ,CLISPRECORDTYPES)
-                                                                  (PFI.COLLECT.DEFINERS
 
-                                                                         *PFI-TYPES*] 
-                                                             (* ; 
-
                                                 "Add known record types and definers to the list.")

-                      (SETQ CRDATE (GETFILEINFO *STANDARD-INPUT* 'CREATIONDATE]
+                     [SETQ *PFI-FILEVARS* `((,(FILECOMS FILENAME) . NOBIND] 
+                                                             (* ; "Says to do something with coms")

+                     [if
 (NOT (FIXP *PFI-MAX-WASTED-LINES*))
+                         then
                                (* ; 
+
                                                        "a parameter expressed as a fraction of page")

+                              (SETQ *PFI-MAX-WASTED-LINES* (FIXR (TIMES *PFI-MAX-WASTED-LINES*
+                                                                        (- (PFI.LINES.REMAINING
)
+                                                                           2]
+                     [SETQ *PFI-TYPES* (APPEND *PFI-TYPES* (CONS `(RECORD ,CLISPRECORDTYPES)
+                                                                 (PFI.COLLECT.DEFINERS
 *PFI-TYPES*] 
+                                                             (* ; 
+
                                                   "Add known record types and definers to the list.")

+                     (SETQ CRDATE (GETFILEINFO *STANDARD-INPUT* 'CREATIONDATE]
               [SETQ *PFI-PAGE-COUNT* (SETQ FIRSTPAGE (LOGOR (OR (LISTGET PRINTOPTIONS :FIRSTPAGE)
                                                                 1)
                                                             (if
 *PFI-TWO-SIDED*
                                                                 then
 
-                                                             (* ; "Make first page odd")

-                                                                      1
+                                                             (* ; "Make first page odd")

+                                                                     1
                                                               else
 0]
               (if
 (SETQ PART# (LISTGET PRINTOPTIONS :PART))
                   then
 (SETQ *PFI-PAGE-PREFIX* (CONCAT *PFI-PAGE-PREFIX* PART# "-")))
@@ -363,30 +360,29 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                               then
 (PFI.PRINT.FILECREATED
 FILECREATED ENV))
                           (PFI.PROCESS.FILE
 DONTINDEX)
                           (if
 (NOT WASOPEN)
-                              then
                       (* ; 
-
                                                 "We're through with input file now, so release it")

-                                    (CLOSEF *STANDARD-INPUT*))
+                              then
                           (* ; 
+
                                                   "We're through with input file now, so release it")

+                                   (CLOSEF *STANDARD-INPUT*))
                           (if
 (SETQ MULTIFILEINDEX (LISTGET PRINTOPTIONS 'MULTIFILEINDEX))
-                              then
                       (* ; 
-
                               "True on calls from multifileindex-remember the date and last page#")

-                                    (SETQ LASTPAGE *PFI-PAGE-COUNT*))
+                              then
                           (* ; 
+
                                 "True on calls from multifileindex-remember the date and last page#")

+                                   (SETQ LASTPAGE *PFI-PAGE-COUNT*))
                           (if
 (NOT DONTINDEX)
-                              then
                       (* ; 
-
                                               "Now that we've scanned whole file, print the index")

-                                    (SETQ INDICES (PFI.PRINT.INDEX
 CRDATE)))
+                              then
                           (* ; 
+
                                                 "Now that we've scanned whole file, print the index")

+                                   (SETQ INDICES (PFI.PRINT.INDEX
 CRDATE)))
                           [if
 (NULL OUTSTREAM)
                               then
 (CL:FORMAT PROMPTWINDOW "~%%Finished indexing ~A (~D pages)" 
-                                              FILENAME (ADD1 (- *PFI-PAGE-COUNT* FIRSTPAGE]
+                                          FILENAME (ADD1 (- *PFI-PAGE-COUNT* FIRSTPAGE]
                           (if
 (NULL MULTIFILEINDEX)
                               then
 FILENAME
                             else
 (push
 INDICES (LIST FILENAME CRDATE LASTPAGE ENV))
-                                  (if
 (NLISTP MULTIFILEINDEX)
-                                      then
               (* ; 
-
                                                        "More to do yet, so just return this index")

-                                            INDICES
-                                    else
 (PFI.PRINT.MULTI.INDEX
 (NCONC1 MULTIFILEINDEX 
-                                                                               INDICES)
-                                                    PRINTOPTIONS))))])])
+                                 (if
 (NLISTP MULTIFILEINDEX)
+                                     then
                    (* ; 
+
                                                          "More to do yet, so just return this index")

+                                          INDICES
+                                   else
 (PFI.PRINT.MULTI.INDEX
 (NCONC1 MULTIFILEINDEX INDICES)
+                                               PRINTOPTIONS))))])])
 
 (PFI.MAKE.LPT.STREAM

   [LAMBDA (PRINTOPTIONS)
                                 (* ; "Edited 12-Nov-93 09:53 by rmk:")

@@ -458,22 +454,20 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 (DEFINEQ
 
 (PFI.PRINT.FILECREATED

-  [LAMBDA (EXPR ENV)                                         (* ; 
-
                                                           "Edited 30-Nov-2021 22:08 by larry")

-                                                             (* ; 
-
                                                           "Edited 30-Nov-2021 21:40 by larry")

-                                                             (* ; 
-
                                                           "Edited  9-Jul-2021 07:59 by rmk:")

+  [LAMBDA (EXPR ENV)
                                         (* ; "Edited  5-May-2022 21:53 by rmk")


+                                                           (* ; "Edited 30-Nov-2021 22:08 by larry")


+                                                           (* ; "Edited 30-Nov-2021 21:40 by larry")


+                                                            (* ; "Edited  9-Jul-2021 07:59 by rmk:")

 
     (* ;; "Display the FILECREATED expression and environment prettily")

 
     (* ;; 
-
  "Form is (FILECREATED date filename filemaploc changes to: changes previous date: date filename)")

+
    "Form is (FILECREATED date filename filemaploc changes to: changes previous date: date filename)")

 
     (pop
 EXPR)
     (CHANGEFONT ITALICFONT)
-    (LET* [(STRINGS '("File created:" "changes to:" "previous date:" "Read Table:" "Package:" "Base:"
-                            "Format:"))
+    (LET* [(STRINGS '("File created:  " "changes to:  " "previous date:  " "Read Table:  " 
+                            "Package:  " "Base:  " "Format:  "))
            (FONT (DSPFONT))
            (STRWIDTHS (for
 STR in
 STRINGS collect
 (STRINGWIDTH STR FONT)))
            (TABSTOP (+ (DSPLEFTMARGIN)
@@ -486,42 +480,42 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                  "  " .FONT LAMBDAFONT (pop
 EXPR)
                  T T)                                        (* ; "date and file name")

           (if
 (OR (NULL (CAR EXPR))
-                      (FIXP (CAR EXPR)))
-              then
                                       (* ; "Skip over filemaploc")

-                    (pop
 EXPR))
+                  (FIXP (CAR EXPR)))
+              then
                                           (* ; "Skip over filemaploc")

+                   (pop
 EXPR))
           (if
 (SELECTQ (CAR EXPR)
-                      (changes (SETQ EXPR (CDR EXPR))
-                               T)
-                      (:CHANGES-TO T)
-                      NIL)
-              then
                                       (* ; "handle %"Changes to:%"")

-                    (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                           (pop
 STRWIDTHS)
-                           TABSTOP)
-                    (SETQ EXPR (CDR EXPR))
-                    (PRINTDEF (while
 (LISTP (CAR EXPR)) collect
 (pop
 EXPR))
-                           T NIL T)
-                    (TERPRI)
-                    (TERPRI)
-            else
 (pop
 STRINGS)
-                  (pop
 STRWIDTHS))
-          (if
 (SELECTQ (CAR EXPR)
-                      (previous (SETQ EXPR (CDR EXPR))
-                                T)
-                      (:PREVIOUS-DATE 
+                  (changes (SETQ EXPR (CDR EXPR))
                            T)
-                      NIL)
-              then
                                       (* ; "Handle %"Previous date:%"")

-                    (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                           (pop
 STRWIDTHS)
-                           TABSTOP)
-                    (SETQ EXPR (CDR EXPR))
-                    (PRINTOUT NIL (pop
 EXPR)
-                           "  "
-                           (pop
 EXPR)
-                           T T)
+                  (:CHANGES-TO T)
+                  NIL)
+              then
                                           (* ; "handle %"Changes to:%"")

+                   (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                          (pop
 STRWIDTHS)
+                          TABSTOP)
+                   (SETQ EXPR (CDR EXPR))
+                   (PRINTDEF (while
 (LISTP (CAR EXPR)) collect
 (pop
 EXPR))
+                          T NIL T)
+                   (TERPRI)
+                   (TERPRI)
             else
 (pop
 STRINGS)
-                  (pop
 STRWIDTHS))
+                 (pop
 STRWIDTHS))
+          (if
 (SELECTQ (CAR EXPR)
+                  (previous (SETQ EXPR (CDR EXPR))
+                            T)
+                  (:PREVIOUS-DATE 
+                       T)
+                  NIL)
+              then
                                           (* ; "Handle %"Previous date:%"")

+                   (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                          (pop
 STRWIDTHS)
+                          TABSTOP)
+                   (SETQ EXPR (CDR EXPR))
+                   (PRINTOUT NIL (pop
 EXPR)
+                          "  "
+                          (pop
 EXPR)
+                          T T)
+            else
 (pop
 STRINGS)
+                 (pop
 STRWIDTHS))
 
           (* ;; "Show environment")

 
@@ -535,9 +529,9 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
           (PFI.PRINT.ENVIRONMENT
 ENV :PACKAGE)
           (if
 (NEQ *PRINT-BASE* 10)
               then
 (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                              (pop
 STRWIDTHS)
-                              TABSTOP)
-                    (PFI.PRINT.ENVIRONMENT
 ENV :BASE)
+                          (pop
 STRWIDTHS)
+                          TABSTOP)
+                   (PFI.PRINT.ENVIRONMENT
 ENV :BASE)
             else
 (pop
 STRINGS))
           (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
                  (pop
 STRWIDTHS)
@@ -545,8 +539,16 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
           (PFI.PRINT.ENVIRONMENT
 ENV :FORMAT])
 
 (PFI.PRINT.TO.TAB

-(LAMBDA (STR WIDTH TABSTOP) (* ; "Edited 29-Mar-88 12:44 by bvm") (* ;; "Print STR of specified WIDTH right-justified to xpos TABSTOP in italic font, leave a couple of spaces, then switch back to defaultfont.") (CHANGEFONT ITALICFONT) (DSPXPOSITION (- TABSTOP WIDTH)) (PRIN3 STR) (RELMOVETO (TIMES 12 (DSPSCALE)) 0) (CHANGEFONT DEFAULTFONT))
-)
+  [LAMBDA (STR WIDTH TABSTOP)
                                (* ; "Edited 29-Mar-88 12:44 by bvm")

+
+    (* ;; "Print STR of specified WIDTH right-justified to xpos TABSTOP in italic font, leave a couple of spaces, then switch back to defaultfont.")

+
+    (CHANGEFONT ITALICFONT)
+    (DSPXPOSITION (- TABSTOP WIDTH))
+    (PRIN3 STR)
+    (RELMOVETO (TIMES 12 (DSPSCALE))
+           0)
+    (CHANGEFONT DEFAULTFONT])
 
 (PFI.PRINT.ENVIRONMENT

   [LAMBDA (ENV KEYWORD)
                                 (* ; "Edited  9-Jul-2021 08:03 by rmk:")

@@ -614,8 +616,19 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 )
 
 (PFI.MAYBE.NEW.PAGE

-(LAMBDA (EXPR MINLINES) (* ; "Edited 13-Apr-88 14:32 by bvm") (* ;; "Maybe start a new page if it looks like EXPR will overflow the page and we're near the end of the page.  MINLINES is optional size estimate; else we guess") (LET (REMAINING) (if (OR (DISPLAYSTREAMP *STANDARD-OUTPUT*) (> (SETQ REMAINING (SUB1 (PFI.LINES.REMAINING))) *PFI-MAX-WASTED-LINES*) (>= REMAINING (OR MINLINES (PFI.ESTIMATE.SIZE EXPR)))) then (TERPRI) else (* ; "put it on a new page") (DSPNEWPAGE))))
-)
+  [LAMBDA (EXPR MINLINES)
                                    (* ; "Edited  5-May-2022 23:31 by rmk")


+                                                             (* ; "Edited 13-Apr-88 14:32 by bvm")

+
+    (* ;; "Maybe start a new page if it looks like EXPR will overflow the page and we're near the end of the page.  MINLINES is optional size estimate; else we guess")

+
+    (LET (REMAINING)
+         (if
 [OR (IMAGESTREAMP *STANDARD-OUTPUT*)
+                 (> (SETQ REMAINING (SUB1 (PFI.LINES.REMAINING
)))
+                    *PFI-MAX-WASTED-LINES*)
+                 (>= REMAINING (OR MINLINES (PFI.ESTIMATE.SIZE
 EXPR]
+             then
 (TERPRI)
+           else
                                              (* ; "put it on a new page")

+                (DSPNEWPAGE])
 
 (PFI.ESTIMATE.SIZE

 (LAMBDA (EXPR) (* ; "Edited 11-Apr-88 17:37 by bvm") (* ;; "Guess how many lines EXPR will take, so that we can try getting it all on one page if we're near the bottom.  Heuristic is that after the first list element in any element, each subsequent element gets its own line") (+ (LET ((TEMPLATE (AND (LITATOM (CAR EXPR)) (GET (CAR EXPR) :DEFINITION-PRINT-TEMPLATE)))) (if (AND TEMPLATE (MEMB :BODY TEMPLATE)) then (* ; "Make extra space for things that have body") 2 else 1)) (PFI.ESTIMATE.SIZE1 EXPR 0)))
@@ -677,8 +690,29 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 )
 
 (PFI.PRINT.COMMENTS

-(LAMBDA (EXPR) (* ; "Edited  7-Apr-88 12:27 by bvm") (* ;; "Print any pending comments we have in preparation of printing EXPR.  We want to print comments on same page as EXPR, so guess EXPR's size first.  This is not perfect, since a handler might end up printing things differently, but it's probably not worse than default handling.") (TERPRI) (DESTRUCTURING-BIND (LINES . BODIES) *PFI-PENDING-COMMENTS* (if (NOT (DISPLAYSTREAMP *STANDARD-OUTPUT*)) then (LET ((REMAINING (PFI.LINES.REMAINING))) (if (OR (>= LINES REMAINING) (AND (< REMAINING *PFI-MAX-WASTED-LINES*) (< REMAINING (+ (PFI.ESTIMATE.SIZE EXPR) LINES)))) then (* ; "put it on a new page") (DSPNEWPAGE)))) (for B in BODIES do (PRINTDEF B T T) (if (> (DSPXPOSITION) (DSPLEFTMARGIN)) then (* ; "Go to new line for next comment.  Usually this has already been done") (TERPRI))) (SETQ *PFI-PENDING-COMMENTS* NIL)))
-)
+  [LAMBDA (EXPR)
                                             (* ; "Edited  5-May-2022 23:27 by rmk")


+                                                             (* ; "Edited  7-Apr-88 12:27 by bvm")

+
+    (* ;; "Print any pending comments we have in preparation of printing EXPR.  We want to print comments on same page as EXPR, so guess EXPR's size first.  This is not perfect, since a handler might end up printing things differently, but it's probably not worse than default handling.")

+
+    (TERPRI)
+    (DESTRUCTURING-BIND (LINES . BODIES)
+           *PFI-PENDING-COMMENTS*
+           [if
 (NOT (IMAGESTREAMP *STANDARD-OUTPUT*))
+               then
 (LET ((REMAINING (PFI.LINES.REMAINING
)))
+                         (if
 [OR (>= LINES REMAINING)
+                                 (AND (< REMAINING *PFI-MAX-WASTED-LINES*)
+                                      (< REMAINING (+ (PFI.ESTIMATE.SIZE
 EXPR)
+                                                      LINES]
+                             then
                            (* ; "put it on a new page")

+                                  (DSPNEWPAGE]
+           (for
 B in
 BODIES do
 (PRINTDEF B T T)
+                               (if
 (> (DSPXPOSITION)
+                                      (DSPLEFTMARGIN))
+                                   then
                      (* ; 
+
                               "Go to new line for next comment.  Usually this has already been done")

+                                        (TERPRI)))
+           (SETQ *PFI-PENDING-COMMENTS* NIL])
 
 (PFI.HANDLE.FILEMAP

 (LAMBDA (EXPR) (* ; "Edited 31-Mar-88 15:28 by bvm") (* ;; "Only get here from declare: previewer (during SEE), since declare: expression handler filters out the whole thing.") (PFI.PRETTYPRINT (LIST (QUOTE *) (QUOTE ;;) "---Filemap elided by lister---") NIL T))
@@ -791,12 +825,57 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 (DEFINEQ
 
 (PFI.MAYBE.SEE.PRETTY

-(LAMBDA (FROMFILE TOFILE) (* ; "Edited  1-Apr-88 11:23 by bvm") (* ;; "Replaces COPYALLBYTES and PFCOPYBYTES in various forms of SEE that want to see a whole file") (RESETLST (LET ((*UPPER-CASE-FILE-NAMES* NIL) OUTSTREAM INSTREAM) (if (OR (NULL *PRINT-PRETTY-FROM-FILES*) (NULL (SETQ OUTSTREAM (DISPLAYP TOFILE)))) then (* ; "Not a display window, or don't want prettyprinting") (if (STREAMP FROMFILE) then (* ; "Wanted PFCOPYBYTES") (PFCOPYBYTES FROMFILE TOFILE) else (COPYALLBYTES FROMFILE TOFILE)) else (if (NOT (SETQ INSTREAM (STREAMP FROMFILE))) then (RESETSAVE NIL (LIST (QUOTE CLOSEF) (SETQ INSTREAM (OPENSTREAM FROMFILE (QUOTE INPUT) NIL (QUOTE ((SEQUENTIAL T)))))))) (* ;; "Open the file, try to prettyprint it.  We get NIL back from PRETTYFILEINDEX if it's not a file manager file") (if (PRETTYFILEINDEX INSTREAM NIL OUTSTREAM T) else (PFCOPYBYTES INSTREAM OUTSTREAM) (FULLNAME INSTREAM))))))
-)
+  [LAMBDA (FROMFILE TOFILE)
                                  (* ; "Edited  5-May-2022 14:29 by rmk")


+                                                             (* ; "Edited  1-Apr-88 11:23 by bvm")

+
+    (* ;; 
+
    "Replaces COPYALLBYTES and PFCOPYBYTES in various forms of SEE that want to see a whole file")

+
+    (RESETLST
+        [LET ((*UPPER-CASE-FILE-NAMES* NIL)
+              OUTSTREAM INSTREAM)
+             (if
 [OR (NULL *PRINT-PRETTY-FROM-FILES*)
+                     (NULL (SETQ OUTSTREAM (IMAGESTREAMP TOFILE]
+                 then
                                        (* ; 
+
                                                 "Not a display window, or don't want prettyprinting")

+                      (if
 (STREAMP FROMFILE)
+                          then
                               (* ; "Wanted PFCOPYBYTES")

+                               (PFCOPYBYTES FROMFILE TOFILE)
+                        else
 (COPYALLBYTES FROMFILE TOFILE))
+               else
 [if
 (NOT (SETQ INSTREAM (STREAMP FROMFILE)))
+                        then
 (RESETSAVE NIL (LIST 'CLOSEF (SETQ INSTREAM (OPENSTREAM
+                                                                          FROMFILE
+                                                                          'INPUT NIL
+                                                                          '((SEQUENTIAL T] 
+
+                    (* ;; "Open the file, try to prettyprint it.  We get NIL back from PRETTYFILEINDEX if it's not a file manager file")

+
+                    (if
 (PRETTYFILEINDEX
 INSTREAM NIL OUTSTREAM T)
+                      else
 (PFCOPYBYTES INSTREAM OUTSTREAM)
+                           (FULLNAME INSTREAM])])
 
 (PFI.MAYBE.PP.DEFINITION

-(LAMBDA (INSTREAM OUTSTREAM START END) (* ; "Edited  1-Apr-88 11:22 by bvm") (LET (ENV) (if (OR (NULL *PRINT-PRETTY-FROM-FILES*) (NOT (DISPLAYP OUTSTREAM)) (NULL (SETQ ENV (GET-ENVIRONMENT-AND-FILEMAP INSTREAM))) (WITH-READER-ENVIRONMENT ENV (SETFILEPTR INSTREAM START) (CL:MULTIPLE-VALUE-BIND (DEF CONDITION) (IGNORE-ERRORS (READ INSTREAM)) (LET ((*STANDARD-OUTPUT* (GETSTREAM OUTSTREAM (QUOTE OUTPUT)))) (if CONDITION then (CL:FORMAT T "[Failed to read because: ~A]" CONDITION) T else (PFI.PRINT.LAMBDA.BODY DEF) (TERPRI) NIL))))) then (* ;; "Punt to what we were called for in the first place") (PFCOPYBYTES INSTREAM OUTSTREAM START END))))
-)
+  [LAMBDA (INSTREAM OUTSTREAM START END)
                     (* ; "Edited  5-May-2022 23:14 by rmk")


+                                                             (* ; "Edited  1-Apr-88 11:22 by bvm")

+    (LET (ENV)
+         (if
 [OR (NULL *PRINT-PRETTY-FROM-FILES*)
+                 (NOT (IMAGESTREAMP OUTSTREAM))
+                 (NULL (SETQ ENV (GET-ENVIRONMENT-AND-FILEMAP INSTREAM)))
+                 (WITH-READER-ENVIRONMENT ENV
+                     (SETFILEPTR INSTREAM START)
+                     (CL:MULTIPLE-VALUE-BIND (DEF CONDITION)
+                            (IGNORE-ERRORS (READ INSTREAM))
+                            (LET [(*STANDARD-OUTPUT* (GETSTREAM OUTSTREAM 'OUTPUT]
+                                 (if
 CONDITION
+                                     then
 (CL:FORMAT T "[Failed to read because: ~A]" CONDITION)
+                                          T
+                                   else
 (PFI.PRINT.LAMBDA.BODY
 DEF)
+                                        (TERPRI)
+                                        NIL))))]
+             then
 
+                  (* ;; "Punt to what we were called for in the first place")

+
+                  (PFCOPYBYTES INSTREAM OUTSTREAM START END])
 )
 
 (RPAQ? *PRINT-PRETTY-FROM-FILES*
 T)
@@ -821,20 +900,19 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 (RPAQ? *PFI-MAX-WASTED-LINES*
 12)
 
 (RPAQ? *PFI-CHARACTER-TRANSLATIONS*
 '((INTERPRESS (95 172)
-                                                 (96 169 FAMILY CLASSIC)
-                                                 (39 185 FAMILY CLASSIC))))
+                                             (96 169 FAMILY CLASSIC)
+                                             (39 185 FAMILY CLASSIC))))
 
 (RPAQ? *PFI-INDEX-ORDER*
 '(FUNCTIONS))
 
 (RPAQ? *PFI-DEFINER-PROPS*
 (LET ((*PACKAGE* (if (EQ MAKESYSNAME :LYRIC)
-                                                    then *INTERLISP-PACKAGE* else *KEYWORD-PACKAGE*))
-                                     )
-                                    
-                                    (* ;; 
-
                                  "Properties of definers changed between Lyric and Medley (yech).")

+                                                then *INTERLISP-PACKAGE* else *KEYWORD-PACKAGE*)))
+                                
+                                (* ;; 
+
                                "Properties of definers changed between Lyric and Medley (yech).")

 
-                                    (MAPCAR '("DEFINER-FOR" "DEFINED-BY" "DEFINITION-NAME")
-                                           (FUNCTION CL:INTERN))))
+                                (MAPCAR '("DEFINER-FOR" "DEFINED-BY" "DEFINITION-NAME")
+                                       (FUNCTION CL:INTERN))))
 
 (RPAQ? \PFI.PROCESS.COMMANDS
 )
 
@@ -885,10 +963,10 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
           (CL:EVAL-WHEN . PFI.HANDLE.EVAL-WHEN))
 
 (ADDTOVAR *PFI-PREVIEWERS*
 (DECLARE%: . PFI.PREVIEW.DECLARE)
-                               (DEFINEQ . PFI.PREVIEW.DEFINEQ))
+                           (DEFINEQ . PFI.PREVIEW.DEFINEQ))
 
 (ADDTOVAR *PFI-PROPERTIES*
 (COPYRIGHT)
-                               (READVICE ADVICE))
+                           (READVICE ADVICE))
 
 (ADDTOVAR *PFI-FILTERS*
 (VARIABLES . CONSTANTS))
 
@@ -916,11 +994,11 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 )
 
 (ADDTOVAR PRETTYPRINTMACROS
 (RPAQ . RPAQX.PRETTYPRINT)
-                                (RPAQQ . RPAQX.PRETTYPRINT)
-                                (RPAQ? . RPAQX.PRETTYPRINT)
-                                (ADDTOVAR . RPAQX.PRETTYPRINT)
-                                (PUTPROPS . PUTPROPS.PRETTYPRINT)
-                                (COURIERPROGRAM . COURIERPROGRAM.PRETTYPRINT))
+                            (RPAQQ . RPAQX.PRETTYPRINT)
+                            (RPAQ? . RPAQX.PRETTYPRINT)
+                            (ADDTOVAR . RPAQX.PRETTYPRINT)
+                            (PUTPROPS . PUTPROPS.PRETTYPRINT)
+                            (COURIERPROGRAM . COURIERPROGRAM.PRETTYPRINT))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -960,11 +1038,11 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
            DEFINERPRINT))
 
                                                              (* ; 
-
                                                 "Get prettyprinter fixes if running in old sysout")

+
                                                   "Get prettyprinter fixes if running in old sysout")

 
 (MOVD? [PROG ((SYMS '("OLDLISTFILES1" "LISTFILES1-ORIGINAL"))
               S)                                             (* ; 
-
       "Look for LISTFILES1.  These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")

+
         "Look for LISTFILES1.  These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")

          LP  (COND
                 [(AND (SETQ S (CL:FIND-SYMBOL (CAR SYMS)))
                       (GETD S))
@@ -975,8 +1053,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
                                  (MOVD 'PFI.MAYBE.SEE.PRETTY S NIL T))))]
                 ((SETQ SYMS (CDR SYMS))
                  (GO LP))
-                (T                                           (* ; 
-
                                                           "Neither one loaded, take original")

+                (T                                           (* ; "Neither one loaded, take original")

                    (RETURN 'LISTFILES1]
        'PFI.ORIGINAL.LISTFILES1 NIL T)
 
@@ -994,28 +1071,28 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 )
 (PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10070 12305 (PFI.NEW.LISTFILES1 10080 . 10574) (PFI.ENQUEUE 10576 . 11200) (
-\PFI.DO.HARDCOPY 11202 . 11788) (MAYBE.PRETTYFILEINDEX 11790 . 12303)) (12306 35220 (PRETTYFILEINDEX 
-12316 . 26748) (PFI.MAKE.LPT.STREAM 26750 . 29801) (PFI.SETUP.TRANSLATIONS 29803 . 31317) (
-PFI.OUTCHARFN 31319 . 33293) (PFI.COLLECT.DEFINERS 33295 . 34107) (PFI.AFTER.NEW.PAGE 34109 . 35218)) 
-(35221 41169 (PFI.PRINT.FILECREATED 35231 . 39436) (PFI.PRINT.TO.TAB 39438 . 39803) (
-PFI.PRINT.ENVIRONMENT 39805 . 41167)) (41170 48354 (PFI.PROCESS.FILE 41180 . 42410) (PFI.PASS.COMMENT 
-42412 . 43382) (PFI.HANDLE.EXPR 43384 . 44051) (PFI.DEFAULT.HANDLER 44053 . 46106) (PFI.PRETTYPRINT 
-46108 . 46443) (PFI.LINES.REMAINING 46445 . 46772) (PFI.MAYBE.NEW.PAGE 46774 . 47277) (
-PFI.ESTIMATE.SIZE 47279 . 47810) (PFI.ESTIMATE.SIZE1 47812 . 48352)) (48391 57878 (PFI.HANDLE.RPAQQ 
-48401 . 49809) (PFI.HANDLE.DECLARE 49811 . 50750) (PFI.HANDLE.EVAL-WHEN 50752 . 51235) (
-PFI.HANDLE.DEFDEFINER 51237 . 52527) (PFI.HANDLE.DEFINEQ 52529 . 52773) (PFI.PRINT.LAMBDA 52775 . 
-53113) (PFI.PRINT.LAMBDA.BODY 53115 . 53450) (PFI.HANDLE.PUTDEF 53452 . 53949) (PFI.HANDLE.PUTPROPS 
-53951 . 54566) (PFI.HANDLE./DECLAREDATATYPE 54568 . 55115) (PFI.HANDLE.* 55117 . 56379) (
-PFI.PRINT.COMMENTS 56381 . 57281) (PFI.HANDLE.FILEMAP 57283 . 57571) (PFI.HANDLE.PACKAGE 57573 . 57876
-)) (57906 58898 (PFI.PREVIEW.DECLARE 57916 . 58578) (PFI.PREVIEW.DEFINEQ 58580 . 58896)) (58934 69922 
-(PFI.PRINT.INDEX 58944 . 59795) (PFI.CONDENSE.INDEX 59797 . 61604) (PFI.SORT.INDICES 61606 . 62745) (
-PFI.COMPUTE.INDEX.SHAPE 62747 . 64211) (PFI.PRINT.INDICES 64213 . 68755) (PFI.CENTER.PRINT 68757 . 
-69327) (PFI.INDEX.BREAK 69329 . 69787) (PFI.LOOKUP.NAME 69789 . 69920)) (69923 71154 (PFI.ADD.TO.INDEX
- 69933 . 70443) (PFI.VARNAME 70445 . 70855) (PFI.CONSTANTNAMES 70857 . 71152)) (71189 79502 (
-MULTIFILEINDEX 71199 . 71995) (MULTIFILEINDEX1 71997 . 73453) (PFI.PRINT.MULTI.INDEX 73455 . 78558) (
-PFI.CHOOSE.BEST 78560 . 78787) (PFI.MERGE.INDICES 78789 . 79500)) (79559 81177 (PFI.MAYBE.SEE.PRETTY 
-79569 . 80499) (PFI.MAYBE.PP.DEFINITION 80501 . 81175)) (81247 85082 (PFI.PRINT.BITMAP 81257 . 85080))
- (87927 91041 (PUTPROPS.PRETTYPRINT 87937 . 89348) (RPAQX.PRETTYPRINT 89350 . 90075) (
-COURIERPROGRAM.PRETTYPRINT 90077 . 90777) (MAYBE.PRETTYPRINT.BOLD 90779 . 91039)))))
+  (FILEMAP (NIL (10203 12438 (PFI.NEW.LISTFILES1 10213 . 10707) (PFI.ENQUEUE 10709 . 11333) (
+\PFI.DO.HARDCOPY 11335 . 11921) (MAYBE.PRETTYFILEINDEX 11923 . 12436)) (12439 34954 (PRETTYFILEINDEX 
+12449 . 26482) (PFI.MAKE.LPT.STREAM 26484 . 29535) (PFI.SETUP.TRANSLATIONS 29537 . 31051) (
+PFI.OUTCHARFN 31053 . 33027) (PFI.COLLECT.DEFINERS 33029 . 33841) (PFI.AFTER.NEW.PAGE 33843 . 34952)) 
+(34955 40868 (PFI.PRINT.FILECREATED 34965 . 39055) (PFI.PRINT.TO.TAB 39057 . 39502) (
+PFI.PRINT.ENVIRONMENT 39504 . 40866)) (40869 48384 (PFI.PROCESS.FILE 40879 . 42109) (PFI.PASS.COMMENT 
+42111 . 43081) (PFI.HANDLE.EXPR 43083 . 43750) (PFI.DEFAULT.HANDLER 43752 . 45805) (PFI.PRETTYPRINT 
+45807 . 46142) (PFI.LINES.REMAINING 46144 . 46471) (PFI.MAYBE.NEW.PAGE 46473 . 47307) (
+PFI.ESTIMATE.SIZE 47309 . 47840) (PFI.ESTIMATE.SIZE1 47842 . 48382)) (48421 58630 (PFI.HANDLE.RPAQQ 
+48431 . 49839) (PFI.HANDLE.DECLARE 49841 . 50780) (PFI.HANDLE.EVAL-WHEN 50782 . 51265) (
+PFI.HANDLE.DEFDEFINER 51267 . 52557) (PFI.HANDLE.DEFINEQ 52559 . 52803) (PFI.PRINT.LAMBDA 52805 . 
+53143) (PFI.PRINT.LAMBDA.BODY 53145 . 53480) (PFI.HANDLE.PUTDEF 53482 . 53979) (PFI.HANDLE.PUTPROPS 
+53981 . 54596) (PFI.HANDLE./DECLAREDATATYPE 54598 . 55145) (PFI.HANDLE.* 55147 . 56409) (
+PFI.PRINT.COMMENTS 56411 . 58033) (PFI.HANDLE.FILEMAP 58035 . 58323) (PFI.HANDLE.PACKAGE 58325 . 58628
+)) (58658 59650 (PFI.PREVIEW.DECLARE 58668 . 59330) (PFI.PREVIEW.DEFINEQ 59332 . 59648)) (59686 70674 
+(PFI.PRINT.INDEX 59696 . 60547) (PFI.CONDENSE.INDEX 60549 . 62356) (PFI.SORT.INDICES 62358 . 63497) (
+PFI.COMPUTE.INDEX.SHAPE 63499 . 64963) (PFI.PRINT.INDICES 64965 . 69507) (PFI.CENTER.PRINT 69509 . 
+70079) (PFI.INDEX.BREAK 70081 . 70539) (PFI.LOOKUP.NAME 70541 . 70672)) (70675 71906 (PFI.ADD.TO.INDEX
+ 70685 . 71195) (PFI.VARNAME 71197 . 71607) (PFI.CONSTANTNAMES 71609 . 71904)) (71941 80254 (
+MULTIFILEINDEX 71951 . 72747) (MULTIFILEINDEX1 72749 . 74205) (PFI.PRINT.MULTI.INDEX 74207 . 79310) (
+PFI.CHOOSE.BEST 79312 . 79539) (PFI.MERGE.INDICES 79541 . 80252)) (80311 83380 (PFI.MAYBE.SEE.PRETTY 
+80321 . 82104) (PFI.MAYBE.PP.DEFINITION 82106 . 83378)) (83450 87285 (PFI.PRINT.BITMAP 83460 . 87283))
+ (90054 93168 (PUTPROPS.PRETTYPRINT 90064 . 91475) (RPAQX.PRETTYPRINT 91477 . 92202) (
+COURIERPROGRAM.PRETTYPRINT 92204 . 92904) (MAYBE.PRETTYPRINT.BOLD 92906 . 93166)))))
 STOP

lispusers/PSEUDOHOSTS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Feb-2022 23:56:08" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;138
 25865  
+
(FILECREATED "25-Apr-2022 09:38:17" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;140
 26309  
 
-      :CHANGES-TO (FNS PSEUDOHOST PSEUDOHOSTP)
+      :CHANGES-TO (FNS EXPAND.PH)
 
-      :PREVIOUS-DATE " 5-Feb-2022 08:23:53" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136)
+      :PREVIOUS-DATE "24-Apr-2022 14:18:32" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;139)
 
 
 (PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -19,11 +19,13 @@
         
         (* ;; "Internals")

 
-        (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT)
+        (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH)
         (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH 
              OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH 
              SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
-        (P (PSEUDOHOST 'LI LOGINHOST/DIR))
+        (P (PSEUDOHOST 'LI LOGINHOST/DIR)
+           (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
+           (MOVD 'GETHOSTINFO.PH 'GETHOSTINFO))
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
                (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
                (P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
@@ -178,7 +180,7 @@
 (EXPAND.PH

   [LAMBDA (FILENAME PHDEV)
 
-    (* ;; "Edited  5-Feb-2022 08:23 by rmk: that FILENAME contains }, because HOST was identified in it.  If FILENAME is a stream, expand its full name")

+    (* ;; "Edited 25-Apr-2022 09:35 by rmk: that FILENAME contains }, because HOST was identified in it.  If FILENAME is a stream, expand its full name")

 
     (* ;; "Assumes that FILENAME contains }, because HOST was identified in it.  If FILENAME is a stream, expand its full name")

 
@@ -187,7 +189,7 @@
                  (SETQ PHDEV (FETCH
 (STREAM DEVICE) OF
 FILENAME)))
              (SETQ FILENAME (FETCH
 (STREAM FULLNAME) OF
 FILENAME))
       ELSEIF
 (NOT (TYPE?
 FDEV PHDEV))
-        THEN
 (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV (FILENAMEFIELD FILENAME 'HOST]
+        THEN
 (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV FILENAME]
     (IF
 (TYPE?
 PHDEVICE PHDEV)
         THEN
 (LET (SUFFIX SUFFIXPOS)
                   (CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME))
@@ -293,6 +295,17 @@
              UNSLASHED
              (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
                     UNSLASHED))])
+
+(GETHOSTINFO.PH

+  [LAMBDA (HOST ATTRIBUTE)
+
+    (* ;; "Edited 24-Apr-2022 14:16 by rmk: the  info from the true host")

+
+    (* ;; "Want the  info from the true host")

+
+    (GETHOSTINFO.ORIG (OR (TARGETHOST
 HOST)
+                          HOST)
+           HOST ATTRIBUTE])
 )
 (DEFINEQ
 
@@ -422,6 +435,10 @@
 )
 
 (PSEUDOHOST
 'LI LOGINHOST/DIR)
+
+(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
+
+(MOVD 'GETHOSTINFO.PH 'GETHOSTINFO)
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
@@ -478,12 +495,13 @@
     (LOAD 'EXPORTS.ALL))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1239 9187 (PSEUDOHOST 1249 . 6724) (PSEUDOHOSTP 6726 . 7239) (PSEUDOHOSTS 7241 . 7598) 
-(TARGETHOST 7600 . 7874) (TRUEFILENAME 7876 . 8563) (PSEUDOFILENAME 8565 . 9185)) (9215 16486 (
-EXPAND.PH 9225 . 10499) (CONTRACT.PH 10501 . 13166) (SLASHIT 13168 . 14736) (UNSLASHIT 14738 . 16484))
- (16487 23277 (OPENFILE.PH 16497 . 17058) (GETFILENAME.PH 17060 . 17349) (DIRECTORYNAMEP.PH 17351 . 
-17975) (CLOSEFILE.PH 17977 . 18331) (REOPENFILE.PH 18333 . 18898) (DELETEFILE.PH 18900 . 19184) (
-OPENP.PH 19186 . 19362) (UNREGISTERFILE.PH 19364 . 19669) (REGISTERFILE.PH 19671 . 19972) (
-GENERATEFILES.PH 19974 . 21014) (GETFILEINFO.PH 21016 . 21318) (SETFILEINFO.PH 21320 . 21519) (
-NEXTFILEFN.PH 21521 . 22063) (FILEINFOFN.PH 22065 . 22336) (RENAMEFILE.PH 22338 . 23275)))))
+  (FILEMAP (NIL (1338 9286 (PSEUDOHOST 1348 . 6823) (PSEUDOHOSTP 6825 . 7338) (PSEUDOHOSTS 7340 . 7697) 
+(TARGETHOST 7699 . 7973) (TRUEFILENAME 7975 . 8662) (PSEUDOFILENAME 8664 . 9284)) (9314 16853 (
+EXPAND.PH 9324 . 10577) (CONTRACT.PH 10579 . 13244) (SLASHIT 13246 . 14814) (UNSLASHIT 14816 . 16562) 
+(GETHOSTINFO.PH 16564 . 16851)) (16854 23644 (OPENFILE.PH 16864 . 17425) (GETFILENAME.PH 17427 . 17716
+) (DIRECTORYNAMEP.PH 17718 . 18342) (CLOSEFILE.PH 18344 . 18698) (REOPENFILE.PH 18700 . 19265) (
+DELETEFILE.PH 19267 . 19551) (OPENP.PH 19553 . 19729) (UNREGISTERFILE.PH 19731 . 20036) (
+REGISTERFILE.PH 20038 . 20339) (GENERATEFILES.PH 20341 . 21381) (GETFILEINFO.PH 21383 . 21685) (
+SETFILEINFO.PH 21687 . 21886) (NEXTFILEFN.PH 21888 . 22430) (FILEINFOFN.PH 22432 . 22703) (
+RENAMEFILE.PH 22705 . 23642)))))
 STOP

lispusers/TEDIT-PF-SEE

@@ -1,28 +1,32 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "12-Jan-2022 13:16:00" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;110
 7695   
+
(FILECREATED " 5-May-2022 23:48:59" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;112
 7835   
 
-      :CHANGES-TO (FNS PF-TEDIT)
+      :CHANGES-TO (COMMANDS ts tf)
+                  (FNS PF-TEDIT)
+                  (VARS TEDIT-PF-SEECOMS)
 
-      :PREVIOUS-DATE " 2-Jan-2022 22:03:27" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;104)
+      :PREVIOUS-DATE " 5-May-2022 23:26:29" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;111)
 
 
 (PRETTYCOMPRINT TEDIT-PF-SEECOMS)
 
-(RPAQQ TEDIT-PF-SEECOMS
 [(FNS PF-TEDIT)
-                         (COMMANDS ts tf)
-                         (FILES (SYSLOAD)
-                                REGIONMANAGER)
-                         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
-                                                                                        (NLAMA)
-                                                                                        (NLAML)
-                                                                                        (LAMA])
+(RPAQQ TEDIT-PF-SEECOMS

+       [(FNS PF-TEDIT)
+        (COMMANDS ts tf)
+        (FILES (SYSLOAD)
+               REGIONMANAGER)
+        (P (MOVD? 'PFCOPYBYTES 'PFI.mAYBE.PP.DEFINITION))
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
+                                                                             (NLAML)
+                                                                             (LAMA])
 (DEFINEQ
 
 (PF-TEDIT

-  [LAMBDA (FN IFILES REPRINT)                                (* ; "Edited 12-Jan-2022 13:15 by rmk")

+  [LAMBDA (FN IFILES REPRINT)
                                (* ; "Edited  5-May-2022 23:11 by rmk")


+                                                             (* ; "Edited 12-Jan-2022 13:15 by rmk")


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

 
     (* ;; "PF* to a read-only TEDIT window.  First argument is the function name, second if given is the input file.")

@@ -98,7 +102,7 @@
                                                                   3 T T NIL TSTREAM)
                                                            (PRIN3 ")" TSTREAM)
                                                     ELSE
 (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)))
-                                       ELSE
 (PFCOPYBYTES ISTREAM TSTREAM (POP
 LOC)
+                                       ELSE
 (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP
 LOC)
                                                    (POP
 LOC)))
                                      (TERPRI TSTREAM)
                                      [TEDIT TSTREAM (OR WINDOW 'PF-TEDIT)
@@ -133,6 +137,8 @@
 
 (FILESLOAD (SYSLOAD)
        REGIONMANAGER)
+
+(MOVD? 'PFCOPYBYTES 'PFI.mAYBE.PP.DEFINITION)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 )
@@ -142,5 +148,5 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (947 7216 (PF-TEDIT 957 . 7214)))))
+  (FILEMAP (NIL (911 7309 (PF-TEDIT 921 . 7307)))))
 STOP

lispusers/WHEELSCROLL.TXT

@@ -10,7 +10,7 @@ It is toggled on and off by
 
 (ENABLEWHEELSCROLL ON)  (initially (ENABLEWHEELSCROLL T))
 
-The scrolling speed is controlled by the variable
+The vertical scrolling speed is controlled by the variable
 
 WHEELSCROLLDELTA (initially 20)
 	The number of points to scroll for each click of the wheel.  Higher values give faster scrolling.  A negative value reverses the scrolling direction.  

lispusers/comparetext

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Feb-2022 14:36:43" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;116
 46252  
+
(FILECREATED "20-May-2022 16:35:56" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>comparetext.;118
 46470  
 
-      :CHANGES-TO (FNS COMPARETEXT.WINDOW)
+      :CHANGES-TO (FNS IMCOMPARE.BOXNODE)
 
-      :PREVIOUS-DATE "19-Feb-2022 12:01:45" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115)
+      :PREVIOUS-DATE "25-Feb-2022 14:36:43" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>comparetext.;116)
 
 
 (* ; "
@@ -193,20 +193,26 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
          X])
 
 (IMCOMPARE.BOXNODE

-  [LAMBDA (WINDOW NODE1 NODE2)                               (* ; "Edited 25-Dec-2021 12:01 by rmk")

+  [LAMBDA (WINDOW NODE1 NODE2)
+
+    (* ;; "Edited 20-May-2022 16:35 by rmk: Invert nodes rather than FLIPNODES, so they stay inverted when scrolled")

+
+    (* ;; "Edited 25-Dec-2021 12:01 by rmk")

                                                              (* rmk%: "14-Dec-84 13:40")

 
     (* ;; "Marks NODE1 and NODE2 as having been selected, removing marks on previous nodes.")

 
     (LET [(LASTNODES (WINDOWPROP WINDOW 'LASTNODES]          (* ; "FLIPNODE ?")

          (CL:WHEN (CAR LASTNODES)
-             (FLIPNODE (CAR LASTNODES)
-                    WINDOW))
+             (RESET/NODE/LABELSHADE (CAR LASTNODES)
+                    'INVERT WINDOW))
          (CL:WHEN (CADR LASTNODES)
-             (FLIPNODE (CADR LASTNODES)
-                    WINDOW))
-         (CL:WHEN NODE1 (FLIPNODE NODE1 WINDOW))
-         (CL:WHEN NODE2 (FLIPNODE NODE2 WINDOW))
+             (RESET/NODE/LABELSHADE (CADR LASTNODES)
+                    'INVERT WINDOW))
+         (CL:WHEN NODE1
+             (RESET/NODE/LABELSHADE NODE1 'INVERT WINDOW))
+         (CL:WHEN NODE2
+             (RESET/NODE/LABELSHADE NODE2 'INVERT WINDOW))
          (WINDOWPROP WINDOW 'LASTNODES (LIST NODE1 NODE2])
 
 (IMCOMPARE.CHUNKS

@@ -737,12 +743,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
 )
 (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1344 38872 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6357) (
-COMPARETEXT.TEXTOBJ 6359 . 9067) (COMPARETEXT.SETSEL 9069 . 9859) (CHUNKNODELABEL 9861 . 10982) (
-IMCOMPARE.BOXNODE 10984 . 11751) (IMCOMPARE.CHUNKS 11753 . 16129) (IMCOMPARE.COLLECT.HASH.CHUNKS 16131
- . 19048) (IMCOMPARE.DISPLAYGRAPH 19050 . 26893) (IMCOMPARE.HASH 26895 . 31082) (
-IMCOMPARE.MERGE.CONNECTED.CHUNKS 31084 . 34580) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34582 . 36537) (
-IMCOMPARE.SHOW.DIST 36539 . 36985) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36987 . 38870)) (38873 45030 (
-IMCOMPARE.LEFTBUTTONFN 38883 . 41460) (IMCOMPARE.MIDDLEBUTTONFN 41462 . 44578) (IMCOMPARE.COPYBUTTONFN
- 44580 . 45028)) (45083 45774 (TAIL1 45093 . 45447) (TAIL2 45449 . 45772)))))
+  (FILEMAP (NIL (1353 39090 (COMPARETEXT 1363 . 2863) (COMPARETEXT.WINDOW 2865 . 6366) (
+COMPARETEXT.TEXTOBJ 6368 . 9076) (COMPARETEXT.SETSEL 9078 . 9868) (CHUNKNODELABEL 9870 . 10991) (
+IMCOMPARE.BOXNODE 10993 . 11969) (IMCOMPARE.CHUNKS 11971 . 16347) (IMCOMPARE.COLLECT.HASH.CHUNKS 16349
+ . 19266) (IMCOMPARE.DISPLAYGRAPH 19268 . 27111) (IMCOMPARE.HASH 27113 . 31300) (
+IMCOMPARE.MERGE.CONNECTED.CHUNKS 31302 . 34798) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34800 . 36755) (
+IMCOMPARE.SHOW.DIST 36757 . 37203) (IMCOMPARE.UPDATE.SYMBOL.TABLE 37205 . 39088)) (39091 45248 (
+IMCOMPARE.LEFTBUTTONFN 39101 . 41678) (IMCOMPARE.MIDDLEBUTTONFN 41680 . 44796) (IMCOMPARE.COPYBUTTONFN
+ 44798 . 45246)) (45301 45992 (TAIL1 45311 . 45665) (TAIL2 45667 . 45990)))))
 STOP

lispusers/migration-tool/FILEPKGRECORDS

@@ -1,116 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-(* "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
-The following program was created in 1982 but has not been published
-within the meaning of the copyright law, is furnished under license,
-and may not be used, copied and/or disclosed except in accordance
-with the terms of said license.
-")
-
-(PRETTYCOMPRINT FILEPKGRECORDSCOMS)
-
-(RPAQQ FILEPKGRECORDSCOMS
 
-       [(COMS                                                (* ; 
-
             "standard records for accessing file package type/command parts.  Exported for PRETTY")

-              (RECORDS * FILEPKGRECORDS)])
-
-(RPAQQ FILEPKGRECORDS
 (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
-
-(ACCESSFNS FILEPKGCOM
 [[ADD
 (GETPROP DATUM 'ADDTOPRETTYCOM)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE))
-                                               (T (/REMPROP DATUM 'ADDTOPRETTYCOM]
-                           [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE))
-                                               (T (/REMPROP DATUM 'DELFROMPRETTYCOM]
-                           [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE))
-                                               (T (/REMPROP DATUM 'PRETTYTYPE]
-                           [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE))
-                                               (T (/REMPROP DATUM 'FILEPKGCONTENTS]
-                           (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS]
-                                  (STANDARD [COND
-                                               [NEWVALUE (PUTASSOC DATUM NEWVALUE
-                                                                (OR (LISTP (GETTOPVAL 
-                                                                                  'PRETTYDEFMACROS))
-                                                                    (SETTOPVAL 'PRETTYDEFMACROS
-                                                                           (LIST (LIST DATUM]
-                                               (T (SETTOPVAL 'PRETTYDEFMACROS
-                                                         (REMOVE (FASSOC DATUM (GETTOPVAL
-                                                                                'PRETTYDEFMACROS))
-                                                                (GETTOPVAL 'PRETTYDEFMACROS]
-                                         UNDOABLE
-                                         (COND
-                                            [NEWVALUE (/PUTASSOC DATUM NEWVALUE
-                                                             (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
-                                                                 (/SETTOPVAL 'PRETTYDEFMACROS
-                                                                        (LIST (LIST DATUM]
-                                            (T (/SETTOPVAL 'PRETTYDEFMACROS
-                                                      (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.)

-                          (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
-                                       FILEPKGCONTENTS)))
-
-
-
-(ATOMRECORD FILEPKGTYPE
 (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
-                                   HASDEF EDITDEF FILEGETDEF CANFILEDEF)
-                            (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM))
-                                                           (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE))
-                                                           )
-                                                    (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST
-                                                                              DATUM)))
-                                                           (STANDARD (SETTOPVAL (CAR (
-                                                                                  SEARCHPRETTYTYPELST
-                                                                                      DATUM NEWVALUE)
-                                                                                     )
-                                                                            NEWVALUE)
-                                                                  UNDOABLE
-                                                                  (/SETTOPVAL (CAR (
-                                                                                  SEARCHPRETTYTYPELST
-                                                                                    DATUM NEWVALUE))
-                                                                         NEWVALUE)))
-                                                    (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST
-                                                                             DATUM)))
-                                                           (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST
-                                                                               DATUM NEWVALUE))
-                                                                       NEWVALUE)))
-                                                    (ALLFIELDS NIL (/SETTOPVAL
-                                                                    'PRETTYTYPELST
-                                                                    (REMOVE (SEARCHPRETTYTYPELST
-                                                                             DATUM)
-                                                                           (GETTOPVAL 'PRETTYTYPELST]
-                                                             (* 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
-                                                                                        'PROPTYPE
-                                                                                        'FILEPKGCOMS]
-                                         (ADDTOVAR PRETTYTYPELST))))
-
-
-(ATOMRECORD FILE
 (FILECHANGES FILEDATES FILEMAP)
-                     [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE)
-                                             (STANDARD (PUTPROP DATUM 'FILE NEWVALUE)
-                                                    UNDOABLE
-                                                    (/PUTPROP DATUM 'FILE NEWVALUE])
-
-(RECORD FILEDATEPAIR
 (FILEDATE . DATEFILENAME))
-
-(RECORD FILEPROP
 ((COMSNAME . LOADTYPE) . TOBEDUMPED))
-
-
-
-IL:STOP

lispusers/migration-tool/FILEPKGRECORDS.LCOM

@@ -1 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

lispusers/tmax/TMAX

@@ -1,13 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Oct-2021 23:45:20" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;4
 31402  
+
(FILECREATED "17-Mar-2022 23:12:47" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;3
 25981  
 
-      changes to%:  (VARS TMAXCOMS)
-                    (FNS GET.TSP.FONT.FAMILY)
+      :CHANGES-TO (VARS TMAXCOMS)
 
-      previous date%: "24-Oct-2021 22:06:32" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;2)
+      :PREVIOUS-DATE "24-Oct-2021 23:45:20" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;2)
 
 
 (* ; "
@@ -18,9 +16,9 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
 
 (RPAQQ TMAXCOMS

        (                                                     (* ; 
-
                                                 "Developed under support from NIH grant RR-00785.")

+
                                                   "Developed under support from NIH grant RR-00785.")

                                                              (* ; 
-
                                                       "Written by Frank Gilmurray and Sami Shaio.")

+
                                                         "Written by Frank Gilmurray and Sami Shaio.")

         (FILES (COMPILED SYSLOAD)
                TEDIT FREEMENU)
         (VARS TMAX.FILE.LIST)
@@ -59,18 +57,8 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
 
         (FNS TSP.LIST.OF.OBJECTS)
         (GLOBALVARS GP.DefaultFont GP.DefaultShade)
-        (MACROS MAKE.DATEOBJ.IMAGEFNS MAKE.NUMBEROBJ.IMAGEFNS MAKE.REGMARKOBJ.IMAGEFNS 
-               MAKE.XREFOBJ.IMAGEFNS)
         (VARS (GP.DefaultFont (FONTCREATE 'TERMINAL 10))
-              (GP.DefaultShade 1024)
-              (\NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
-              (\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
-              (\REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS))
-              (\XREFOBJ.IMAGEFNS (MAKE.XREFOBJ.IMAGEFNS)))
-        (ADDVARS (IMAGEOBJGETFNS (DATE.GETFN)
-                        (NUMBER.GETFN)
-                        (REGMARK.GETFN)
-                        (XREF.GETFN)))
+              (GP.DefaultShade 1024))
         (P [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)
                                                           NIL
                                                           (SUBITEMS (Update [FUNCTION
@@ -106,7 +94,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
        TEDIT FREEMENU)
 
 (RPAQQ TMAX.FILE.LIST
 (TMAX-DATE TMAX-ENDNOTE TMAX-INDEX TMAX-NUMBER TMAX-NGRAPH TMAX-NGROUP 
-                                 TMAX-XREF))
+                             TMAX-XREF))
 (DECLARE%: DONTCOPY 
 
 (DOFILESLOAD (LIST* '(SOURCE)
@@ -552,92 +540,16 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
 
 (GLOBALVARS GP.DefaultFont GP.DefaultShade)
 )
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS MAKE.DATEOBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
-                                                (IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
-                                                       (FUNCTION DATE.IMAGEBOXFN)
-                                                       (FUNCTION DATE.PUTFN)
-                                                       (FUNCTION DATE.GETFN)
-                                                       (FUNCTION DATE.COPYFN)
-                                                       (FUNCTION DATE.BUTTONEVENTINFN)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL])
-
-(PUTPROPS MAKE.NUMBEROBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
-                                                  (IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
-                                                         (FUNCTION NUMBER.IMAGEBOXFN)
-                                                         (FUNCTION NUMBER.PUTFN)
-                                                         (FUNCTION NUMBER.GETFN)
-                                                         (FUNCTION NUMBER.COPYFN)
-                                                         (FUNCTION NUMBER.BUTTONEVENTINFN)
-                                                         (FUNCTION NILL)
-                                                         (FUNCTION NILL)
-                                                         (FUNCTION NILL)
-                                                         (FUNCTION XREF.WHENDELETEDFN)
-                                                         (FUNCTION NILL)
-                                                         (FUNCTION NILL)
-                                                         (FUNCTION NUMBER.PREPRINTFN])
-
-(PUTPROPS MAKE.REGMARKOBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
-                                                   (IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
-                                                          (FUNCTION REGMARK.IMAGEBOXFN)
-                                                          (FUNCTION REGMARK.PUTFN)
-                                                          (FUNCTION REGMARK.GETFN)
-                                                          (FUNCTION REGMARK.COPYFN)
-                                                          (FUNCTION REGMARK.BUTTONEVENTINFN)
-                                                          (FUNCTION NILL)
-                                                          (FUNCTION NILL)
-                                                          (FUNCTION NILL)
-                                                          (FUNCTION NILL)
-                                                          (FUNCTION NILL)
-                                                          (FUNCTION NILL)
-                                                          (FUNCTION NILL])
-
-(PUTPROPS MAKE.XREFOBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
-                                                (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
-                                                       (FUNCTION XREF.IMAGEBOXFN)
-                                                       (FUNCTION XREF.PUTFN)
-                                                       (FUNCTION XREF.GETFN)
-                                                       (FUNCTION XREF.COPYFN)
-                                                       (FUNCTION XREF.BUTTONEVENTINFN)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION NILL)
-                                                       (FUNCTION XREF.GET.DISPLAY.TEXT])
-)
 
 (RPAQ GP.DefaultFont
 (FONTCREATE 'TERMINAL 10))
 
 (RPAQQ GP.DefaultShade
 1024)
 
-(RPAQ \NUMBEROBJ.IMAGEFNS
 (MAKE.NUMBEROBJ.IMAGEFNS))
-
-(RPAQ \DATEOBJ.IMAGEFNS
 (MAKE.DATEOBJ.IMAGEFNS))
-
-(RPAQ \REGMARKOBJ.IMAGEFNS
 (MAKE.REGMARKOBJ.IMAGEFNS))
-
-(RPAQ \XREFOBJ.IMAGEFNS
 (MAKE.XREFOBJ.IMAGEFNS))
-
-(ADDTOVAR IMAGEOBJGETFNS
 (DATE.GETFN)
-                             (NUMBER.GETFN)
-                             (REGMARK.GETFN)
-                             (XREF.GETFN))
-
 [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)
                                                NIL
                                                (SUBITEMS (Update [FUNCTION (LAMBDA (TEXTSTREAM)
-                                                                             (UPDATE.ALL

-                                                                              TEXTSTREAM
-                                                                              (\TEDIT.MAINW 
+                                                                             (UPDATE.ALL
 TEXTSTREAM
+                                                                                    (\TEDIT.MAINW
                                                                                      TEXTSTREAM]
                                                                 "Updates all cross-references")
                                                       (NGroup% Menu [FUNCTION (LAMBDA (TEXTSTREAM)
@@ -650,14 +562,14 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
 (TSP.FUNCTION.HOOKS
)
 (PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987 1997 1999))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8815 16030 (TSP.DISPLAY.FMMENU 8825 . 9390) (TSP.SETUP.FILENAMES 9392 . 10643) (
-TSP.SETUP.FMMENU 10645 . 11105) (TSP.FMMENU 11107 . 12293) (TSP.FM.APPLY 12295 . 12614) (UPDATE.ALL 
-12616 . 13288) (DOWNDATE.ALL 13290 . 13660) (TSP.FUNCTION.HOOKS 13662 . 15092) (TSP.GETFN 15094 . 
-15654) (TSP.PUTFN 15656 . 16028)) (16076 18325 (AutoUpdate.TOGGLE 16086 . 16322) (UPDATE? 16324 . 
-16469) (NGROUP.Menu.TOGGLE 16471 . 16853) (NGROUPMENU.ENABLED? 16855 . 17091) (
-NGROUP.Text-Before.TOGGLE 17093 . 17343) (TEXTBEFORE.ENABLED? 17345 . 17508) (NGROUP.Text-After.TOGGLE
- 17510 . 17758) (TEXTAFTER.ENABLED? 17760 . 17921) (Manual.Index.TOGGLE 17923 . 18162) (
-MANUALINDEX.ENABLED? 18164 . 18323)) (18359 23832 (GET.TSP.FONT 18369 . 19533) (GET.TSP.FONT.FAMILY 
-19535 . 20383) (GET.TSP.FONT.SIZE 20385 . 20873) (GET.TSP.FONT.FACE 20875 . 21574) (ABBREVIATE.FONT 
-21576 . 23076) (TMAX.SHADEOBJ 23078 . 23830)) (23872 25088 (TSP.LIST.OF.OBJECTS 23882 . 25086)))))
+  (FILEMAP (NIL (8231 15446 (TSP.DISPLAY.FMMENU 8241 . 8806) (TSP.SETUP.FILENAMES 8808 . 10059) (
+TSP.SETUP.FMMENU 10061 . 10521) (TSP.FMMENU 10523 . 11709) (TSP.FM.APPLY 11711 . 12030) (UPDATE.ALL 
+12032 . 12704) (DOWNDATE.ALL 12706 . 13076) (TSP.FUNCTION.HOOKS 13078 . 14508) (TSP.GETFN 14510 . 
+15070) (TSP.PUTFN 15072 . 15444)) (15492 17741 (AutoUpdate.TOGGLE 15502 . 15738) (UPDATE? 15740 . 
+15885) (NGROUP.Menu.TOGGLE 15887 . 16269) (NGROUPMENU.ENABLED? 16271 . 16507) (
+NGROUP.Text-Before.TOGGLE 16509 . 16759) (TEXTBEFORE.ENABLED? 16761 . 16924) (NGROUP.Text-After.TOGGLE
+ 16926 . 17174) (TEXTAFTER.ENABLED? 17176 . 17337) (Manual.Index.TOGGLE 17339 . 17578) (
+MANUALINDEX.ENABLED? 17580 . 17739)) (17775 23248 (GET.TSP.FONT 17785 . 18949) (GET.TSP.FONT.FAMILY 
+18951 . 19799) (GET.TSP.FONT.SIZE 19801 . 20289) (GET.TSP.FONT.FACE 20291 . 20990) (ABBREVIATE.FONT 
+20992 . 22492) (TMAX.SHADEOBJ 22494 . 23246)) (23288 24504 (TSP.LIST.OF.OBJECTS 23298 . 24502)))))
 STOP

lispusers/tmax/TMAX-DATE

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "24-Oct-2021 13:52:22" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX-DATE.;4|
 14231  
+
(FILECREATED "17-Mar-2022 23:03:32" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-DATE.;3|
 14993  
 
-      |changes| |to:|  (FNS FINDMONTH FINDTIME FINDHOUR AMPM CHANGE.DATE.FORMAT FINDYEAR)
-                       (VARS TMAX-DATECOMS)
+      :CHANGES-TO (VARS TMAX-DATECOMS)
+                  (FNS MAKE.DATEOBJ.IMAGEFNS)
 
-      |previous| |date:| "12-Mar-88 15:42:46" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX-DATE.;1|)
+      :PREVIOUS-DATE "24-Oct-2021 13:52:22" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-DATE.;2|)
 
 
 ; Copyright (c) 1987-1988 by Xerox Corporation.
@@ -35,6 +35,9 @@
 
         (FNS FINDTIME FINDHOUR AMPM FINDDAY NUMP FINDMONTH FINDYEAR)
         (VARS DATE.FORMAT.ITEMS)
+        (FNS MAKE.DATEOBJ.IMAGEFNS)
+        (INITVARS (\\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS)))
+        (ADDVARS (IMAGEOBJGETFNS (DATE.GETFN)))
         (DECLARE\: DOEVAL@COMPILE DONTCOPY (RECORDS DATERECORD))))
 
 
@@ -321,6 +324,28 @@
         (|Military Time| '(T E)
                "Insert current time as \"16:30\"")
         (|Update| T "Convert to current date/time")))
+(DEFINEQ
+
+(MAKE.DATEOBJ.IMAGEFNS

+  (LAMBDA NIL
                                               (* \; "Edited 17-Mar-2022 23:03 by rmk")

+    (IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
+           (FUNCTION DATE.IMAGEBOXFN)
+           (FUNCTION DATE.PUTFN)
+           (FUNCTION DATE.GETFN)
+           (FUNCTION DATE.COPYFN)
+           (FUNCTION DATE.BUTTONEVENTINFN)
+           (FUNCTION NILL)
+           (FUNCTION NILL)
+           (FUNCTION NILL)
+           (FUNCTION NILL)
+           (FUNCTION NILL)
+           (FUNCTION NILL)
+           (FUNCTION NILL))))
+)
+
+(RPAQ? \\DATEOBJ.IMAGEFNS
 (MAKE.DATEOBJ.IMAGEFNS))
+
+(ADDTOVAR IMAGEOBJGETFNS
 (DATE.GETFN))
 (DECLARE\: DOEVAL@COMPILE DONTCOPY 
 (DECLARE\: EVAL@COMPILE
 
@@ -329,10 +354,10 @@
 )
 (PUTPROPS TMAX-DATE COPYRIGHT ("Xerox Corporation" 1987 1988))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (1422 6156 (DATEOBJ 1432 . 2199) (DATEOBJP 2201 . 2635) (DATE.DISPLAYFN 2637 . 2959) (
-DATE.IMAGEBOXFN 2961 . 3588) (DATE.PUTFN 3590 . 3788) (DATE.GETFN 3790 . 4084) (DATE.COPYFN 4086 . 
-4618) (DATE.BUTTONEVENTINFN 4620 . 6154)) (6200 8853 (CURRENT.DISPLAY.FONT 6210 . 6916) (
-CHANGE.DATE.FORMAT 6918 . 8851)) (8906 13305 (FINDTIME 8916 . 10695) (FINDHOUR 10697 . 11058) (AMPM 
-11060 . 11359) (FINDDAY 11361 . 11632) (NUMP 11634 . 11863) (FINDMONTH 11865 . 12981) (FINDYEAR 12983
- . 13303)))))
+  (FILEMAP (NIL (1517 6251 (DATEOBJ 1527 . 2294) (DATEOBJP 2296 . 2730) (DATE.DISPLAYFN 2732 . 3054) (
+DATE.IMAGEBOXFN 3056 . 3683) (DATE.PUTFN 3685 . 3883) (DATE.GETFN 3885 . 4179) (DATE.COPYFN 4181 . 
+4713) (DATE.BUTTONEVENTINFN 4715 . 6249)) (6295 8948 (CURRENT.DISPLAY.FONT 6305 . 7011) (
+CHANGE.DATE.FORMAT 7013 . 8946)) (9001 13400 (FINDTIME 9011 . 10790) (FINDHOUR 10792 . 11153) (AMPM 
+11155 . 11454) (FINDDAY 11456 . 11727) (NUMP 11729 . 11958) (FINDMONTH 11960 . 13076) (FINDYEAR 13078
+ . 13398)) (14112 14678 (MAKE.DATEOBJ.IMAGEFNS 14122 . 14676)))))
 STOP

lispusers/tmax/TMAX-ENDNOTE

@@ -1,40 +1,56 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(filecreated "30-Dec-87 11:38:37" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-ENDNOTE.;2|
 22100  
 
-      |previous| |date:| "11-Nov-87 11:49:07" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-ENDNOTE.;1|)
+
(FILECREATED "18-Mar-2022 07:12:34" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-ENDNOTE.;4|
 23444  
+
+      :CHANGES-TO (VARS TMAX-ENDNOTECOMS)
+
+      :PREVIOUS-DATE "17-Mar-2022 23:10:26" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-ENDNOTE.;2|)
 
 
-; Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
+; Copyright (c) 1987 by Xerox Corporation.
 
-(prettycomprint tmax-endnotecoms)
+(PRETTYCOMPRINT TMAX-ENDNOTECOMS)
 
-(rpaqq tmax-endnotecoms
 ((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
-                         (* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
-                         (fns add.endnote insert.endnotes insert.endnotes.text delete.endnotes 
-                              notesregionp set.endnote.style map.endnote.looks get.endnote.fonts)
-                         (fns endnotep note.putfn note.getfn note.buttoneventinfn note.whenselectedfn
-                              )
-                         (vars endnote.notag.items endnote.tag.items)
-                         (records endnotefonts)
-                         (* * |Allow| |user| |to| |edit| |Endnote| |text| |in| |another| |TEdit| 
-                            |window.|)
-                         (fns aux.tedit aux.tedit.afterquitfn aux.tedit.titlemenufn)
-                         (* * |Delimit| |text| |between| |two| |markers| |known| |as| region markers.
-                            )
-                         (fns regmarkobj regmarkobjp regmark.displayfn regmark.imageboxfn 
-                              regmark.putfn regmark.getfn regmark.copyfn regmark.buttoneventinfn)
-                         (records regmarkobj)))
+(RPAQQ TMAX-ENDNOTECOMS

+       ((* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
+        (* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
+        (FNS ADD.ENDNOTE INSERT.ENDNOTES INSERT.ENDNOTES.TEXT DELETE.ENDNOTES NOTESREGIONP 
+             SET.ENDNOTE.STYLE MAP.ENDNOTE.LOOKS GET.ENDNOTE.FONTS)
+        (FNS ENDNOTEP NOTE.PUTFN NOTE.GETFN NOTE.BUTTONEVENTINFN NOTE.WHENSELECTEDFN)
+        (VARS ENDNOTE.NOTAG.ITEMS ENDNOTE.TAG.ITEMS)
+        (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS ENDNOTEFONTS))
+        (* * |Allow| |user| |to| |edit| |Endnote| |text| |in| |another| |TEdit| |window.|)
+        (FNS AUX.TEDIT AUX.TEDIT.AFTERQUITFN AUX.TEDIT.TITLEMENUFN)
+        (* * |Delimit| |text| |between| |two| |markers| |known| |as| REGION MARKERS.)
+        (FNS REGMARKOBJ REGMARKOBJP REGMARK.DISPLAYFN REGMARK.IMAGEBOXFN REGMARK.PUTFN REGMARK.GETFN
+             REGMARK.COPYFN REGMARK.BUTTONEVENTINFN)
+        (INITVARS (\\REGMARKOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
+                                                (FUNCTION REGMARK.IMAGEBOXFN)
+                                                (FUNCTION REGMARK.PUTFN)
+                                                (FUNCTION REGMARK.GETFN)
+                                                (FUNCTION REGMARK.COPYFN)
+                                                (FUNCTION REGMARK.BUTTONEVENTINFN)
+                                                (FUNCTION NILL)
+                                                (FUNCTION NILL)
+                                                (FUNCTION NILL)
+                                                (FUNCTION NILL)
+                                                (FUNCTION NILL)
+                                                (FUNCTION NILL)
+                                                (FUNCTION NILL))))
+        (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS REGMARKOBJ))))
 
 
 
-(* |Developed| |under| |support| |from| nih |grant| rr-00785.)

+(* |Developed| |under| |support| |from| NIH |grant| RR-00785.)

 
 
 
 
 (* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)

 
-(defineq
+(DEFINEQ
 
 (add.endnote

   (lambda (stream window)
                                    (* |fsg| "13-Jul-87 10:44")

@@ -192,7 +208,7 @@
                              text.font _ |GP.DefaultFont|))
                (windowprop window 'endnote.fonts)))))
 )
-(defineq
+(DEFINEQ
 
 (endnotep

   (lambda (imobj)
                                            (* |ss:| "27-Jun-87 15:23")

@@ -269,20 +285,22 @@
           nil)))
 )
 
-(rpaqq endnote.notag.items
 ((|Edit Text| |Edit Text| "Edit the text associated with this EndNote.")
+(RPAQQ ENDNOTE.NOTAG.ITEMS
 ((|Edit Text| |Edit Text| "Edit the text associated with this EndNote.")
                             (|Define Tag| |Define Tag| "Define a TAG for this EndNote.")))
 
-(rpaqq endnote.tag.items
 ((|Edit Text| |Edit Text| "Edit the text associated with this EndNote.")
+(RPAQQ ENDNOTE.TAG.ITEMS
 ((|Edit Text| |Edit Text| "Edit the text associated with this EndNote.")
                           (|Change Tag| |Change Tag| "Change this EndNote's TAG.")
                           (|Delete Tag| |Delete Tag| "Delete this EndNote's TAG.")
                           (|Show Tag| |Show Tag| "Show this EndNote's TAG.")))
-(declare\: eval@compile
+(DECLARE\: EVAL@COMPILE DONTCOPY 
+(DECLARE\: EVAL@COMPILE
 
-(record endnotefonts
 (number.font title.font text.font))
+(RECORD ENDNOTEFONTS
 (NUMBER.FONT TITLE.FONT TEXT.FONT))
+)
 )
 (* * |Allow| |user| |to| |edit| |Endnote| |text| |in| |another| |TEdit| |window.|)

 
-(defineq
+(DEFINEQ
 
 (aux.tedit

   (lambda (imobj title stream)
                               (* |ss:| "27-Jun-87 15:22")

@@ -327,9 +345,9 @@
                               nil)
                           (tedit.quit (textstream auxwindow)))))))
 )
-(* * |Delimit| |text| |between| |two| |markers| |known| |as| region markers.)

+(* * |Delimit| |text| |between| |two| |markers| |known| |as| REGION MARKERS.)

 
-(defineq
+(DEFINEQ
 
 (regmarkobj

   (lambda (use marking)
                                      (* |fsg| "10-Jul-87 15:58")

@@ -404,19 +422,36 @@
                                                   (t "")))
                      t)))))
 )
-(declare\: eval@compile
 
-(record regmarkobj
 (region.use marking))
+(RPAQ? \\REGMARKOBJ.IMAGEFNS

+       (IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
+              (FUNCTION REGMARK.IMAGEBOXFN)
+              (FUNCTION REGMARK.PUTFN)
+              (FUNCTION REGMARK.GETFN)
+              (FUNCTION REGMARK.COPYFN)
+              (FUNCTION REGMARK.BUTTONEVENTINFN)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)))
+(DECLARE\: EVAL@COMPILE DONTCOPY 
+(DECLARE\: EVAL@COMPILE
+
+(RECORD REGMARKOBJ
 (REGION.USE MARKING))
 )
-(putprops tmax-endnote copyright ("Xerox Corporation" 1987))
-(declare\: dontcopy
-  (filemap (nil (1726 11353 (add.endnote 1736 . 2404) (insert.endnotes 2406 . 4609) (
-insert.endnotes.text 4611 . 6040) (delete.endnotes 6042 . 7033) (notesregionp 7035 . 7297) (
-set.endnote.style 7299 . 9972) (map.endnote.looks 9974 . 10741) (get.endnote.fonts 10743 . 11351)) (
-11354 15269 (endnotep 11364 . 11705) (note.putfn 11707 . 12359) (note.getfn 12361 . 12941) (
-note.buttoneventinfn 12943 . 13723) (note.whenselectedfn 13725 . 15267)) (15991 18395 (aux.tedit 16001
- . 16963) (aux.tedit.afterquitfn 16965 . 17408) (aux.tedit.titlemenufn 17410 . 18393)) (18480 21944 (
-regmarkobj 18490 . 18897) (regmarkobjp 18899 . 19093) (regmark.displayfn 19095 . 19341) (
-regmark.imageboxfn 19343 . 19694) (regmark.putfn 19696 . 20028) (regmark.getfn 20030 . 20329) (
-regmark.copyfn 20331 . 20869) (regmark.buttoneventinfn 20871 . 21942)))))
-stop
+)
+(PUTPROPS TMAX-ENDNOTE COPYRIGHT ("Xerox Corporation" 1987))
+(DECLARE\: DONTCOPY
+  (FILEMAP (NIL (2489 12116 (ADD.ENDNOTE 2499 . 3167) (INSERT.ENDNOTES 3169 . 5372) (
+INSERT.ENDNOTES.TEXT 5374 . 6803) (DELETE.ENDNOTES 6805 . 7796) (NOTESREGIONP 7798 . 8060) (
+SET.ENDNOTE.STYLE 8062 . 10735) (MAP.ENDNOTE.LOOKS 10737 . 11504) (GET.ENDNOTE.FONTS 11506 . 12114)) (
+12117 16032 (ENDNOTEP 12127 . 12468) (NOTE.PUTFN 12470 . 13122) (NOTE.GETFN 13124 . 13704) (
+NOTE.BUTTONEVENTINFN 13706 . 14486) (NOTE.WHENSELECTEDFN 14488 . 16030)) (16790 19194 (AUX.TEDIT 16800
+ . 17762) (AUX.TEDIT.AFTERQUITFN 17764 . 18207) (AUX.TEDIT.TITLEMENUFN 18209 . 19192)) (19279 22743 (
+REGMARKOBJ 19289 . 19696) (REGMARKOBJP 19698 . 19892) (REGMARK.DISPLAYFN 19894 . 20140) (
+REGMARK.IMAGEBOXFN 20142 . 20493) (REGMARK.PUTFN 20495 . 20827) (REGMARK.GETFN 20829 . 21128) (
+REGMARK.COPYFN 21130 . 21668) (REGMARK.BUTTONEVENTINFN 21670 . 22741)))))
+STOP

lispusers/tmax/TMAX-NUMBER

@@ -1,20 +1,22 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 6-May-2000 10:37:14" |{DSK}<project>medley3.5>lispusers>TMAX-NUMBER.;4|
 32399  
 
-      |changes| |to:|  (FNS NUMBEROBJ.TEDIT-TO-TEX-FN NUMBEROBJ)
-                       (VARS TMAX-NUMBERCOMS)
+
(FILECREATED "18-Mar-2022 07:06:06" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-NUMBER.;8|
 33934  
 
-      |previous| |date:| "18-May-99 22:54:30" |{DSK}<project>medley3.5>lispusers>TMAX-NUMBER.;2|)
+      :CHANGES-TO (VARS TMAX-NUMBERCOMS)
+
+      :PREVIOUS-DATE "17-Mar-2022 23:33:32" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-NUMBER.;7|)
 
 
-; Copyright (c) 1987, 1999, 2000 by Xerox Corporation.  All rights reserved.
+; Copyright (c) 1987, 1999-2000 by Xerox Corporation.
 
 (PRETTYCOMPRINT TMAX-NUMBERCOMS)
 
 (RPAQQ TMAX-NUMBERCOMS

        ((* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
         (* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
-        (* * TMAX-NUMBERNIL |ImageObject| |functions|)
+        (* * TMAX-NUMBER |ImageObject| |functions|)
         (FNS NUMBEROBJ NUMBEROBJP NGROUPP NUMBER.DISPLAYFN NUMBER.PREPRINTFN NUMBER.IMAGEBOXFN 
              NUMBER.PUTFN NUMBER.GETFN NUMBER.COPYFN NUMBER.BUTTONEVENTINFN NUMBEROBJ.TEDIT-TO-TEX-FN
              )
@@ -24,7 +26,22 @@
         (* * |Variable| |and| |Record| |definitions|)
         (VARS NGROUP.GRAPH.MENU.ITEMS NGROUP.INSERTED.MENU.ITEMS NGROUP.INSERTED.NOTAG.ITEMS 
               NGROUP.INSERTED.TAG.ITEMS)
-        (RECORDS NGCOUNTER NGTEMPLATE NUMBEROBJ)))
+        (FILES (COMPILED SYSLOAD)
+               TMAX)
+        (INITVARS (\\NUMBEROBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
+                                               (FUNCTION NUMBER.IMAGEBOXFN)
+                                               (FUNCTION NUMBER.PUTFN)
+                                               (FUNCTION NUMBER.GETFN)
+                                               (FUNCTION NUMBER.COPYFN)
+                                               (FUNCTION NUMBER.BUTTONEVENTINFN)
+                                               (FUNCTION NILL)
+                                               (FUNCTION NILL)
+                                               (FUNCTION NILL)
+                                               (FUNCTION XREF.WHENDELETEDFN)
+                                               (FUNCTION NILL)
+                                               (FUNCTION NILL)
+                                               (FUNCTION NUMBER.PREPRINTFN))))
+        (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS NGCOUNTER NGTEMPLATE NUMBEROBJ))))
 
 
 
@@ -35,7 +52,7 @@
 
 (* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)

 
-(* * TMAX-NUMBERNIL |ImageObject| |functions|)

+(* * TMAX-NUMBER |ImageObject| |functions|)

 
 (DEFINEQ
 
@@ -533,32 +550,52 @@
                "Show this NGroup's FORMAT.")))
 
 (RPAQQ NGROUP.INSERTED.NOTAG.ITEMS
 ((|Define Tag| (NGROUP.DEFINE.TAG REF.TYPE WINDOW NGROUP.OBJ)
-                                               "Define a TAG for this NGroup.")))
+                                           "Define a TAG for this NGroup.")))
 
 (RPAQQ NGROUP.INSERTED.TAG.ITEMS
 ((|Change Tag| (NGROUP.DEFINE.TAG REF.TYPE WINDOW NGROUP.OBJ)
-                                             "Change this NGroup's TAG.")
-                                      (|Delete Tag| (NUMBER.DELETE.TAG WINDOW NGROUP.OBJ)
-                                             "Delete this NGroup's TAG.")
-                                      (|Show Tag| (NGROUP.SHOW.TAG REF.TYPE WINDOW NGROUP.OBJ)
-                                             "Show this NGroup's TAG.")))
+                                         "Change this NGroup's TAG.")
+                                  (|Delete Tag| (NUMBER.DELETE.TAG WINDOW NGROUP.OBJ)
+                                         "Delete this NGroup's TAG.")
+                                  (|Show Tag| (NGROUP.SHOW.TAG REF.TYPE WINDOW NGROUP.OBJ)
+                                         "Show this NGroup's TAG.")))
+
+(FILESLOAD (COMPILED SYSLOAD)
+       TMAX)
+
+(RPAQ? \\NUMBEROBJ.IMAGEFNS

+       (IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
+              (FUNCTION NUMBER.IMAGEBOXFN)
+              (FUNCTION NUMBER.PUTFN)
+              (FUNCTION NUMBER.GETFN)
+              (FUNCTION NUMBER.COPYFN)
+              (FUNCTION NUMBER.BUTTONEVENTINFN)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION XREF.WHENDELETEDFN)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NUMBER.PREPRINTFN)))
+(DECLARE\: EVAL@COMPILE DONTCOPY 
 (DECLARE\: EVAL@COMPILE
 
 (RECORD NGCOUNTER
 (NCOUNT . ANCESTRY))
 
 (RECORD NGTEMPLATE
 (NG.CHARTYPE NG.TEXT-AFTER NG.START NG.ADDTOTOC NG.CURRENTVAL NG.MANUALINDEX 
-                              NG.TEXT-BEFORE))
+                          NG.TEXT-BEFORE))
 
-(RECORD NUMBEROBJ
 (REF.TYPE NUMSTRING USE NGROUP.MOTHER TEMPLATE UPDATED.OBJ TEXT.AFTER# 
-                             PAGE.NUMBER FONT TEXT.BEFORE# ABBREV-VAL))
+(RECORD NUMBEROBJ
 (REF.TYPE NUMSTRING USE NGROUP.MOTHER TEMPLATE UPDATED.OBJ TEXT.AFTER# PAGE.NUMBER
+                         FONT TEXT.BEFORE# ABBREV-VAL))
+)
 )
 (PUTPROPS TMAX-NUMBER COPYRIGHT ("Xerox Corporation" 1987 1999 2000))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (1599 17297 (NUMBEROBJ 1609 . 2715) (NUMBEROBJP 2717 . 3257) (NGROUPP 3259 . 3613) (
-NUMBER.DISPLAYFN 3615 . 6654) (NUMBER.PREPRINTFN 6656 . 7700) (NUMBER.IMAGEBOXFN 7702 . 10195) (
-NUMBER.PUTFN 10197 . 11281) (NUMBER.GETFN 11283 . 13419) (NUMBER.COPYFN 13421 . 15118) (
-NUMBER.BUTTONEVENTINFN 15120 . 17025) (NUMBEROBJ.TEDIT-TO-TEX-FN 17027 . 17295)) (17298 26469 (
-COPY.NGROUP.BRANCH 17308 . 18764) (DUMP.NGROUP.GRAPH 18766 . 19642) (NGROUP.BUTTONEVENTINFN 19644 . 
-20344) (NGROUP.DEFINE.TAG 20346 . 20949) (NUMBER.DELETE.TAG 20951 . 21210) (NGROUP.SHOW.TAG 21212 . 
-21534) (CHANGE.INSERTED.NGROUP.FORMAT 21536 . 23331) (CHANGE.NGROUP.FORMAT.#TEXT 23333 . 24919) (
-SHOW.INSERTED.NGROUP.FORMAT 24921 . 26467)))))
+  (FILEMAP (NIL (2558 18256 (NUMBEROBJ 2568 . 3674) (NUMBEROBJP 3676 . 4216) (NGROUPP 4218 . 4572) (
+NUMBER.DISPLAYFN 4574 . 7613) (NUMBER.PREPRINTFN 7615 . 8659) (NUMBER.IMAGEBOXFN 8661 . 11154) (
+NUMBER.PUTFN 11156 . 12240) (NUMBER.GETFN 12242 . 14378) (NUMBER.COPYFN 14380 . 16077) (
+NUMBER.BUTTONEVENTINFN 16079 . 17984) (NUMBEROBJ.TEDIT-TO-TEX-FN 17986 . 18254)) (18257 27428 (
+COPY.NGROUP.BRANCH 18267 . 19723) (DUMP.NGROUP.GRAPH 19725 . 20601) (NGROUP.BUTTONEVENTINFN 20603 . 
+21303) (NGROUP.DEFINE.TAG 21305 . 21908) (NUMBER.DELETE.TAG 21910 . 22169) (NGROUP.SHOW.TAG 22171 . 
+22493) (CHANGE.INSERTED.NGROUP.FORMAT 22495 . 24290) (CHANGE.NGROUP.FORMAT.#TEXT 24292 . 25878) (
+SHOW.INSERTED.NGROUP.FORMAT 25880 . 27426)))))
 STOP

lispusers/tmax/TMAX-XREF

@@ -1,26 +1,29 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 6-May-2000 14:26:45" |{DSK}<project>medley3.5>lispusers>TMAX-XREF.;3|
 22168  
 
-      |changes| |to:|  (FNS XREF.TEDIT-TO-TEX-FN)
+
(FILECREATED "18-Mar-2022 07:07:27" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;5|
 23662  
 
-      |previous| |date:| " 6-May-2000 10:40:07" |{DSK}<project>medley3.5>lispusers>TMAX-XREF.;2|)
+      :CHANGES-TO (VARS TMAX-XREFCOMS)
+
+      :PREVIOUS-DATE "17-Mar-2022 23:36:37" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;4|)
 
 
-; Copyright (c) 1987, 1997, 2000 by Xerox Corporation.  All rights reserved.
+; Copyright (c) 1987, 1997, 2000 by Xerox Corporation.
 
 (PRETTYCOMPRINT TMAX-XREFCOMS)
 
 (RPAQQ TMAX-XREFCOMS

-       (                                                     (* \; 
-
                                                 "Developed under support from NIH grant RR-00785.")

-                                                             (* \; 
-
                                                       "Written by Frank Gilmurray and Sami Shaio.")

+       (                                                     (* \; 
+
                                                   "Developed under support from NIH grant RR-00785.")

+                                                             (* \; 
+
                                                         "Written by Frank Gilmurray and Sami Shaio.")

         
-        (* |;;| "An XREF is a general-purpose cross-referencing imageobject.  In order to create an instance of an XREF one simply calls the function XREF with a TAG that is supposed to link it with some imageobject that it is referencing.  In order to add to the class of imageobjects that can be referenced with XREF one uses the function XREF.ADD.DISPLAYFN with the type of the imageobject and a function that operates on it to return some string that XREF will then display in the document.")

+        (* |;;| "An XREF is a general-purpose cross-referencing imageobject.  In order to create an instance of an XREF one simply calls the function XREF with a TAG that is supposed to link it with some imageobject that it is referencing.  In order to add to the class of imageobjects that can be referenced with XREF one uses the function XREF.ADD.DISPLAYFN with the type of the imageobject and a function that operates on it to return some string that XREF will then display in the document.")

 
         
 
-(* |;;;| "TMAX-XREFNIL Image Object functions")

+(* |;;;| "TMAX-XREFNIL Image Object functions")

 
         (FNS XREF XREFP XREF.DISPLAYFN XREF.IMAGEBOXFN XREF.PUTFN XREF.GETFN XREF.COPYFN 
              XREF.BUTTONEVENTINFN XREF.WHENDELETEDFN XREF.TEDIT-TO-TEX-FN)
@@ -29,15 +32,30 @@
              TSP.GETCODEVAL TSP.PUTCODE)
         
 
-(* |;;;| "Functions for adding and retrieving the method for a gven imageobject.")

+(* |;;;| "Functions for adding and retrieving the method for a gven imageobject.")

 
         (FNS XREF.ADD.DISPLAYFN XREF.GET.DISPLAYFN)
         
 
-(* |;;;| "Examples of some XREF display methods.")

+(* |;;;| "Examples of some XREF display methods.")

 
         (FNS NGROUP.XREF.DISPLAYFN NGROUP.XREF.DISPLAY.TEXT NOTE.XREF.DISPLAYFN)
-        (UGLYVARS XREF.DISPLAY.METHODS)))
+        (INITVARS (\\XREFOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
+                                             (FUNCTION XREF.IMAGEBOXFN)
+                                             (FUNCTION XREF.PUTFN)
+                                             (FUNCTION XREF.GETFN)
+                                             (FUNCTION XREF.COPYFN)
+                                             (FUNCTION XREF.BUTTONEVENTINFN)
+                                             (FUNCTION NILL)
+                                             (FUNCTION NILL)
+                                             (FUNCTION NILL)
+                                             (FUNCTION NILL)
+                                             (FUNCTION NILL)
+                                             (FUNCTION NILL)
+                                             (FUNCTION XREF.GET.DISPLAY.TEXT))))
+        (UGLYVARS XREF.DISPLAY.METHODS)
+        (FILES (COMPILED SYSLOAD)
+               TMAX)))
 
 
 
@@ -437,19 +455,37 @@
               (t (concat "<" numstring "/" reference.by ">"))))))
 )
 
+(RPAQ? \\XREFOBJ.IMAGEFNS

+       (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
+              (FUNCTION XREF.IMAGEBOXFN)
+              (FUNCTION XREF.PUTFN)
+              (FUNCTION XREF.GETFN)
+              (FUNCTION XREF.COPYFN)
+              (FUNCTION XREF.BUTTONEVENTINFN)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION NILL)
+              (FUNCTION XREF.GET.DISPLAY.TEXT)))
+
 (READVARS-FROM-STRINGS '(XREF.DISPLAY.METHODS)
-       "({H(24 ERROR) 2 NOTE.XREF.DISPLAYFN NOTE NGROUP.XREF.DISPLAYFN NGROUP })
+       "({H(24 ERROR) 2 NGROUP.XREF.DISPLAYFN NGROUP NOTE.XREF.DISPLAYFN NOTE })
 ")
+
+(FILESLOAD (COMPILED SYSLOAD)
+       TMAX)
 (PUTPROPS TMAX-XREF COPYRIGHT ("Xerox Corporation" 1987 1997 2000))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (2764 10100 (XREF 2774 . 3341) (XREFP 3343 . 3730) (XREF.DISPLAYFN 3732 . 4166) (
-XREF.IMAGEBOXFN 4168 . 4820) (XREF.PUTFN 4822 . 5068) (XREF.GETFN 5070 . 5544) (XREF.COPYFN 5546 . 
-6156) (XREF.BUTTONEVENTINFN 6158 . 9150) (XREF.WHENDELETEDFN 9152 . 9649) (XREF.TEDIT-TO-TEX-FN 9651
- . 10098)) (10101 12085 (XREF.GET.DISPLAY.TEXT 10111 . 11395) (XREF.GET.TOOBJ 11397 . 11934) (
-TSPOBJ.GETTYPE 11936 . 12083)) (12086 18460 (UPDATE.XREFS 12096 . 14479) (INSERT.REF 14481 . 14893) (
-GET.REF 14895 . 15950) (GET.REFERENCE.BY 15952 . 16939) (TSP.LIST.REFS 16941 . 17393) (TSP.GET.INCODE 
-17395 . 18049) (TSP.GETCODEVAL 18051 . 18273) (TSP.PUTCODE 18275 . 18458)) (18552 19523 (
-XREF.ADD.DISPLAYFN 18562 . 19076) (XREF.GET.DISPLAYFN 19078 . 19521)) (19583 21945 (
-NGROUP.XREF.DISPLAYFN 19593 . 20553) (NGROUP.XREF.DISPLAY.TEXT 20555 . 21191) (NOTE.XREF.DISPLAYFN 
-21193 . 21943)))))
+  (FILEMAP (NIL (3709 11045 (XREF 3719 . 4286) (XREFP 4288 . 4675) (XREF.DISPLAYFN 4677 . 5111) (
+XREF.IMAGEBOXFN 5113 . 5765) (XREF.PUTFN 5767 . 6013) (XREF.GETFN 6015 . 6489) (XREF.COPYFN 6491 . 
+7101) (XREF.BUTTONEVENTINFN 7103 . 10095) (XREF.WHENDELETEDFN 10097 . 10594) (XREF.TEDIT-TO-TEX-FN 
+10596 . 11043)) (11046 13030 (XREF.GET.DISPLAY.TEXT 11056 . 12340) (XREF.GET.TOOBJ 12342 . 12879) (
+TSPOBJ.GETTYPE 12881 . 13028)) (13031 19405 (UPDATE.XREFS 13041 . 15424) (INSERT.REF 15426 . 15838) (
+GET.REF 15840 . 16895) (GET.REFERENCE.BY 16897 . 17884) (TSP.LIST.REFS 17886 . 18338) (TSP.GET.INCODE 
+18340 . 18994) (TSP.GETCODEVAL 18996 . 19218) (TSP.PUTCODE 19220 . 19403)) (19497 20468 (
+XREF.ADD.DISPLAYFN 19507 . 20021) (XREF.GET.DISPLAYFN 20023 . 20466)) (20528 22890 (
+NGROUP.XREF.DISPLAYFN 20538 . 21498) (NGROUP.XREF.DISPLAY.TEXT 21500 . 22136) (NOTE.XREF.DISPLAYFN 
+22138 . 22888)))))
 STOP