Merge branch 'master' into mth2--GITFNS-for-personal-repo

* Add to APPS-INIT code to always update NOTECARDSDIRECTORIES since automatic builds do not set this correctly

* Add AROUNDEXITFN to reset NOTECARDSDIRS after returning from logout, etc.

greetfiles/APPS-INIT

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Jun-2023 17:20:09" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;11
 21130  
+
(FILECREATED "25-Feb-2024 13:56:23" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;17
 23321  
 
-      :CHANGES-TO (FNS Apps.DoInit)
+      :CHANGES-TO (VARS APPS-INITCOMS)
+                  (FNS Apps.DoInit Apps.AroundExitFn)
 
-      :PREVIOUS-DATE "19-Jan-2023 12:44:20" 
-{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;10)
+      :PREVIOUS-DATE "25-Feb-2024 13:14:02" 
+{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;16)
 
 
 (PRETTYCOMPRINT APPS-INITCOMS)
@@ -16,8 +17,9 @@
         (GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
         (INITVARS (Apps.NotecardsActivated NIL)
                (Apps.RoomsActivated NIL))
-        (FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS 
-             Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP)
+        (FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons 
+             Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc 
+             XCL-USER::EXEC_INTERLISP Apps.AroundExitFn)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
         (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
 
@@ -90,6 +92,33 @@
           (if
 (NOT DoNotRefreshButtons)
               then
 (Apps.CreateButtons
])
 
+(Apps.SetUpNOTECARDSDIRECTORIES

+  [LAMBDA NIL
+
+    (* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")

+
+    (* ;; " This is needed to make sure that lazy loading of Notecard types works.")

+
+    (LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
+           (LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
+           (LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
+           (NCDIR (for
 LOC in
 (LIST LOC1 LOC2 LOC3) thereis
 (OR (INFILEP (CONCAT LOC 
+                                                                                "system>NOTECARDS"))
+                                                                (INFILEP (CONCAT LOC 
+                                                                              "system>NOTECARDS.LCOM"
+                                                                                ]
+          (if
 NCDIR
+              then
 [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
+                                   (INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
+                   (SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
+                                                         1)))
+                   (NC.SetUpNOTECARDSDIRECTORIES NCDIR)
+                   T
+            else
 (PRIN1 "Warning: Notecards directory could not be found." T)
+                 (PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
+                 (PRIN1 "and Notecards will not work properly." T)
+                 NIL])
+
 (Apps.DoInit

   [LAMBDA NIL
 
@@ -173,7 +202,16 @@
 
            (* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")

 
-           (SETTOPVAL '\NC.SourceAccessFlg NIL])
+           (SETTOPVAL '\NC.SourceAccessFlg NIL)
+
+           (* ;; "Setup NOTECARDSDIRECTORIES.")

+
+           (Apps.SetUpNOTECARDSDIRECTORIES
)
+
+           (* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")

+
+           (SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
+                                      'MEDLEY-INIT-VARS AROUNDEXITFNS])
 
 (Apps.CreateButtons

   [LAMBDA (DoDocsToo)
                                      (* ; "Edited 13-Dec-2022 12:51 by frank")


@@ -366,6 +404,11 @@
                                                         YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
            (XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
            (XCL:SET-EXEC-TYPE 'INTERLISP])
+
+(Apps.AroundExitFn

+  [LAMBDA (EVENT)
+    (if
 (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
+        then
 (Apps.SetUpNOTECARDSDIRECTORIES
])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
@@ -376,8 +419,8 @@
 (BKSYSBUF " ")
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) (
-Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) (
-Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994
-)))))
+  (FILEMAP (NIL (1229 23187 (Apps.InitNotecards 1239 . 5101) (Apps.SetUpNOTECARDSDIRECTORIES 5103 . 6658
+) (Apps.DoInit 6660 . 10257) (Apps.CreateButtons 10259 . 19083) (Apps.CreateLabel 19085 . 19895) (
+Apps.ActivateCLOS 19897 . 21246) (Apps.ActivateRooms 21248 . 22099) (Apps.ShowDoc 22101 . 22250) (
+XCL-USER::EXEC_INTERLISP 22252 . 23024) (Apps.AroundExitFn 23026 . 23185)))))
 STOP

library/DATABASEFNS

@@ -1,14 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7
 16051  
+
(FILECREATED "20-Feb-2024 23:45:56" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4
 18445  
 
-      changes to%:  (FNS DUMPDB)
+      :EDIT-BY "mth"
 
-      previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
+      :CHANGES-TO (FNS DUMPDB)
+
+      :PREVIOUS-DATE "19-Feb-2024 16:29:44" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
 
 
 (* ; "
-Copyright (c) 1986, 1990-1993 by Xerox Corporation.
+Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -31,7 +33,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
         (INITVARS (LOADDBFLG 'ASK)
                (SAVEDBFLG 'ASK))
         (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
-        (INITVARS (MSFILETABLE))
+        (INITVARS (MSFILETABLE)
+               (DEFAULTDATABASECOPYRIGHTOWNER 'NEVER))
                                                              (* ; "To permit MSHASH interface")

         (LOCALVARS . T)
         (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
@@ -161,52 +164,85 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 (DEFINEQ
 
 (DUMPDB

-  [LAMBDA (FILE PROPFLG)                                     (* ; 
-
                                                           "Edited 27-Oct-2021 10:51 by larry")

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

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


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


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


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

 
     (* ;; "Dumps a Masterscope database for functions in FILE.  Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it.  A user-level call would default PROPFLG to NIL.")

 
-    (* ;; 
-
  "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

+    (* ;; "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

 
-    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG))
+    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER)
+           (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER))
     (CL:WHEN (AND FILE (OR (LITATOM FILE)
                            (STRINGP FILE)))
-        (PROG (DBFILE
 (FL (NAMEFIELD FILE))
-                     (FNS (FILEFNSLST FILE)))
-              (COND
-                 (FNS)
-                 ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
+        (LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
+              (SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
+             (CL:UNWIND-PROTECT
+                 (PROG (DBFILE
 DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
+                              (FNS (FILEFNSLST FILE)))
+                       (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
+                       (SETQ DBROOTFN (ROOTFILENAME DBFN))
+                       (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
+                                      (NULL DEFAULTDATABASECOPYRIGHTOWNER)
+                                      (GETPROP DBROOTFN 'COPYRIGHT))
+                           (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
+                               ((NONE NEVER) 
+                                             (* ;; 
+
                                          "Set the COPYRIGHT to NONE (I.e., never mention it again.)")

+
+                                    (/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE)))
+                               (SAME 
+                                     (* ;; 
+
                         "Same as the source file. If it doesn't have one, then just normal handling")

+
+                                     (CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
+                                         (/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
+                               (DEFAULT 
+                                        (* ;; "Use the general default for copyright")

+
+                                        (SETQ COPYRIGHTFLG 'DEFAULT))
+                               (PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
+
+                                      (* ;; 
+
                        "Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys")

+
+                                      (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
+                       (COND
+                          (FNS)
+                          ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
                                                              (* ; 
-
                                                           "Always dump if this is a known file")

-                  (SETQ PROPFLG NIL))
-                 (T (COND
-                       (PROPFLG (/REMPROP FL 'DATABASE))
-                       (T (printout T T FILE " has no functions." T)))
-                    (RETURN)))
-              (CL:WHEN [OR (NULL PROPFLG)
-                           (EQ (GETPROP FL 'DATABASE)
-                               'YES)
-                           (EQ SAVEDBFLG 'YES)
-                           (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
-                  (CL:WHEN MSFILETABLE
-                      [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
-                  [SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
-                                                     'BODY FILE)
-                                      `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
-                                                  (ERROR!)))
-                                        (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
-                                           (DUMPDATABASE ',FNS]
-                  [COND
-                     (PROPFLG (PRINT (FULLNAME DBFILE)
-                                     T))
-                     (T (/PUT FL 'DATABASEFILENAME DBFILE)   (* ; 
-
                                                   "Remember that we have this file valid already.")

-                        (/PUT FL 'DATABASE 'YES]             (* ; 
-
                                                   "Take future note of the databae on a user call")

-                  (RETURN DBFILE))))])
+
                                                             "Always dump if this is a known file")

+                           (SETQ PROPFLG NIL))
+                          (T (COND
+                                (PROPFLG (/REMPROP FL 'DATABASE))
+                                (T (printout T T FILE " has no functions." T)))
+                             (RETURN)))
+                       (CL:WHEN [OR (NULL PROPFLG)
+                                    (EQ (GETPROP FL 'DATABASE)
+                                        'YES)
+                                    (EQ SAVEDBFLG 'YES)
+                                    (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
+                           (CL:WHEN MSFILETABLE
+                               [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
+                           [SETQ DBFILE
+                            (PRETTYDEF NIL DBFN
+                                   `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
+                                               (ERROR!)))
+                                     (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
+                                        (DUMPDATABASE ',FNS]
+                           [COND
+                              (PROPFLG (PRINT (FULLNAME DBFILE)
+                                              T))
+                              (T (/PUT FL 'DATABASEFILENAME DBFILE)
+                                                             (* ; 
+
                                                     "Remember that we have this file valid already.")

+                                 (/PUT FL 'DATABASE 'YES]    (* ; 
+
                                                    "Take future note of the database on a user call")

+                           (RETURN DBFILE))))
+             (SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG)
+             (SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))])
 
 (LOADDB

   [LAMBDA (FILE ASKFLAG)
                                (* ; "Edited 24-Oct-2021 17:44 by rmk:")


@@ -321,6 +357,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RPAQ? MSFILETABLE
 )
 
+(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER
 'NEVER)
+
 
 
 (* ; "To permit MSHASH interface")

@@ -337,9 +375,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RESETSAVE DWIMIFYCOMPFLG T)
 )
-(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
+(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072
- . 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536
- . 14411) (MAKEDB 14413 . 15497)))))
+  (FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
+ . 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB 
+11875 . 16750) (MAKEDB 16752 . 17836)))))
 STOP

library/HRULE

@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Jul-2022 15:09:26" {DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;4
 23801  
+
(FILECREATED "26-Nov-2023 09:46:44" {WMEDLEY}<library>HRULE.;5
 23918  
 
-      :CHANGES-TO (VARS HRULECOMS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "25-Jul-2022 15:07:00" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;3)
+      :CHANGES-TO (FNS HRULE.CREATE VRULE.CREATE CROPMARK.CREATE)
 
+      :PREVIOUS-DATE "25-Jul-2022 15:09:26" {WMEDLEY}<library>HRULE.;4)
 
-(* ; "
-Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT HRULECOMS)
 
@@ -90,30 +87,27 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (HRULE.CREATE

-  [LAMBDA (WIDTH)
                                        (* jds "11-Sep-85 16:36")

+  [LAMBDA (WIDTH)
                                            (* ; "Edited 26-Nov-2023 09:45 by rmk")

+                                                             (* jds "11-Sep-85 16:36")

 
-         (* * Create a Horizontal-Rule image object.
-
       WIDTH may be NIL to default, a number, for a single rule with its width in 
-
       points (and fractions thereof)%, or a list of alternating black and white 
-
       widths. E.g., to get a hairline over 1pt white over 3pt rule, specify
-
       (0.5 1 3))

+(* ;;; "Create a Horizontal-Rule image object.  WIDTH may be NIL to default, a number, for a single rule with its width in points (and fractions thereof), or a list of alternating black and white widths.  E.g., to get a hairline over 1pt white over 3pt rule, specify (0.5 1 3)")

 
     (PROG ((HRULE (IMAGEOBJCREATE NIL HRULE.IMAGEFNS)))
           (COND
-             ((NOT WIDTH)                                    (* USe the default width)

+             ((NOT WIDTH)                                    (* ; "USe the default width")

               (IMAGEOBJPROP HRULE 'RULE.WIDTH HRULE.DEFAULT.WIDTH)
               (RETURN HRULE))
              ((NUMBERP WIDTH)
               (IMAGEOBJPROP HRULE 'RULE.WIDTH WIDTH)
               (RETURN HRULE))
              ((AND (LISTP WIDTH)
-                   (EVERY WIDTH (FUNCTION NUMBERP)))         (* It's a list of numbers.
-
                                                           Add (QUOTE em) up)

+                   (EVERY WIDTH (FUNCTION NUMBERP)))         (* ; 
+
                                                         "It's a list of numbers.  Add (QUOTE em) up")

               (IMAGEOBJPROP HRULE 'RULE.WIDTH WIDTH)
               (RETURN HRULE))
-             (T                                              (* Something was specified, and 
-
                                                           there was a non-number in it...)

-                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Non-numeric widths not desirable: " WIDTH)
+             (T                                              (* ; 
+
                                       "Something was specified, and there was a non-number in it...")

+                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "HRULE with non-numeric width: " WIDTH)
                        T])
 
 (HRULE.DISPLAYFN

@@ -233,8 +227,9 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (VRULE.CREATE

-  [LAMBDA (WIDTH HEIGHT DASHING)
              (* ; 
-
                                                "Edited  8-Oct-92 16:46 by sybalsky:mv:envos")

+  [LAMBDA (WIDTH HEIGHT DASHING)
                             (* ; "Edited 26-Nov-2023 09:45 by rmk")

+                                                             (* ; 
+
                                                        "Edited  8-Oct-92 16:46 by sybalsky:mv:envos")

 
     (* ;; "Create a Vertical-Rule image object.  HEIGHT may be NIL to default, a number, for a single rule with its width in points (and fractions thereof), or a list of alternating black and white widths.  E.g., to get a hairline over 1pt white over 3pt rule, specify (0.5 1 3)")

 
@@ -246,7 +241,7 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
               (IMAGEOBJPROP VRULE 'RULE.WIDTH WIDTH))
              ((AND (LISTP WIDTH)
                    (EVERY WIDTH (FUNCTION NUMBERP)))         (* ; 
-
                                                           "It's a list of numbers.  Add 'em up")

+
                                                             "It's a list of numbers.  Add 'em up")

               (IMAGEOBJPROP VRULE 'RULE.WIDTH WIDTH)))
           (COND
              ((NOT HEIGHT)                                   (* ; "Use the default width")

@@ -257,12 +252,12 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
               (RETURN VRULE))
              ((AND (LISTP HEIGHT)
                    (EVERY HEIGHT (FUNCTION NUMBERP)))        (* ; 
-
                                                           "It's a list of numbers.  Add 'em up")

+
                                                             "It's a list of numbers.  Add 'em up")

               (IMAGEOBJPROP VRULE 'RULE.HEIGHT HEIGHT)
               (RETURN VRULE))
              (T                                              (* ; 
-
                                     "Something was specified, and there was a non-number in it...")

-                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Non-numeric widths not desirable: " HEIGHT)
+
                                       "Something was specified, and there was a non-number in it...")

+                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "VRULE with non-numeric height: " HEIGHT)
                        T)))
           (IMAGEOBJPROP VRULE 'RULE.DASHING DASHING])
 
@@ -392,7 +387,8 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (CROPMARK.CREATE

-  [LAMBDA (WIDTH HEIGHT)
                                 (* ; "Edited  5-Jun-91 14:56 by jds")

+  [LAMBDA (WIDTH HEIGHT)
                                     (* ; "Edited 26-Nov-2023 09:46 by rmk")


+                                                             (* ; "Edited  5-Jun-91 14:56 by jds")

 
     (* ;; "Create a CROPMARK, that prints crop-marks for a page that is WIDTH points wide and HEIGHT points high.")

 
@@ -406,12 +402,12 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
               (RETURN CROPMARK))
              ((AND (LISTP HEIGHT)
                    (EVERY HEIGHT (FUNCTION NUMBERP)))        (* ; 
-
                                                           "It's a list of numbers.  Add 'em up")

+
                                                             "It's a list of numbers.  Add 'em up")

               (IMAGEOBJPROP CROPMARK 'PAGE.SIZE (LIST WIDTH HEIGHT))
               (RETURN CROPMARK))
              (T                                              (* ; 
-
                                     "Something was specified, and there was a non-number in it...")

-                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Non-numeric widths not desirable: " HEIGHT)
+
                                       "Something was specified, and there was a non-number in it...")

+                (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "CROPMARK with non-numeric height: " HEIGHT)
                        T])
 
 (CROPMARK.DISPLAYFN

@@ -508,14 +504,13 @@ Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
              (FUNCTION NILL)
              (FUNCTION CROPMARK.WHENOPERATEDONFN)
              (FUNCTION NILL)))
-(PUTPROPS HRULE COPYRIGHT ("Venue & Xerox Corporation" 1985 1990 1991 1992))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4512 10691 (HRULE.CREATE 4522 . 5944) (HRULE.DISPLAYFN 5946 . 8515) (HRULE.GETFN 8517
- . 8837) (HRULE.IMAGEBOXFN 8839 . 9641) (HRULE.PUTFN 9643 . 10021) (HRULE.COPYFN 10023 . 10487) (
-HRULE.WHENOPERATEDONFN 10489 . 10689)) (11583 17788 (VRULE.CREATE 11593 . 13592) (VRULE.DISPLAYFN 
-13594 . 15788) (VRULE.GETFN 15790 . 16011) (VRULE.GETFN2 16013 . 16349) (VRULE.IMAGEBOXFN 16351 . 
-16779) (VRULE.PUTFN 16781 . 17179) (VRULE.COPYFN 17181 . 17584) (VRULE.WHENOPERATEDONFN 17586 . 17786)
-) (18427 23077 (CROPMARK.CREATE 18437 . 19704) (CROPMARK.DISPLAYFN 19706 . 21206) (CROPMARK.GETFN 
-21208 . 21502) (CROPMARK.IMAGEBOXFN 21504 . 22205) (CROPMARK.PUTFN 22207 . 22485) (CROPMARK.COPYFN 
-22487 . 22870) (CROPMARK.WHENOPERATEDONFN 22872 . 23075)))))
+  (FILEMAP (NIL (4411 10637 (HRULE.CREATE 4421 . 5890) (HRULE.DISPLAYFN 5892 . 8461) (HRULE.GETFN 8463
+ . 8783) (HRULE.IMAGEBOXFN 8785 . 9587) (HRULE.PUTFN 9589 . 9967) (HRULE.COPYFN 9969 . 10433) (
+HRULE.WHENOPERATEDONFN 10435 . 10635)) (11529 17865 (VRULE.CREATE 11539 . 13669) (VRULE.DISPLAYFN 
+13671 . 15865) (VRULE.GETFN 15867 . 16088) (VRULE.GETFN2 16090 . 16426) (VRULE.IMAGEBOXFN 16428 . 
+16856) (VRULE.PUTFN 16858 . 17256) (VRULE.COPYFN 17258 . 17661) (VRULE.WHENOPERATEDONFN 17663 . 17863)
+) (18504 23271 (CROPMARK.CREATE 18514 . 19898) (CROPMARK.DISPLAYFN 19900 . 21400) (CROPMARK.GETFN 
+21402 . 21696) (CROPMARK.IMAGEBOXFN 21698 . 22399) (CROPMARK.PUTFN 22401 . 22679) (CROPMARK.COPYFN 
+22681 . 23064) (CROPMARK.WHENOPERATEDONFN 23066 . 23269)))))
 STOP

library/UNICODE

@@ -1,18 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Jan-2024 10:58:06" {WMEDLEY}<library>UNICODE.;212
 72240  
+
(FILECREATED "26-Jan-2024 14:19:50" {LIB}UNICODE.;4
 72688  
 
-      :EDIT-BY rmk
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS NUTF8CODEBYTES)
+      :CHANGES-TO (FNS MAKE-UNICODE-FORMATS MAKE-UNICODE-TRANSLATION-TABLES SHOWCHARS 
+                       READ-UNICODE-MAPPING-FILENAMES)
+                  (VARS UNICODECOMS)
 
-      :PREVIOUS-DATE " 5-Jan-2024 17:25:29" {WMEDLEY}<library>UNICODE.;211)
+      :PREVIOUS-DATE " 8-Jan-2024 10:58:06" {LIB}UNICODE.;1)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
 
 (RPAQQ UNICODECOMS

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

 
               (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
@@ -61,7 +63,7 @@
              XCCSSTRING)
         (FNS \UTF8.FETCHCODE)
         (FNS SHOWCHARS)
-        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
+        [DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
                                                 EXPORTS.ALL)
                
                (* ;; "These control the layout of the translation tables.  Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")

@@ -70,7 +72,9 @@
                       (MAX-ALIST-LENGTH 10)
                       (N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE))
                       (TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE)))
-                      (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE])
+                      (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE]
+        (PROP (FILETYPE)
+              UNICODE)))
 
 
 
@@ -528,16 +532,19 @@
 (DEFINEQ
 
 (READ-UNICODE-MAPPING-FILENAMES

-  [LAMBDA (FILESPEC DIRS)
                                    (* ; "Edited  5-Jan-2024 17:24 by rmk")


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


+                                                             (* ; "Edited  5-Jan-2024 17:24 by rmk")


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


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

+    (DECLARE
 (USEDFREE UNICODEDIRECTORIES XCCS-SET-NAMES))
     (CL:UNLESS DIRS (SETQ DIRS UNICODEDIRECTORIES))
     (FOR
 F X CSI INSIDE
 FILESPEC JOIN
 
                                       (* ;; 
 
            "Last case hopes to pick up tables that are gruped together in a subdirectory (e.g. JIS)")

 
-                                      (OR (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT)
-                                                 T DIRS)
+                                      (OR (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION
+                                                                   'TXT)
+                                                         T DIRS))
                                           (for
 D inside
 DIRS
                                              when
 (SETQ D (FILDIR (PACKFILENAME 'NAME
                                                                          (CONCAT "XCCS-*=" F)
@@ -876,7 +883,7 @@
 (DEFINEQ
 
 (MAKE-UNICODE-TRANSLATION-TABLES

-  [LAMBDA (MAPPING LTORVAR RTOLVAR)
                     (* ; "Edited 21-Aug-2021 13:12 by rmk:")


+  [LAMBDA (MAPPING LTORVAR RTOLVAR)
                         (* ; "Edited 21-Aug-2021 13:12 by rmk:")


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

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

@@ -902,7 +909,7 @@
     (* ;; "")

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

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

 
     (* ;; "")

 
@@ -918,75 +925,67 @@
          (* ;; "The left-to-right direction (into Unicode).    We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte).  The second loop converts long alists into arrays.")

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

+                                               (* ;; "(CDR RCODES) contains combiners on the base")

 
-                                                      (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
-                                                                     (CL:IF (CDR RCODES)
-                                                                         RCODES
-                                                                         RBASE))
-                                                             (CL:SVREF LTORARRAY (LRSH LEFTC 
-                                                                                    TRANSLATION-SHIFT
-                                                                                       ]
+                                               (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
+                                                              (CL:IF (CDR RCODES)
+                                                                  RCODES
+                                                                  RBASE))
+                                                      (CL:SVREF LTORARRAY (LRSH LEFTC 
+                                                                                TRANSLATION-SHIFT]
          (FOR
 I CSA FROM
 0 TO
 (SUB1 N-TRANSLATION-SEGMENTS)
             WHEN
 (IGREATERP (LENGTH (CL:SVREF LTORARRAY I))
-                            MAX-ALIST-LENGTH)
-            DO
 
+                        MAX-ALIST-LENGTH) DO
 
+                                             (* ;; "Leave it alone if the alist is short")

 
-                  (* ;; "Leave it alone if the alist is short")

-
-                  (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
-                  (FOR
 P IN
 (CL:SVREF LTORARRAY I)
-                     DO
 (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
-                                                          TRANSLATION-MASK))
-                                   (CDR P)))
-                  (CL:SETF (CL:SVREF LTORARRAY I)
-                         CSA))
+                                             (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE 
+                                                              :INITIAL-ELEMENT NIL))
+                                             (FOR
 P IN
 (CL:SVREF LTORARRAY I)
+                                                DO
 (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
+                                                                                 TRANSLATION-MASK))
+                                                          (CDR P)))
+                                             (CL:SETF (CL:SVREF LTORARRAY I)
+                                                    CSA))
 
          (* ;; "")

 
          (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.")

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

 
-                                             (* ;; 
-
                                     "Have we already seen an explicit mapping from right to left?")

-
-                                             (SETQ LEFTC (CAR M))
-                                             [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
-                                                               (CL:SVREF RTOLARRAY (LRSH RBASE 
-                                                                                    TRANSLATION-SHIFT
-                                                                                         ]
-                                             (IF
 (NULL PREV)
-                                                 THEN
 (CL:PUSH (CONS (LOGAND RBASE 
-                                                                                TRANSLATION-MASK)
-                                                                         LEFTC)
-                                                                 (CL:SVREF RTOLARRAY (LRSH RBASE 
-                                                                                    TRANSLATION-SHIFT
-                                                                                           )))
-                                               ELSEIF
 (IGREATERP (CDR PREV)
-                                                                 LEFTC)
-                                                 THEN
 (RPLACD PREV LEFTC)))
+                                      (SETQ LEFTC (CAR M))
+                                      [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
+                                                        (CL:SVREF RTOLARRAY (LRSH RBASE 
+                                                                                  TRANSLATION-SHIFT]
+                                      (IF
 (NULL PREV)
+                                          THEN
 (CL:PUSH (CONS (LOGAND RBASE TRANSLATION-MASK)
+                                                              LEFTC)
+                                                      (CL:SVREF RTOLARRAY (LRSH RBASE 
+                                                                                TRANSLATION-SHIFT)))
+                                        ELSEIF
 (IGREATERP (CDR PREV)
+                                                      LEFTC)
+                                          THEN
 (RPLACD PREV LEFTC)))
          (FOR
 I CSA FROM
 0 TO
 (SUB1 N-TRANSLATION-SEGMENTS)
             WHEN
 (IGREATERP (LENGTH (CL:SVREF RTOLARRAY I))
-                            MAX-ALIST-LENGTH)
-            DO
 
+                        MAX-ALIST-LENGTH) DO
 
+                                             (* ;; "Long list, make an array")

 
-                  (* ;; "Long list, make an array")

-
-                  (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
-                  (FOR
 P IN
 (CL:SVREF RTOLARRAY I)
-                     DO
 (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
-                                                          TRANSLATION-MASK))
-                                   (CDR P)))
-                  (CL:SETF (CL:SVREF RTOLARRAY I)
-                         CSA))
+                                             (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE 
+                                                              :INITIAL-ELEMENT NIL))
+                                             (FOR
 P IN
 (CL:SVREF RTOLARRAY I)
+                                                DO
 (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
+                                                                                 TRANSLATION-MASK))
+                                                          (CDR P)))
+                                             (CL:SETF (CL:SVREF RTOLARRAY I)
+                                                    CSA))
 
          (* ;; "")

 
@@ -1285,14 +1284,15 @@
 (DEFINEQ
 
 (SHOWCHARS

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

+  [LAMBDA (FROMCHAR TOCHAR FONT)
                             (* ; "Edited 26-Jan-2024 14:18 by mth")


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

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

+
      "If a small number, assume it's an octal (in decimal) character set, no need for string quotes")

 
                (SETQ TOCHAR (CONCAT FROMCHAR "," 376))
                (SETQ FROMCHAR (CONCAT FROMCHAR "," 41)))
@@ -1302,16 +1302,16 @@
                (SETQ TOCHAR (CL:IF TOCHAR
                                 (CHARCODE.DECODE TOCHAR)
                                 FROMCHAR)))
-           (FOR
 C FROM
 FROMCHAR TO
 TOCHAR UNLESS
 (AND (IGEQ (LOGAND C 255)
-                                                                            127)
-                                                                      (ILEQ (LOGAND C 255)
-                                                                            (PLUS 128 33)))
-              DO
 (PRINTOUT T .P2 (CONCAT (OCTALSTRING (LRSH CODE 8))
-                                            ","
-                                            (OCTALSTRING (LOGAND CODE 255)))
-                            10
-                            (CHARACTER C)
-                            T])
+           (for
 C from
 FROMCHAR to
 TOCHAR unless
 (AND (IGEQ (LOGAND C 255)
+                                                            127)
+                                                      (ILEQ (LOGAND C 255)
+                                                            (PLUS 128 33)))
+              do
 (PRINTOUT T .P2 (CONCAT (OCTALSTRING (LRSH C 8))
+                                        ","
+                                        (OCTALSTRING (LOGAND C 255)))
+                        10
+                        (CHARACTER C)
+                        T])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
@@ -1338,17 +1338,19 @@
        (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE)))
 )
 )
+
+(PUTPROPS UNICODE
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3950 18041 (UTF8.OUTCHARFN 3960 . 6791) (UTF8.INCCODEFN 6793 . 12283) (UTF8.PEEKCCODEFN
- 12285 . 17059) (\UTF8.BACKCCODEFN 17061 . 18039)) (18042 21823 (UTF16BE.OUTCHARFN 18052 . 18876) (
-UTF16BE.INCCODEFN 18878 . 19777) (UTF16BE.PEEKCCODEFN 19779 . 20850) (\UTF16BE.BACKCCODEFN 20852 . 
-21821)) (21853 24134 (MAKE-UNICODE-FORMATS 21863 . 24132)) (24231 25537 (UNICODE.UNMAPPED 24241 . 
-25535)) (25538 26214 (XCCS-UTF8-AFTER-OPEN 25548 . 26212)) (27670 28019 (XTOUCODE 27680 . 27848) (
-UTOXCODE 27850 . 28017)) (28059 44757 (READ-UNICODE-MAPPING-FILENAMES 28069 . 30519) (
-READ-UNICODE-MAPPING 30521 . 33497) (WRITE-UNICODE-MAPPING 33499 . 37249) (WRITE-UNICODE-INCLUDED 
-37251 . 41973) (WRITE-UNICODE-MAPPING-HEADER 41975 . 43223) (WRITE-UNICODE-MAPPING-FILENAME 43225 . 
-44755)) (48071 56550 (MAKE-UNICODE-TRANSLATION-TABLES 48081 . 56548)) (57055 68253 (UTF-8.VALIDATE 
-57065 . 60067) (HEXSTRING 60069 . 61230) (UTF8HEXSTRING 61232 . 63437) (NUTF8CODEBYTES 63439 . 64392) 
-(NUTF8STRINGBYTES 64394 . 64875) (XTOUSTRING 64877 . 67888) (XCCSSTRING 67890 . 68251)) (68254 70058 (
-\UTF8.FETCHCODE 68264 . 70056)) (70059 71528 (SHOWCHARS 70069 . 71526)))))
+  (FILEMAP (NIL (4111 18202 (UTF8.OUTCHARFN 4121 . 6952) (UTF8.INCCODEFN 6954 . 12444) (UTF8.PEEKCCODEFN
+ 12446 . 17220) (\UTF8.BACKCCODEFN 17222 . 18200)) (18203 21984 (UTF16BE.OUTCHARFN 18213 . 19037) (
+UTF16BE.INCCODEFN 19039 . 19938) (UTF16BE.PEEKCCODEFN 19940 . 21011) (\UTF16BE.BACKCCODEFN 21013 . 
+21982)) (22014 24295 (MAKE-UNICODE-FORMATS 22024 . 24293)) (24392 25698 (UNICODE.UNMAPPED 24402 . 
+25696)) (25699 26375 (XCCS-UTF8-AFTER-OPEN 25709 . 26373)) (27831 28180 (XTOUCODE 27841 . 28009) (
+UTOXCODE 28011 . 28178)) (28220 45174 (READ-UNICODE-MAPPING-FILENAMES 28230 . 30936) (
+READ-UNICODE-MAPPING 30938 . 33914) (WRITE-UNICODE-MAPPING 33916 . 37666) (WRITE-UNICODE-INCLUDED 
+37668 . 42390) (WRITE-UNICODE-MAPPING-HEADER 42392 . 43640) (WRITE-UNICODE-MAPPING-FILENAME 43642 . 
+45172)) (48488 56912 (MAKE-UNICODE-TRANSLATION-TABLES 48498 . 56910)) (57417 68615 (UTF-8.VALIDATE 
+57427 . 60429) (HEXSTRING 60431 . 61592) (UTF8HEXSTRING 61594 . 63799) (NUTF8CODEBYTES 63801 . 64754) 
+(NUTF8STRINGBYTES 64756 . 65237) (XTOUSTRING 65239 . 68250) (XCCSSTRING 68252 . 68613)) (68616 70420 (
+\UTF8.FETCHCODE 68626 . 70418)) (70421 71931 (SHOWCHARS 70431 . 71929)))))
 STOP

library/lafite/UNIXMAIL

@@ -1,20 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "30-Sep-2021 16:06:26" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNIXMAIL.;2|
 82866  
 
-      |changes| |to:|  (VARS UNIXMAILCOMS)
-                       (FNS UNIX.POLLNEWMAIL UNIX.NEXTMESSAGE UNIXMAILER.OPENMAILBOX 
-                            UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX UNIXSPOOL.OPENMAILBOX
-                            UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX UNIX.FLUSH.STREAM 
-                            UNIX.RETRIEVE.LINE \\UNIXMAIL.SEND \\UNIXMAIL.SEND.WRAPLINES \\SMTP-DUMP
-                            \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.CHECK.ABORT \\UNIXMAIL.MUNG.RECIPIENTS 
-                            \\UNIXMAIL.SMTP \\UNIXMAIL.SMTP.FLUSH \\UNIXMAIL.CHANGE.MODE 
-                            \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.LOGIN \\UNIXMAIL.PARSENAMES 
-                            \\UNIXMAIL.MAKEANSWERFORM \\UNIXMAIL.MESSAGE.FROM.SELF.P 
-                            \\UNIXMAIL.MESSAGE.P \\UNIXMAIL.REALADDRESS \\UNIXMAIL.FQNAME 
-                            \\UNIXMAIL.FIXMICROSOFT)
+
(FILECREATED "24-Feb-2024 10:26:07" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;3|
 81776  
 
-      |previous| |date:| "10-Feb-2000 12:03:28" |{DSK}<project>medley3.5>library>unixmail.;42|)
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (VARS UNIXMAILCOMS)
+
+      :PREVIOUS-DATE "30-Sep-2021 16:06:26" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;1|
+)
 
 
 ; Copyright (c) 1989-1992, 1997, 1999, 1920, 2021 by ENVOS Corporation.
@@ -22,7 +15,11 @@
 (PRETTYCOMPRINT UNIXMAILCOMS)
 
 (RPAQQ UNIXMAILCOMS

-       ((DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
+       (
+        (* |;;| " LMM 2/24/24 need LAFITE to load")

+
+        (FILES LAFITE)
+        (DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
                                                   LAFITEDECLS NSMAIL)
                (RECORDS UNIXMAILBOX UNIXMAILFILEINFO UNIXMAILPARSE))
         (ALISTS (LAFITEMODELST UNIX))
@@ -90,6 +87,13 @@
                                                    '(CHANGE \\SENDMSG.CHANGE.MODE TO 
                                                            \\UNIXMAIL.CHANGE.MODE)))))
         (PROP FILETYPE UNIXMAIL)))
+
+
+
+(* |;;| " LMM 2/24/24 need LAFITE to load")

+
+
+(FILESLOAD LAFITE)
 (DECLARE\: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
@@ -106,8 +110,8 @@
 )
 
 (ADDTOVAR LAFITEMODELST
 (UNIX 3 \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.SEND \\UNIXMAIL.MAKEANSWERFORM 
-                                  \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
-                                  \\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
+                              \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
+                              \\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
 
 
 
@@ -133,9 +137,9 @@
 
 
 (RPAQQ UNIXMAIL.MSOPS.LIST
 ((MAILER UNIX.POLLNEWMAIL UNIXMAILER.OPENMAILBOX UNIX.NEXTMESSAGE 
-                                       UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
-                                (SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE 
-                                       UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
+                                   UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
+                            (SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE 
+                                   UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
 
 
 
@@ -979,13 +983,13 @@
 (* |;;| "This returns multiple-values, so it's a CL:LAMBDA (what the heck).")

 
 
-(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS
 ()
             (* \; "Edited 27-Feb-99 13:55 by rmk:")

+(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS
 ()
                     (* \; "Edited 27-Feb-99 13:55 by rmk:")

 
    (* |;;| "Opens two streams representing the input and output streams of an SMTP TCP connection.  On failure return NIL and a string describing the failure.")

 
    (SELECTQ UNIXMAIL.SEND.MODE
        (PROCESS (|if|
 (EQ (MACHINETYPE)
-                              'MAIKO)
+                          'MAIKO)
                     |then|

 
                     (* |;;| "UNIXMAIL.SEND.PROCESS can be a list of possibilities because the process may be in different places in different operating systems (e.g. solaris vs. sunos).  If the first one doesn't exist at this time, we search the remaining ones and move the first one we find to the beginning of the list for next time.  This could be done as an AFTERSYSOUTFORMS, but easy enough just to do it here.")

@@ -993,36 +997,32 @@
                     (LET ((S (CREATE-PROCESS-STREAM
                               (CONCAT (IF
 (NLISTP UNIXMAIL.SEND.PROCESS)
                                           THEN
 UNIXMAIL.SEND.PROCESS
-                                        ELSEIF
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY
-                                                                   (CAR UNIXMAIL.SEND.PROCESS)))
+                                        ELSEIF
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY (CAR 
+                                                                                UNIXMAIL.SEND.PROCESS
+                                                                                            )))
                                           THEN
 (CAR UNIXMAIL.SEND.PROCESS)
                                         ELSE
 (FOR
 P IN
 (CDR UNIXMAIL.SEND.PROCESS)
-                                                    WHEN
 (INFILEP (PACKFILENAME 'HOST
-                                                                             'DSK
-                                                                             'BODY P))
-                                                    DO
 (SETQ UNIXMAIL.SEND.PROCESS
-                                                            (CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)
-                                                                  ))
-                                                          (RETURN P)))
+                                                WHEN
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY P))
+                                                DO
 (SETQ UNIXMAIL.SEND.PROCESS
+                                                    (CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)))
+                                                   (RETURN P)))
                                      (IF
 UNIXMAIL.SEND.HOST
                                          THEN
 (CONCAT " " UNIXMAIL.SEND.HOST)
                                        ELSE
 "")))))
                          (CL:VALUES S S))
                   |else|
 (CL:VALUES NIL 
                           "this MACHINETYPE can't do Unix process-streams; change UNIXMAIL.SEND.MODE"
-                                    )))
+                                )))
        (SOCKET (|if|
 (EQ (MACHINETYPE)
-                             'MAIKO)
-                   |then|
 (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"
-                                                                                    ))
-                                              25)))
-                                   (CL:VALUES S S))
+                         'MAIKO)
+                   |then|
 (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"))
+                                          25)))
+                               (CL:VALUES S S))
                  |else|
 (LET ((S (TCP.OPEN UNIXMAIL.SEND.HOST 25 NIL 'ACTIVE 'INPUT T)))
-                                 (|if|
 S
-                                     |then|
 (CL:VALUES S (TCP.OTHER.STREAM S))
-                                   |else|
 (CL:VALUES NIL 
-                                                 "TCP.OPEN failed; check your Lisp TCP configuration"
-                                                     )))))
+                             (|if|
 S
+                                 |then|
 (CL:VALUES S (TCP.OTHER.STREAM S))
+                               |else|
 (CL:VALUES NIL 
+                                             "TCP.OPEN failed; check your Lisp TCP configuration")))))
        (ERROR "Unrecognized UNIXMAIL.SEND.MODE:" UNIXMAIL.SEND.MODE)))
 
 
@@ -1368,23 +1368,22 @@
 
     (SETQ LAFITESENDINGMENUITEMS (EDITE (CONS (CAR LAFITESENDINGMENUITEMS)
                                               (CDR LAFITESENDINGMENUITEMS))
-                                        '(CHANGE
 \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE)
-                                        )))
+                                        '(CHANGE
 \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE))))
 
 (PUTPROPS UNIXMAIL
 FILETYPE
 :COMPILE-FILE)
 (PUTPROPS UNIXMAIL COPYRIGHT ("ENVOS Corporation" 1989 1990 1991 1992 1997 1999 1920 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (7835 26260 (UNIX.POLLNEWMAIL 7845 . 9795) (UNIX.NEXTMESSAGE 9797 . 9973) (
-UNIXMAILER.OPENMAILBOX 9975 . 14371) (UNIXMAILER.RETRIEVEMESSAGE 14373 . 15580) (
-UNIXMAILER.CLOSEMAILBOX 15582 . 16607) (UNIXSPOOL.OPENMAILBOX 16609 . 22826) (
-UNIXSPOOL.RETRIEVEMESSAGE 22828 . 24909) (UNIXSPOOL.CLOSEMAILBOX 24911 . 26258)) (26308 56798 (
-UNIX.FLUSH.STREAM 26318 . 26899) (UNIX.RETRIEVE.LINE 26901 . 28090) (\\UNIXMAIL.SEND 28092 . 38386) (
-\\UNIXMAIL.SEND.WRAPLINES 38388 . 42018) (\\SMTP-DUMP 42020 . 43290) (\\UNIXMAIL.SEND.PARSE 43292 . 
-46536) (\\UNIXMAIL.CHECK.ABORT 46538 . 47366) (\\UNIXMAIL.MUNG.RECIPIENTS 47368 . 52236) (
-\\UNIXMAIL.SMTP 52238 . 52843) (\\UNIXMAIL.SMTP.FLUSH 52845 . 55322) (\\UNIXMAIL.CHANGE.MODE 55324 . 
-56796)) (56886 60196 (\\UNIXMAIL.SMTP.TCP.STREAMS 56886 . 60196)) (60275 81847 (
-\\UNIXMAIL.AUTHENTICATE 60285 . 61976) (\\UNIXMAIL.LOGIN 61978 . 62323) (\\UNIXMAIL.PARSENAMES 62325
- . 64643) (\\UNIXMAIL.MAKEANSWERFORM 64645 . 69527) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 69529 . 70658) (
-\\UNIXMAIL.MESSAGE.P 70660 . 70979) (\\UNIXMAIL.REALADDRESS 70981 . 75025) (\\UNIXMAIL.FQNAME 75027 . 
-75632) (\\UNIXMAIL.FIXMICROSOFT 75634 . 81845)))))
+  (FILEMAP (NIL (7090 25515 (UNIX.POLLNEWMAIL 7100 . 9050) (UNIX.NEXTMESSAGE 9052 . 9228) (
+UNIXMAILER.OPENMAILBOX 9230 . 13626) (UNIXMAILER.RETRIEVEMESSAGE 13628 . 14835) (
+UNIXMAILER.CLOSEMAILBOX 14837 . 15862) (UNIXSPOOL.OPENMAILBOX 15864 . 22081) (
+UNIXSPOOL.RETRIEVEMESSAGE 22083 . 24164) (UNIXSPOOL.CLOSEMAILBOX 24166 . 25513)) (25563 56053 (
+UNIX.FLUSH.STREAM 25573 . 26154) (UNIX.RETRIEVE.LINE 26156 . 27345) (\\UNIXMAIL.SEND 27347 . 37641) (
+\\UNIXMAIL.SEND.WRAPLINES 37643 . 41273) (\\SMTP-DUMP 41275 . 42545) (\\UNIXMAIL.SEND.PARSE 42547 . 
+45791) (\\UNIXMAIL.CHECK.ABORT 45793 . 46621) (\\UNIXMAIL.MUNG.RECIPIENTS 46623 . 51491) (
+\\UNIXMAIL.SMTP 51493 . 52098) (\\UNIXMAIL.SMTP.FLUSH 52100 . 54577) (\\UNIXMAIL.CHANGE.MODE 54579 . 
+56051)) (56141 59147 (\\UNIXMAIL.SMTP.TCP.STREAMS 56141 . 59147)) (59226 80798 (
+\\UNIXMAIL.AUTHENTICATE 59236 . 60927) (\\UNIXMAIL.LOGIN 60929 . 61274) (\\UNIXMAIL.PARSENAMES 61276
+ . 63594) (\\UNIXMAIL.MAKEANSWERFORM 63596 . 68478) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68480 . 69609) (
+\\UNIXMAIL.MESSAGE.P 69611 . 69930) (\\UNIXMAIL.REALADDRESS 69932 . 73976) (\\UNIXMAIL.FQNAME 73978 . 
+74583) (\\UNIXMAIL.FIXMICROSOFT 74585 . 80796)))))
 STOP

lispusers/DEMO

@@ -0,0 +1,127 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "24-Mar-2023 11:59:58" {DSK}<home>larry>il>medley>lispusers>DEMO.;3
 5662   
+
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (VARS DEMOCOMS)
+
+      :PREVIOUS-DATE "24-Mar-2023 07:29:15" {DSK}<home>larry>il>medley>lispusers>DEMO.;2)
+
+
+(PRETTYCOMPRINT DEMOCOMS)
+
+(RPAQQ DEMOCOMS
 ((VARS (HELPTIME 1)
+                       (AUTOBACKTRACEFLG 'ALWAYS))
+                 (COMS * BKSYSOBJCOMS)
+                 (FNS MEDLEY-CONTRIB OPEN-URL)))
+
+(RPAQQ HELPTIME
 1)
+
+(RPAQQ AUTOBACKTRACEFLG
 ALWAYS)
+
+(RPAQQ BKSYSOBJCOMS
 [(FNS BKSYSOBJ BKSYSOBJ.BUTTONEVENTINFN BKSYSOBJ.COPYBUTTONEVENTINFN 
+                          BKSYSOBJ.DISPLAYFN BKSYSOBJ.FINDEXEC BKSYSOBJ.IMAGEBOXFN)
+                     (INITVARS (BKSYSOBJFNS (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN
+                                                   NIL NIL NIL 'BKSYSOBJ.BUTTONEVENTINFN 
+                                                   'BKSYSOBJ.COPYBUTTONEVENTINFN])
+(DEFINEQ
+
+(BKSYSOBJ

+  [LAMBDA (STRING)
                                           (* ; "Edited 18-Mar-2023 12:52 by rmk")

+    (IMAGEOBJCREATE STRING BKSYSOBJFNS])
+
+(BKSYSOBJ.BUTTONEVENTINFN

+  [LAMBDA (OBJ WINDOW)
                                       (* ; "Edited 18-Mar-2023 13:51 by rmk")

+    (LET [(EXECW (BKSYSOBJ.FINDEXEC
))
+          (STR (IMAGEOBJPROP OBJ 'OBJECTDATUM]
+         (CL:WHEN (MEMB (NTHCHARCODE STR -1)
+                        (CHARCODE (%) %])))
+             (SETQ STR (SUBSTRING STR 1 -2)))
+         (CL:WHEN EXECW
+             (GIVE.TTY.PROCESS EXECW)
+             (BKSYSBUF STR))])
+
+(BKSYSOBJ.COPYBUTTONEVENTINFN

+  [LAMBDA (OBJ WINDOW REGION)
                                (* ; "Edited  3-Jan-2022 08:36 by rmk")

+    (CL:WHEN (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA))
+        [COPYINSERT (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA])])
+
+(BKSYSOBJ.DISPLAYFN

+  [LAMBDA (OBJ WINDOW)
                                       (* ; "Edited 18-Mar-2023 13:04 by rmk")

+    (DSPFONT DEFAULTFONT WINDOW)
+    (FOR
 I C (FONTARRAY _ (FONTMAPARRAY))
+         (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) FROM
 1
+       DO
 (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
+               (EOL (TERPRI WINDOW))
+               (NIL (RETURN))
+               (IF
 (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
+                   THEN
 (DSPFONT (ELT FONTARRAY (NTHCHARCODE STRING (ADD
 I 1)))
+                               WINDOW)
+                 ELSE
 (PRINTCCODE C WINDOW])
+
+(BKSYSOBJ.FINDEXEC

+  [LAMBDA NIL
                                                (* ; "Edited 18-Mar-2023 13:45 by rmk")

+
+    (* ;; "Finds the first exec with an Interlisp read table.")

+
+    (find
 W P in
 (OPENWINDOWS) suchthat
 (SETQ P (WINDOWPROP W 'PROCESS))
+                                     (AND (STRPOS "EXEC" (PROCESSPROP P 'NAME)
+                                                 1 NIL T)
+                                          (STREQUAL "INTERLISP" (READTABLEPROP
+                                                                 (LISTGET (PROCESSPROP P 'PROFILE)
+                                                                        '*READTABLE*)
+                                                                 'NAME])
+
+(BKSYSOBJ.IMAGEBOXFN

+  [LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN)
             (* ; "Edited 18-Mar-2023 13:04 by rmk")

+
+    (* ;; "Calculate the height of each line, and the width of the widest line.")

+
+    (* ;; 
+
    "Probably ought to compute the max height per line, at every font change, add it at each EOL.")

+
+    (SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
+    (FOR
 I C (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
+         (FONT _ (FONTCREATE DEFAULTFONT NIL NIL NIL IMAGESTREAM))
+         (HEIGHT _ 0)
+         (LINELENGTH _ 0)
+         (MAXLINELENGTH _ 0)
+         (FONTARRAY _ (FONTMAPARRAY)) FROM
 1
+       DO
 (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
+               (EOL (ADD
 HEIGHT (FONTPROP FONT 'HEIGHT))
+                    (CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
+                           (SETQ MAXLINELENGTH LINELENGTH))
+                    (SETQ LINELENGTH 0))
+               (NIL                                          (* ; "end of string")

+                    (CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
+                           (SETQ MAXLINELENGTH LINELENGTH))
+                    (RETURN (CREATE
 IMAGEBOX
+                                   XSIZE _ MAXLINELENGTH
+                                   YSIZE _ HEIGHT
+                                   YDESC _ (DIFFERENCE HEIGHT (FONTPROP FONT 'HEIGHT))
+                                   XKERN _ 0)))
+               (IF
 (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
+                   THEN
 (SETQ FONT (FONTCREATE (ELT FONTARRAY (NTHCHARCODE STRING (ADD
 I 1)))
+                                          NIL NIL NIL IMAGESTREAM))
+                 ELSE
 (ADD
 LINELENGTH (CHARWIDTH C FONT])
+)
+
+(RPAQ? BKSYSOBJFNS
 (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN NIL NIL NIL 
+                          'BKSYSOBJ.BUTTONEVENTINFN 'BKSYSOBJ.COPYBUTTONEVENTINFN))
+(DEFINEQ
+
+(MEDLEY-CONTRIB

+  [LAMBDA (REPO)
                                             (* ; "Edited 15-Mar-2023 08:05 by lmm")

+    (OPEN-URL
 (CONCAT "https://github.com/Interlisp/" REPO "/graphs/contributors"])
+
+(OPEN-URL

+  [LAMBDA (URL)
                                              (* ; "Edited 24-Mar-2023 06:31 by lmm")

+    (ShellBrowse URL])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1038 5085 (BKSYSOBJ 1048 . 1211) (BKSYSOBJ.BUTTONEVENTINFN 1213 . 1668) (
+BKSYSOBJ.COPYBUTTONEVENTINFN 1670 . 1923) (BKSYSOBJ.DISPLAYFN 1925 . 2572) (BKSYSOBJ.FINDEXEC 2574 . 
+3334) (BKSYSOBJ.IMAGEBOXFN 3336 . 5083)) (5264 5639 (MEDLEY-CONTRIB 5274 . 5490) (OPEN-URL 5492 . 5637
+)))))
+STOP

lispusers/DEMO.TEDIT

@@ -0,0 +1,29 @@
+
+DEMO -- utilities for running demos / tutorials in Medley
+
+includes
+   OPEN-URL (URL)  
+                 (rename of ShellBrowse)
+   MEDLEY-CONTRIB(REPO)
+                  shows GitHub contributors to given repo
+                  uses ShellBrowse
+    BKSYSOBJ(string)
+
+
+DEMO-*.TEDIT
+    contains scripts / TEDIT file talks
+    add your own
+
+
+
+BKSYSOBJ is the start of a facility
+
+(TEDIT.INSERT.OBJ (BKSYSOBJ ª(CONS NILº)     (TEXTSTREAM(WHICHW)]
+
+
+
+You should see (CONS NIL) in the TEDIT stream, clicking should shove (CONS NIL into an Interlisp exec, waiting for ) or ].  (probably the image objectg should be shaded, may also have to set the RDTBL flag on BKSYSBUF for strings, but this is a start).
+
+
+
+

lispusers/GITFNS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Oct-2023 19:33:26" {WMEDLEY}<lispusers>GITFNS.;489
 124166 
+
(FILECREATED " 1-Feb-2024 20:51:51" {LU}GITFNS.;2
 125030 
 
-      :EDIT-BY rmk
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS GIT-MAKE-PROJECT)
+      :CHANGES-TO (FNS GIT-GET-PROJECT GIT-BRANCH-EXISTS? GIT-BRANCH-DIFF)
 
-      :PREVIOUS-DATE " 1-Oct-2023 19:27:42" {WMEDLEY}<lispusers>GITFNS.;488)
+      :PREVIOUS-DATE " 1-Oct-2023 19:33:26" {LU}GITFNS.;1)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -288,32 +288,36 @@
              PROJECTNAME))])
 
 (GIT-GET-PROJECT

-  [LAMBDA (PROJECT FIELD NOERROR)
                            (* ; "Edited  7-Jul-2022 11:25 by rmk")


+  [LAMBDA (PROJECT FIELD NOERROR)
                            (* ; "Edited  1-Feb-2024 19:42 by mth")


+                                                             (* ; "Edited  7-Jul-2022 11:25 by rmk")


                                                              (* ; "Edited 13-May-2022 10:40 by rmk")


                                                              (* ; "Edited  9-May-2022 20:02 by rmk")


                                                              (* ; "Edited  8-May-2022 11:38 by rmk")

-    (CL:WHEN (SETQ PROJECT (IF
 (TYPE?
 GIT-PROJECT PROJECT)
-                               THEN
 PROJECT
-                             ELSEIF
 (CDR (ASSOC (OR (U-CASE PROJECT)
+    (CL:WHEN (SETQ PROJECT (if
 (type?
 GIT-PROJECT PROJECT)
+                               then
 PROJECT
+                             elseif
 (CDR (ASSOC (OR (U-CASE PROJECT)
                                                     GIT-DEFAULT-PROJECT)
                                                 GIT-PROJECTS))
-                             ELSEIF
 NOERROR
-                               THEN
 NIL
-                             ELSE
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
+                             elseif
 NOERROR
+                               then
 NIL
+                             else
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
         (SELECTQ FIELD
-            (PROJECTNAME (FETCH
 PROJECTNAME OF
 PROJECT))
+            (PROJECTNAME (fetch
 PROJECTNAME of
 PROJECT))
             (WHOST (FETCH
 WHOST OF
 PROJECT))
             (GITHOST (FETCH
 GITHOST OF
 PROJECT))
             (EXCLUSIONS (FETCH
 EXCLUSIONS OF
 PROJECT))
             (DEFAULTSUBDIRS 
                  (FETCH
 DEFAULTSUBDIRS OF
 PROJECT))
             (CLONEPATH (FETCH
 CLONEPATH OF
 PROJECT))
-            (MAINBRANCH [OR (FETCH
 MAINBRANCH OF
 PROJECT)
-                            (REPLACE
 MAINBRANCH OF
 PROJECT WITH
 (OR (GIT-BRANCH-EXISTS?
 'origin/main
+            (MAINBRANCH [OR (fetch
 MAINBRANCH of
 PROJECT)
+                            (replace
 MAINBRANCH of
 PROJECT with
 (OR (GIT-BRANCH-EXISTS?
 'origin/main
                                                                            T PROJECT)
                                                                     (GIT-BRANCH-EXISTS?
 
-                                                                           'origin/master NIL PROJECT
-                                                                           ])
+                                                                           'origin/master T PROJECT)
+                                                                    (GIT-BRANCH-EXISTS?
 'local/main T
+                                                                           PROJECT)
+                                                                    (GIT-BRANCH-EXISTS?
 
+                                                                           'local/master NIL PROJECT])
             PROJECT))])
 
 (GIT-PUT-PROJECT-FIELD

@@ -1059,6 +1063,8 @@
 (GIT-BRANCH-DIFF

   [LAMBDA (BRANCH1 BRANCH2 PROJECT)
 
+    (* ;; "Edited  1-Feb-2024 20:49 by mth")

+
     (* ;; "Edited 29-Sep-2022 10:52 by rmk")

 
     (* ;; "Edited 12-Sep-2022 14:13 by rmk")

@@ -1089,7 +1095,11 @@
 
           (SETQ RESULTFILE (GIT-COMMAND-TO-FILE
 (CONCAT 
                                                  "git diff -C --find-copies-harder $(git merge-base "
-                                                       BRANCH1 " " BRANCH2 ") " BRANCH2 
+                                                       (STRIPWHERE
 BRANCH1)
+                                                       " "
+                                                       (STRIPWHERE
 BRANCH2)
+                                                       ") "
+                                                       (STRIPWHERE
 BRANCH2)
                                                        " --name-status")
                                   PROJECT))
           (SETQ ELINES NIL)
@@ -1351,18 +1361,19 @@
          (SORT BRANCHES])
 
 (GIT-BRANCH-EXISTS?

-  [LAMBDA (BRANCH NOERROR PROJECT EXCLUDEMERGED)
             (* ; "Edited 19-May-2022 10:10 by rmk")

+  [LAMBDA (BRANCH NOERROR PROJECT EXCLUDEMERGED)
             (* ; "Edited  1-Feb-2024 20:16 by mth")


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

 
     (* ;; "Returns the canonical name of the branch (xxx or origin/xxx) depending on whether BRANCH is local/xxx or origin/xxx")

 
-    (IF
 (CAR (MEMB (MKATOM BRANCH)
-                   (GIT-BRANCHES
 (IF
 (STRPOS "origin/" BRANCH 1 NIL T)
-                                     THEN
 'REMOTE
-                                   ELSEIF
 (STRPOS "local/" BRANCH 1 NIL T)
-                                     THEN
 'LOCAL)
+    (if
 (CAR (MEMB (MKATOM (STRIPWHERE
 BRANCH T))
+                   (GIT-BRANCHES
 (if
 (STRPOS "origin/" BRANCH 1 NIL T)
+                                     then
 'REMOTE
+                                   elseif
 (STRPOS "local/" BRANCH 1 NIL T)
+                                     then
 'LOCAL)
                           PROJECT EXCLUDEMERGED)))
-      ELSEIF
 (NOT NOERROR)
-        THEN
 (ERROR "Unknown branch" BRANCH])
+      elseif
 (NOT NOERROR)
+        then
 (ERROR "Unknown branch" BRANCH])
 
 (GIT-PICK-BRANCH

   [LAMBDA (BRANCHES TITLE)
                                   (* ; "Edited  6-Jul-2023 22:31 by rmk")


@@ -2300,33 +2311,33 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4081 20660 (GIT-CLONEP 4091 . 5419) (GIT-INIT 5421 . 6051) (GIT-MAKE-PROJECT 6053 . 
-13718) (GIT-GET-PROJECT 13720 . 15645) (GIT-PUT-PROJECT-FIELD 15647 . 17288) (GIT-PROJECT-PATH 17290
- . 18334) (FIND-ANCESTOR-DIRECTORY 18336 . 18685) (GIT-FIND-CLONE 18687 . 19768) (GIT-MAINBRANCH 19770
- . 20165) (GIT-MAINBRANCH? 20167 . 20658)) (26068 28195 (PRC-COMMAND 26078 . 28193)) (28251 31039 (
-ALLSUBDIRS 28261 . 29547) (MEDLEYSUBDIRS 29549 . 30242) (GITSUBDIRS 30244 . 31037)) (31040 35830 (
-TOGIT 31050 . 32456) (FROMGIT 32458 . 33439) (GIT-DELETE-FILE 33441 . 34287) (MYMEDLEY-DELETE-FILES 
-34289 . 35828)) (35831 38834 (MYMEDLEYSUBDIR 35841 . 36297) (GITSUBDIR 36299 . 36742) (STRIPDIR 36744
- . 37115) (STRIPHOST 37117 . 37357) (STRIPNAME 37359 . 38112) (STRIPWHERE 38114 . 38832)) (38835 40737
- (GFILE4MFILE 38845 . 39208) (MFILE4GFILE 39210 . 39779) (GIT-REPO-FILENAME 39781 . 40735)) (40786 
-52616 (GIT-COMMIT 40796 . 41622) (GIT-PUSH 41624 . 42268) (GIT-PULL 42270 . 42882) (GIT-APPROVAL 42884
- . 43233) (GIT-GET-FILE 43235 . 45200) (GIT-FILE-EXISTS? 45202 . 45476) (GIT-REMOTE-UPDATE 45478 . 
-46202) (GIT-REMOTE-ADD 46204 . 46511) (GIT-FILE-DATE 46513 . 47444) (GIT-FILE-HISTORY 47446 . 49380) (
-GIT-PRINT-FILE-HISTORY 49382 . 50432) (GIT-FETCH 50434 . 50606) (GIT-PR-BRANCHES 50608 . 52614)) (
-52646 63239 (GIT-BRANCH-DIFF 52656 . 58996) (GIT-COMMIT-DIFFS 58998 . 59551) (GIT-BRANCH-RELATIONS 
-59553 . 63237)) (63284 76387 (GIT-BRANCH-NUM 63294 . 63867) (GIT-CHECKOUT 63869 . 64928) (
-GIT-WHICH-BRANCH 64930 . 65228) (GIT-MAKE-BRANCH 65230 . 67443) (GIT-BRANCHES 67445 . 69713) (
-GIT-BRANCH-EXISTS? 69715 . 70419) (GIT-PICK-BRANCH 70421 . 70911) (GIT-BRANCH-MENU 70913 . 71616) (
-GIT-PULL-REQUESTS 71618 . 73764) (GIT-SHORT-BRANCH-NAME 73766 . 74057) (GIT-LONG-NAME 74059 . 74376) (
-GIT-PRC-BRANCHES 74378 . 76385)) (76417 79752 (GIT-MY-CURRENT-BRANCH 76427 . 76797) (GIT-MY-BRANCHP 
-76799 . 77304) (GIT-MY-NEXT-BRANCH 77306 . 77800) (GIT-MY-BRANCHES 77802 . 79750)) (79798 83750 (
-GIT-ADD-WORKTREE 79808 . 81292) (GIT-REMOVE-WORKTREE 81294 . 82224) (GIT-LIST-WORKTREES 82226 . 83030)
- (WORKTREEDIR 83032 . 83748)) (83798 116000 (GIT-GET-DIFFERENT-FILES 83808 . 90232) (
-GIT-BRANCHES-COMPARE-DIRECTORIES 90234 . 96585) (GIT-WORKING-COMPARE-DIRECTORIES 96587 . 101983) (
-GIT-COMPARE-WORKTREE 101985 . 105963) (GITCDOBJBUTTONFN 105965 . 110455) (GIT-CD-LABELFN 110457 . 
-111539) (GIT-CD-MENUFN 111541 . 113981) (GIT-WORKING-COMPARE-FILES 113983 . 114603) (
-GIT-BRANCHES-COMPARE-FILES 114605 . 115769) (GIT-PR-COMPARE 115771 . 115998)) (116070 124099 (CDGITDIR
- 116080 . 116767) (GIT-COMMAND 116769 . 118327) (GITORIGIN 118329 . 119026) (GIT-INITIALS 119028 . 
-119332) (GIT-COMMAND-TO-FILE 119334 . 122823) (GIT-RESULT-TO-LINES 122825 . 123432) (STRIPLOCAL 123434
- . 124097)))))
+  (FILEMAP (NIL (4081 21076 (GIT-CLONEP 4091 . 5419) (GIT-INIT 5421 . 6051) (GIT-MAKE-PROJECT 6053 . 
+13718) (GIT-GET-PROJECT 13720 . 16061) (GIT-PUT-PROJECT-FIELD 16063 . 17704) (GIT-PROJECT-PATH 17706
+ . 18750) (FIND-ANCESTOR-DIRECTORY 18752 . 19101) (GIT-FIND-CLONE 19103 . 20184) (GIT-MAINBRANCH 20186
+ . 20581) (GIT-MAINBRANCH? 20583 . 21074)) (26484 28611 (PRC-COMMAND 26494 . 28609)) (28667 31455 (
+ALLSUBDIRS 28677 . 29963) (MEDLEYSUBDIRS 29965 . 30658) (GITSUBDIRS 30660 . 31453)) (31456 36246 (
+TOGIT 31466 . 32872) (FROMGIT 32874 . 33855) (GIT-DELETE-FILE 33857 . 34703) (MYMEDLEY-DELETE-FILES 
+34705 . 36244)) (36247 39250 (MYMEDLEYSUBDIR 36257 . 36713) (GITSUBDIR 36715 . 37158) (STRIPDIR 37160
+ . 37531) (STRIPHOST 37533 . 37773) (STRIPNAME 37775 . 38528) (STRIPWHERE 38530 . 39248)) (39251 41153
+ (GFILE4MFILE 39261 . 39624) (MFILE4GFILE 39626 . 40195) (GIT-REPO-FILENAME 40197 . 41151)) (41202 
+53032 (GIT-COMMIT 41212 . 42038) (GIT-PUSH 42040 . 42684) (GIT-PULL 42686 . 43298) (GIT-APPROVAL 43300
+ . 43649) (GIT-GET-FILE 43651 . 45616) (GIT-FILE-EXISTS? 45618 . 45892) (GIT-REMOTE-UPDATE 45894 . 
+46618) (GIT-REMOTE-ADD 46620 . 46927) (GIT-FILE-DATE 46929 . 47860) (GIT-FILE-HISTORY 47862 . 49796) (
+GIT-PRINT-FILE-HISTORY 49798 . 50848) (GIT-FETCH 50850 . 51022) (GIT-PR-BRANCHES 51024 . 53030)) (
+53062 63975 (GIT-BRANCH-DIFF 53072 . 59732) (GIT-COMMIT-DIFFS 59734 . 60287) (GIT-BRANCH-RELATIONS 
+60289 . 63973)) (64020 77251 (GIT-BRANCH-NUM 64030 . 64603) (GIT-CHECKOUT 64605 . 65664) (
+GIT-WHICH-BRANCH 65666 . 65964) (GIT-MAKE-BRANCH 65966 . 68179) (GIT-BRANCHES 68181 . 70449) (
+GIT-BRANCH-EXISTS? 70451 . 71283) (GIT-PICK-BRANCH 71285 . 71775) (GIT-BRANCH-MENU 71777 . 72480) (
+GIT-PULL-REQUESTS 72482 . 74628) (GIT-SHORT-BRANCH-NAME 74630 . 74921) (GIT-LONG-NAME 74923 . 75240) (
+GIT-PRC-BRANCHES 75242 . 77249)) (77281 80616 (GIT-MY-CURRENT-BRANCH 77291 . 77661) (GIT-MY-BRANCHP 
+77663 . 78168) (GIT-MY-NEXT-BRANCH 78170 . 78664) (GIT-MY-BRANCHES 78666 . 80614)) (80662 84614 (
+GIT-ADD-WORKTREE 80672 . 82156) (GIT-REMOVE-WORKTREE 82158 . 83088) (GIT-LIST-WORKTREES 83090 . 83894)
+ (WORKTREEDIR 83896 . 84612)) (84662 116864 (GIT-GET-DIFFERENT-FILES 84672 . 91096) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 91098 . 97449) (GIT-WORKING-COMPARE-DIRECTORIES 97451 . 102847) (
+GIT-COMPARE-WORKTREE 102849 . 106827) (GITCDOBJBUTTONFN 106829 . 111319) (GIT-CD-LABELFN 111321 . 
+112403) (GIT-CD-MENUFN 112405 . 114845) (GIT-WORKING-COMPARE-FILES 114847 . 115467) (
+GIT-BRANCHES-COMPARE-FILES 115469 . 116633) (GIT-PR-COMPARE 116635 . 116862)) (116934 124963 (CDGITDIR
+ 116944 . 117631) (GIT-COMMAND 117633 . 119191) (GITORIGIN 119193 . 119890) (GIT-INITIALS 119892 . 
+120196) (GIT-COMMAND-TO-FILE 120198 . 123687) (GIT-RESULT-TO-LINES 123689 . 124296) (STRIPLOCAL 124298
+ . 124961)))))
 STOP

lispusers/MODERNIZE

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Oct-2023 10:56:48" {WMEDLEY}<lispusers>MODERNIZE.;48
 30909  
+
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7
 30816  
 
-      :EDIT-BY rmk
+      :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
 
-      :CHANGES-TO (FNS NEARESTCORNER)
-
-      :PREVIOUS-DATE "29-Jul-2023 10:48:55" {WMEDLEY}<lispusers>MODERNIZE.;47)
+      :PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
+)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
@@ -368,26 +367,24 @@
          (\CURSORPOSITION X Y])
 
 (INCORNER.REGION

-  [LAMBDA (CORNERREGION TOPMARGIN)
                      (* ; "Edited 13-Oct-2021 15:04 by rmk:")

+  [LAMBDA (CORNERREGION TOPMARGIN)
                          (* ; "Edited 13-Oct-2021 15:04 by rmk:")

 
     (* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")

 
     (* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")

 
-    (IF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 LEFT OF
 CORNERREGION)))
-                  MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
-                     THEN
 'LEFTTOP
-                   ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 CORNERREGION)))
-                     THEN
 'LEFTBOTTOM)
-      ELSEIF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 RIGHT OF
 CORNERREGION)))
-                       MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
-                     THEN
 'RIGHTTOP
-                   ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 CORNERREGION)))
-                     THEN
 'RIGHTBOTTOM])
+    (if
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch
 LEFT of
 CORNERREGION)))
+              MODERN-WINDOW-MARGIN)
+        then
 (if
 (NEARTOP
 CORNERREGION TOPMARGIN)
+                 then
 'LEFTTOP
+               elseif
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch
 BOTTOM of
 CORNERREGION)))
+                 then
 'LEFTBOTTOM)
+      elseif
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch
 RIGHT of
 CORNERREGION)))
+                   MODERN-WINDOW-MARGIN)
+        then
 (if
 (NEARTOP
 CORNERREGION TOPMARGIN)
+                 then
 'RIGHTTOP
+               elseif
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch
 BOTTOM of
 CORNERREGION)))
+                 then
 'RIGHTBOTTOM])
 )
 
 
@@ -510,9 +507,11 @@
     (* ;; "We pass the pane that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")

 
     (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
-           NIL NIL [APPLY (FUNCTION UNIONREGIONS)
-                          (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
-                             repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
+           NIL
+           (WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
+           [APPLY (FUNCTION UNIONREGIONS)
+                  (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
+                     repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
            (WINDOWPROP (CENTRALWINDOW W)
                   'TITLE])
 )
@@ -615,11 +614,11 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5048 11410 (MODERNWINDOW 5058 . 6598) (MODERNWINDOW.SETUP 6600 . 9549) (UNMODERNWINDOW 
-9551 . 9945) (MODERNWINDOW.UNSETUP 9947 . 10759) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10761 . 11408)) (
-11475 22625 (MODERNWINDOW.BUTTONEVENTFN 11485 . 18512) (NEARTOP 18514 . 19442) (NEARESTCORNER 19444 . 
-21311) (INCORNER.REGION 21313 . 22623)) (22683 25155 (MODERN-ADD-EXEC 22693 . 23124) (MODERN-SNAPW 
-23126 . 23669) (TOTOPW.MODERNIZE 23671 . 24099) (MODERN-MENUBUTTONFN 24101 . 25153)) (25156 27585 (
-\MODERNIZED.FREEMENU.BUTTONEVENTFN 25166 . 25813) (MODERNIZED.TB.BUTTONEVENTFN 25815 . 27583)) (27626 
-29148 (TEDIT.MODERNIZE 27636 . 27989) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27991 . 29146)))))
+  (FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW 
+9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) (
+11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 . 
+21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW 
+22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 (
+\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489 
+29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053)))))
 STOP

lispusers/comparetext

@@ -1,18 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "18-Oct-2023 17:45:46" {WMEDLEY}<lispusers>COMPARETEXT.;131
 48661  
+
(FILECREATED "14-Jan-2024 13:20:30" {WMEDLEY}<lispusers>COMPARETEXT.;133
 48539  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS IMCOMPARE.HASH)
+      :CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS)
 
-      :PREVIOUS-DATE " 2-Nov-2022 10:08:52" {WMEDLEY}<lispusers>COMPARETEXT.;130)
+      :PREVIOUS-DATE "14-Jan-2024 13:11:44" {WMEDLEY}<lispusers>COMPARETEXT.;132)
 
 
-(* ; "
-Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
-")
-
 (PRETTYCOMPRINT COMPARETEXTCOMS)
 
 (RPAQQ COMPARETEXTCOMS

@@ -295,7 +291,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
                 TITLE TEXTWIDTH TEXTHEIGHT])
 
 (IMCOMPARE.COLLECT.HASH.CHUNKS

-  [LAMBDA (CHUNK HASH.TYPE)
                                  (* ; "Edited 18-Oct-2023 17:45 by rmk")


+  [LAMBDA (CHUNK HASH.TYPE)
                                  (* ; "Edited 14-Jan-2024 13:20 by rmk")


+                                                             (* ; "Edited 18-Oct-2023 17:45 by rmk")


                                                              (* ; "Edited 20-Jan-2022 23:09 by rmk")


                                                              (* ; "Edited 24-Dec-2021 22:30 by rmk")


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


@@ -304,19 +301,19 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
 
 (* ;;; "Returns a list of the chunks inside CHUNK as hashed of type HASH.TYPE.  Presumably CHUNK is is higher on the ranking PARA > LINE >.  WORD.  The initial CHUNK covers the whole file, middle-mouse refinement-chunks cover only subsections.")

 
-    (* ;; "It is overkill to open raw text streams as TEDIT stream.  So we open, test for TEDIT and if so, close and reoopen.  TEDIT may not yet honor external formats other than XCCS for rawtext files.")

+    (* ;; "It is overkill to open raw text streams as TEDIT stream.  So we open, test for TEDIT and if so, close and reoopen.  ")

 
     (RESETLST
         (BIND
 (FILENAME _ (fetch
 (IMCOMPARE.CHUNK FILENAME) of
 CHUNK))
               STREAM ENDPOS FIRST
 [RESETSAVE [SETQ STREAM (OPENSTREAM FILENAME 'INPUT 'OLD
                                                                  '((ENDOFSTREAMOP NILL]
                                          '(PROGN (CLOSEF? OLDVALUE]
-                                  (CL:WHEN (\TEDIT.FORMATTEDP1 STREAM)
+                                  (CL:WHEN (TEDIT.FORMATTEDFILEP STREAM)
                                                              (* ; 
 
                                               "The OBJECTCHAR is produced in place of image objects")

                                       [RESETSAVE [SETQ STREAM
                                                   (OPENTEXTSTREAM STREAM NIL NIL NIL
-                                                         `(OBJECTBYTE ,(CHARCODE NULL]
+                                                         `(OBJECTBYTE ,(CHARCODE *
]
                                              '(PROGN (CLOSEF? OLDVALUE])
                                   (SETFILEINFO STREAM 'EOL 'ANY)
                                   (CL:UNLESS (fetch
 (IMCOMPARE.CHUNK CHUNKLENGTH) of
 CHUNK)
@@ -782,14 +779,13 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
 (FILESLOAD (LOADCOMP)
        GRAPHER)
 )
-(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1318 40954 (COMPARETEXT 1328 . 2968) (COMPARETEXT.WINDOW 2970 . 6768) (
-COMPARETEXT.TSTREAM 6770 . 9991) (COMPARETEXT.SETSEL 9993 . 10898) (CHUNKNODELABEL 10900 . 12021) (
-IMCOMPARE.BOXNODE 12023 . 12999) (IMCOMPARE.CHUNKS 13001 . 17609) (IMCOMPARE.COLLECT.HASH.CHUNKS 17611
- . 20723) (IMCOMPARE.DISPLAYGRAPH 20725 . 28804) (IMCOMPARE.HASH 28806 . 33164) (
-IMCOMPARE.MERGE.CONNECTED.CHUNKS 33166 . 36662) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36664 . 38619) (
-IMCOMPARE.SHOW.DIST 38621 . 39067) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39069 . 40952)) (40955 47439 (
-IMCOMPARE.LEFTBUTTONFN 40965 . 43869) (IMCOMPARE.MIDDLEBUTTONFN 43871 . 46987) (IMCOMPARE.COPYBUTTONFN
- 46989 . 47437)) (47492 48183 (TAIL1 47502 . 47856) (TAIL2 47858 . 48181)))))
+  (FILEMAP (NIL (1234 40907 (COMPARETEXT 1244 . 2884) (COMPARETEXT.WINDOW 2886 . 6684) (
+COMPARETEXT.TSTREAM 6686 . 9907) (COMPARETEXT.SETSEL 9909 . 10814) (CHUNKNODELABEL 10816 . 11937) (
+IMCOMPARE.BOXNODE 11939 . 12915) (IMCOMPARE.CHUNKS 12917 . 17525) (IMCOMPARE.COLLECT.HASH.CHUNKS 17527
+ . 20676) (IMCOMPARE.DISPLAYGRAPH 20678 . 28757) (IMCOMPARE.HASH 28759 . 33117) (
+IMCOMPARE.MERGE.CONNECTED.CHUNKS 33119 . 36615) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36617 . 38572) (
+IMCOMPARE.SHOW.DIST 38574 . 39020) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39022 . 40905)) (40908 47392 (
+IMCOMPARE.LEFTBUTTONFN 40918 . 43822) (IMCOMPARE.MIDDLEBUTTONFN 43824 . 46940) (IMCOMPARE.COPYBUTTONFN
+ 46942 . 47390)) (47445 48136 (TAIL1 47455 . 47809) (TAIL2 47811 . 48134)))))
 STOP

sources/MACHINEINDEPENDENT

@@ -1,20 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Jul-2022 19:55:30" {DSK}<home>larry>medley>sources>MACHINEINDEPENDENT.;4
 117970 
+
(FILECREATED "18-Jan-2024 10:40:56" {WMEDLEY}<sources>MACHINEINDEPENDENT.;38
 117576 
 
-      :CHANGES-TO (VARS MACHINEINDEPENDENTCOMS)
-                  (FNS UNSAFE.TO.MODIFY)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "20-Jul-2022 15:26:15" {DSK}<home>larry>medley>sources>MACHINEINDEPENDENT.;3)
+      :CHANGES-TO (FNS LISPSOURCEFILEP)
 
+      :PREVIOUS-DATE "20-Jul-2022 19:55:30" {WMEDLEY}<sources>MACHINEINDEPENDENT.;36)
 
-(* ; "
-Copyright (c) 1983-1991, 2021-2022 by Venue & Xerox Corporation.
-The following program was created in 1983 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 MACHINEINDEPENDENTCOMS)
 
@@ -1665,6 +1658,8 @@ WRITEFILE OF ")
 (LISPSOURCEFILEP

   [LAMBDA (FILE)
 
+    (* ;; "Edited 18-Jan-2024 10:40 by rmk")

+
     (* ;; "Edited 22-May-2022 09:49 by rmk: If FILE is a stream but not open for input, open it")

 
     (* ;; "Edited  9-Jul-2021 22:12 by rmk:")

@@ -1676,16 +1671,17 @@ WRITEFILE OF ")
                         (GETSTREAM FILE 'INPUT T))
             [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT])
         (CL:WHEN (RANDACCESSP FILE)
-            (LET ((HERE (GETFILEPTR FILE)))
-                 (CL:MULTIPLE-VALUE-BIND (ENV MAP)
-                        [\PARSE-FILE-HEADER
 FILE (FUNCTION (LAMBDA (STREAM)
+            (LET ((HERE (GETFILEPTR FILE))
+                  ENV MAP)
+                 [NLSETQ (CL:MULTIPLE-VALUE-SETQ (ENV MAP)
+                                (\PARSE-FILE-HEADER
 FILE (FUNCTION (LAMBDA (STREAM)
                                                              (* ; 
 
                                                 "Pointed now right after the FILECREATED expression")

-                                                             (CAR (NLSETQ (SKREAD STREAM)
-                                                                         (SKREAD STREAM)
-                                                                         (FIXP (READ STREAM]
-                        (SETFILEPTR FILE HERE)
-                        (CL:VALUES ENV MAP)))))])
+                                                                     (CAR (NLSETQ (SKREAD STREAM)
+                                                                                 (SKREAD STREAM)
+                                                                                 (FIXP (READ STREAM]
+                 (SETFILEPTR FILE HERE)
+                 (CL:VALUES ENV MAP))))])
 
 (LISPFILETYPE

   [LAMBDA (FILE)
                                             (* ; "Edited 22-May-2022 13:18 by rmk")

@@ -2466,26 +2462,24 @@ This has little hope of working any more.")

 
 (LOCALVARS . T)
 )
-(PUTPROPS MACHINEINDEPENDENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1985 1986 1987 1988 
-1989 1990 1991 2021 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (12904 26329 (LOAD? 12914 . 14765) (FILESLOAD 14767 . 15056) (DOFILESLOAD 15058 . 22684)
- (FINDFILE-WITH-EXTENSIONS 22686 . 25885) (READ-FILECREATED 25887 . 26327)) (26446 31767 (DMPHASH 
-26456 . 28050) (HASHOVERFLOW 28052 . 31765)) (32523 64631 (BKBUFS 32533 . 33652) (CHANGENAME 33654 . 
-33915) (CHNGNM 33917 . 35765) (CLBUFS 35767 . 37040) (DEFINE 37042 . 37766) (FNS.PUTDEF 37768 . 41183)
- (EQMEMB 41185 . 41367) (EQUALN 41369 . 42198) (FNCHECK 42200 . 44207) (FNTYP1 44209 . 44306) (LCSKIP 
-44308 . 45152) (MAPRINT 45154 . 46100) (MKLIST 46102 . 46252) (NAMEFIELD 46254 . 47779) (NLIST 47781
- . 48116) (PRINTBELLS 48118 . 48244) (PROMPTCHAR 48246 . 50136) (RAISEP 50138 . 50399) (READFILE 50401
- . 52745) (READLINE 52747 . 58187) (REMPROPLIST 58189 . 59077) (RESETBUFS 59079 . 59529) (TAB 59531 . 
-60127) (UNSAVED1 60129 . 61234) (WRITEFILE 61236 . 62978) (CLOSE-AND-MAYBE-DELETE 62980 . 63324) (
-UNSAFE.TO.MODIFY 63326 . 64629)) (66986 69930 (FILEDATE 66996 . 69928)) (70160 97262 (FILEMAP 70170 . 
-70640) (\PARSE-FILE-HEADER 70642 . 74457) (GET-ENVIRONMENT-AND-FILEMAP 74459 . 76686) (
-LOOKUP-ENVIRONMENT-AND-FILEMAP 76688 . 78879) (GET-FILEMAP-FROM-FILECREATED 78881 . 79705) (
-\FILEMAP-HASHOVERFLOW 79707 . 84371) (FLUSHFILEMAPS 84373 . 84996) (LISPSOURCEFILEP 84998 . 86289) (
-LISPFILETYPE 86291 . 89540) (GETFILEMAP 89542 . 89961) (PUTFILEMAP 89963 . 92154) (UPDATEFILEMAP 92156
- . 97260)) (97928 101514 (LVLPRINT 97938 . 98111) (LVLPRIN1 98113 . 98295) (LVLPRIN2 98297 . 98529) (
-LVLPRIN 98531 . 99545) (LVLPRIN0 99547 . 101512)) (101548 106465 (FLUSHRIGHT 101558 . 102373) (
-PRINTPARA 102375 . 103473) (PRINTPARA1 103475 . 106463)) (106501 108786 (SUBLIS 106511 . 107119) (
-SUBPAIR 107121 . 108349) (DSUBLIS 108351 . 108784)) (108809 109409 (CONSTANTOK 108819 . 109407)) (
-111162 111867 (NLAMBDA.ARGS 111172 . 111865)))))
+  (FILEMAP (NIL (12537 25962 (LOAD? 12547 . 14398) (FILESLOAD 14400 . 14689) (DOFILESLOAD 14691 . 22317)
+ (FINDFILE-WITH-EXTENSIONS 22319 . 25518) (READ-FILECREATED 25520 . 25960)) (26079 31400 (DMPHASH 
+26089 . 27683) (HASHOVERFLOW 27685 . 31398)) (32156 64264 (BKBUFS 32166 . 33285) (CHANGENAME 33287 . 
+33548) (CHNGNM 33550 . 35398) (CLBUFS 35400 . 36673) (DEFINE 36675 . 37399) (FNS.PUTDEF 37401 . 40816)
+ (EQMEMB 40818 . 41000) (EQUALN 41002 . 41831) (FNCHECK 41833 . 43840) (FNTYP1 43842 . 43939) (LCSKIP 
+43941 . 44785) (MAPRINT 44787 . 45733) (MKLIST 45735 . 45885) (NAMEFIELD 45887 . 47412) (NLIST 47414
+ . 47749) (PRINTBELLS 47751 . 47877) (PROMPTCHAR 47879 . 49769) (RAISEP 49771 . 50032) (READFILE 50034
+ . 52378) (READLINE 52380 . 57820) (REMPROPLIST 57822 . 58710) (RESETBUFS 58712 . 59162) (TAB 59164 . 
+59760) (UNSAVED1 59762 . 60867) (WRITEFILE 60869 . 62611) (CLOSE-AND-MAYBE-DELETE 62613 . 62957) (
+UNSAFE.TO.MODIFY 62959 . 64262)) (66619 69563 (FILEDATE 66629 . 69561)) (69793 96996 (FILEMAP 69803 . 
+70273) (\PARSE-FILE-HEADER 70275 . 74090) (GET-ENVIRONMENT-AND-FILEMAP 74092 . 76319) (
+LOOKUP-ENVIRONMENT-AND-FILEMAP 76321 . 78512) (GET-FILEMAP-FROM-FILECREATED 78514 . 79338) (
+\FILEMAP-HASHOVERFLOW 79340 . 84004) (FLUSHFILEMAPS 84006 . 84629) (LISPSOURCEFILEP 84631 . 86023) (
+LISPFILETYPE 86025 . 89274) (GETFILEMAP 89276 . 89695) (PUTFILEMAP 89697 . 91888) (UPDATEFILEMAP 91890
+ . 96994)) (97662 101248 (LVLPRINT 97672 . 97845) (LVLPRIN1 97847 . 98029) (LVLPRIN2 98031 . 98263) (
+LVLPRIN 98265 . 99279) (LVLPRIN0 99281 . 101246)) (101282 106199 (FLUSHRIGHT 101292 . 102107) (
+PRINTPARA 102109 . 103207) (PRINTPARA1 103209 . 106197)) (106235 108520 (SUBLIS 106245 . 106853) (
+SUBPAIR 106855 . 108083) (DSUBLIS 108085 . 108518)) (108543 109143 (CONSTANTOK 108553 . 109141)) (
+110896 111601 (NLAMBDA.ARGS 110906 . 111599)))))
 STOP