Updated github actions to add wsl1-specific builds to the releases (#2182)

Updated Build/Push Medley Release workflow to add wsl1-specific assets
to the releases - based on the new wsl1-specific maiko builds.

Renamed the current wsl release assets to be wsl2-speciic assets.

There are now 20 assets in a release build.

.github/workflows/doHCFILES.yml

@@ -52,6 +52,12 @@ jobs:
       - name: Checkout Medley repo
         uses: actions/checkout@v4
 
+      - name: Checkout maiko
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/maiko
+          path: ./maiko
+
       - name: Checkout notecards
         uses: actions/checkout@v4
         with:
@@ -79,6 +85,7 @@ jobs:
                               --repo ${{ github.repository_owner }}/maiko \
                               --pattern '*-linux.x86_64.tgz'
           tar -xzf /tmp/maiko.tgz
+          touch ./maiko/linux.x86_64/.skip
         env:
           GH_TOKEN: ${{ secrets.MU_TOKEN }}
 

clos/NEW-CLOS-BROWSER

@@ -1,18 +1,18 @@
-(DEFINE-FILE-INFO PACKAGE (PROGN (DEFPACKAGE "CLOS-BROWSER" (USE "CLOS") (EXPORT "CLOS-ICON" 
-"CLOS-BROWSER" "ADD-BROWSER-METHOD" "BROWSE-CLASS")) (CLFIND-PACKAGE "USER")) READTABLE "XCL" BASE 
-10)
+(DEFINE-FILE-INFO PACKAGE (PROGN (DEFPACKAGE "CLOS-BROWSER" (USE "CLOS" "LISP") (EXPORT "CLOS-ICON"
+ "CLOS-BROWSER" "ADD-BROWSER-METHOD" "BROWSE-CLASS")) (CLFIND-PACKAGE "USER")) READTABLE "XCL" BASE
+ 10)
 
-
(IL:FILECREATED " 5-Dec-2023 12:07:41" IL:{CLOS}NEW-CLOS-BROWSER.\;3
 91622  
+
(IL:FILECREATED "28-Apr-2025 18:32:38" 
+IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;4|
 91934  
 
-      :EDIT-BY "mth"
+      :EDIT-BY "akw"
 
       :CHANGES-TO (IL:PROPS (IL:NEW-CLOS-BROWSER IL:MAKEFILE-ENVIRONMENT))
 
-      :PREVIOUS-DATE " 5-Dec-2023 00:58:05" IL:{CLOS}NEW-CLOS-BROWSER.\;2)
+      :PREVIOUS-DATE "26-Apr-2025 17:16:46" 
+IL:|{DSK}<Users>arunwelch>DOCUMENTS>MEDLEY-WORKSPACE>RELEASE>NEW-CLOS-BROWSER.;3|)
 
 
-; Copyright (c) 1991, 2020, 2023 by Venue.
-
 (IL:PRETTYCOMPRINT IL:NEW-CLOS-BROWSERCOMS)
 
 (IL:RPAQQ IL:NEW-CLOS-BROWSERCOMS

@@ -275,7 +275,7 @@
 
 (IL:PUTPROPS IL:NEW-CLOS-BROWSER
 IL:MAKEFILE-ENVIRONMENT
 (:PACKAGE (PROGN (XCL:DEFPACKAGE
                                                                            "CLOS-BROWSER"
-                                                                           (:USE "CLOS")
+                                                                           (:USE "CLOS" "LISP")
                                                                            (:EXPORT "CLOS-ICON" 
                                                                                   "CLOS-BROWSER" 
                                                                                  "ADD-BROWSER-METHOD"
@@ -1159,9 +1159,14 @@ Below this line operates on individual slots and methods."
    (DOCUMENTATION (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS)))
 
 (DEFMETHOD CLOS-BROWSER::PRINT-CLASS
 ((CLOS-BROWSER::SELF CLOS-BROWSER::CLOS-BROWSER-NODE))
-   (PPRINT (IL:GETDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF `CLOS-BROWSER::CLASS)
-                             'CLOS::NAME)
-                  'CLOS-BROWSER::CLASSES)))
+   (IF (IL:HASDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF 'CLOS-BROWSER::CLASS)
+                         'CLOS::NAME)
+              'CLOS-BROWSER::CLASSES)
+       (PPRINT (IL:GETDEF (SLOT-VALUE (SLOT-VALUE CLOS-BROWSER::SELF `CLOS-BROWSER::CLASS)
+                                 'CLOS::NAME)
+                      'CLOS-BROWSER::CLASSES))
+       (IL:PROMPTPRINT "No Printable Definition for the class " (SLOT-VALUE CLOS-BROWSER::SELF
+                                                                       'WEB::NAME))))
 
 (DEFMETHOD CLOS-BROWSER::SPECIALIZE-CLASS
 ((CLOS-BROWSER::NODE CLOS-BROWSER::CLOS-BROWSER-NODE)
                                            &OPTIONAL CLOS-BROWSER::FORM CLOS-BROWSER::NEW-CLASS-NAME)
@@ -1211,7 +1216,8 @@ Below this line operates on individual slots and methods."
                                            (RETURN))))))
                    (IL:SETCURSOR CLOS-BROWSER::ORIGINALCURSOR))))))
 
-(DEFUN CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE
 (IGNORE STRUCTURE)
+(DEFUN CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE
 (IGNORE STRUCTURE)

+                                                  (IL:* IL:\; "Edited 26-Apr-2025 14:31 by arunwelch")

    (LET ((CLOS-BROWSER::ORIGINALCURSOR (IL:CURSOR)))
         (UNWIND-PROTECT
             (PROGN (IL:SETCURSOR IL:WAITINGCURSOR)
@@ -1224,8 +1230,7 @@ Below this line operates on individual slots and methods."
                         (IL:* IL:|;;| "check for bug")

 
                         (WHEN (SYMBOLP CLOS-BROWSER::SUB-CLASS)
-                            (SETQ CLOS-BROWSER::SUB-CLASS (CLOS::SYMBOL-CLASS CLOS-BROWSER::SUB-CLASS
-                                                                 )))
+                            (SETQ CLOS-BROWSER::SUB-CLASS (FIND-CLASS CLOS-BROWSER::SUB-CLASS)))
                         (DOLIST (CLOS-BROWSER::BROWSER (SLOT-VALUE CLOS-BROWSER:CLOS-ICON
                                                               'CLOS-BROWSER::CLASS-BROWSERS))
                             (DOLIST (CLOS-BROWSER::SUPER-CLASS (SLOT-VALUE CLOS-BROWSER::SUB-CLASS
@@ -1387,14 +1392,12 @@ Below this line operates on individual slots and methods."
                 (0 (FORMAT T "Unspecialized methods cannot be copied. ~A" (CLOS::FULL-METHOD-NAME
                                                                            CLOS-BROWSER::METHOD NIL)))
                 (1 (SETQ CLOS-BROWSER::FROM-CLASS (CAR CLOS-BROWSER::NON-T-CLASSES)))
-                (OTHERWISE (SETQ CLOS-BROWSER::FROM-CLASS (CLOS::SYMBOL-CLASS
-                                                           (IL:PROMPTFORWORD (FORMAT NIL 
+                (OTHERWISE (SETQ CLOS-BROWSER::FROM-CLASS (FIND-CLASS (IL:PROMPTFORWORD
+                                                                       (FORMAT NIL 
                                                         "Which class in ~A do you wish to move from?"
-                                                                                    (
-                                                                               CLOS::FULL-METHOD-NAME
-                                                                                     
-                                                                                 CLOS-BROWSER::METHOD
-                                                                                     NIL))))))))
+                                                                              (CLOS::FULL-METHOD-NAME
+                                                                               CLOS-BROWSER::METHOD 
+                                                                               NIL))))))))
 
         (IL:* IL:|;;| "should contain from-class.  If it is not the same, abort.")

 
@@ -1465,7 +1468,7 @@ Below this line operates on individual slots and methods."
 
      "fix bug in the inconsistent way CLOS objects store T class specializers and do method lookup.")

 
                        (WHEN (EQ CLOS-BROWSER::CLASS T)
-                           (SETQ CLOS-BROWSER::CLASS (CLOS::SYMBOL-CLASS T)))
+                           (SETQ CLOS-BROWSER::CLASS (FIND-CLASS T)))
                        (LET ((CLOS-BROWSER::NODE (CLOS-BROWSER::BROWSER-CONTAINS-P
 
                                                         CLOS-BROWSER::CLASS CLOS-BROWSER::BROWSER)))
                             (WHEN CLOS-BROWSER::NODE
@@ -1582,7 +1585,8 @@ Below this line operates on individual slots and methods."
         (IL:|if|
 PACKAGE
             IL:|then|
 (IN-PACKAGE PACKAGE))))
 
-(DEFUN CLOS-BROWSER::CLASSES-IN-PACKAGE
 (PACKAGE &OPTIONAL CLOS-BROWSER::MAP-ON-PACKAGE)
+(DEFUN CLOS-BROWSER::CLASSES-IN-PACKAGE
 (PACKAGE &OPTIONAL CLOS-BROWSER::MAP-ON-PACKAGE)

+                                                  (IL:* IL:\; "Edited 26-Apr-2025 14:25 by arunwelch")

    "Retrieves a list of all the classes for a given package.  When map-on-package is t this can be very slow."
 
    (IL:* IL:|;;| "The maphash is always fast, whereas for some strange reason map-on-package varys among packages greatly.")

@@ -1594,7 +1598,7 @@ Below this line operates on individual slots and methods."
             (DO-SYMBOLS (CLOS-BROWSER::SYM PACKAGE)
                    (IF (AND (EQ (SYMBOL-PACKAGE CLOS-BROWSER::SYM)
                                 PACKAGE)
-                            (CLOS::SYMBOL-CLASS CLOS-BROWSER::SYM T))
+                            (FIND-CLASS CLOS-BROWSER::SYM T))
                        (PUSH CLOS-BROWSER::SYM CLOS-BROWSER::CLASSES)))
             (MAPHASH #'(LAMBDA (CLOS-BROWSER::KEY CLOS-BROWSER::VAL)
                               (IF (EQ (SYMBOL-PACKAGE CLOS-BROWSER::KEY)
@@ -1623,17 +1627,16 @@ Below this line operates on individual slots and methods."
       IL:|BackgroundMenuCommands|)
 
 (SETQ IL:|BackgroundMenu| NIL)
-(IL:PUTPROPS IL:NEW-CLOS-BROWSER IL:COPYRIGHT ("Venue" 1991 2020 2023))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (11770 13440 (CLOS-BROWSER:BROWSE-CLASS 11770 . 13440)) (13442 14785 (
-CLOS-BROWSER::COLLECT-FAMILY 13442 . 14785)) (14787 16819 (CLOS-BROWSER::MAKE-NODES 14787 . 16819)) (
-16821 17496 (CLOS-BROWSER::CLOS-BROWSER-CLOSE-FN 16821 . 17496)) (17498 18430 (CLOS-BROWSER::BROWSER-CONTAINS-P
- 17498 . 18430)) (42263 42587 (CLOS-BROWSER::EDIT 42263 . 42587)) (42589 48183 (
-CLOS-BROWSER::MAKE-METHOD-MENU-ITEMS 42589 . 48183)) (48185 49663 (CLOS-BROWSER::MAKE-TOP-LEVEL-METHOD-MENU-ITEMS
- 48185 . 49663)) (49665 50955 (CLOS-BROWSER::MAKE-MULTI-METHOD-SUB-MENU 49665 . 50955)) (64981 65598 (
-CLOS-BROWSER::COMPLETE-ADD-METHOD 64981 . 65598)) (65600 67812 (CLOS-BROWSER::COMPLETE-SPECIALIZE 
-65600 . 67812)) (67814 69482 (CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE 67814 . 69482)) (69484 69649 (
-CLOS-BROWSER::THIS-CLASS-NODE-P 69484 . 69649)) (69651 69753 (CLOS::CLASS-DIRECT-METHODS 69651 . 69753
-)) (86457 87472 (CLOS-BROWSER::REPLACE-SPECIALIZERS 86457 . 87472)) (87783 89367 (CLOS-BROWSER::IN-SELECT-PACKAGE
- 87783 . 89367)) (89369 90516 (CLOS-BROWSER::CLASSES-IN-PACKAGE 89369 . 90516)))))
+  (IL:FILEMAP (NIL (11846 13516 (CLOS-BROWSER:BROWSE-CLASS 11846 . 13516)) (13518 14861 (
+CLOS-BROWSER::COLLECT-FAMILY 13518 . 14861)) (14863 16895 (CLOS-BROWSER::MAKE-NODES 14863 . 16895)) (
+16897 17572 (CLOS-BROWSER::CLOS-BROWSER-CLOSE-FN 16897 . 17572)) (17574 18506 (CLOS-BROWSER::BROWSER-CONTAINS-P
+ 17574 . 18506)) (42339 42663 (CLOS-BROWSER::EDIT 42339 . 42663)) (42665 48259 (
+CLOS-BROWSER::MAKE-METHOD-MENU-ITEMS 42665 . 48259)) (48261 49739 (CLOS-BROWSER::MAKE-TOP-LEVEL-METHOD-MENU-ITEMS
+ 48261 . 49739)) (49741 51031 (CLOS-BROWSER::MAKE-MULTI-METHOD-SUB-MENU 49741 . 51031)) (65408 66025 (
+CLOS-BROWSER::COMPLETE-ADD-METHOD 65408 . 66025)) (66027 68239 (CLOS-BROWSER::COMPLETE-SPECIALIZE 
+66027 . 68239)) (68241 69946 (CLOS-BROWSER::LYRIC-COMPLETE-SPECIALIZE 68241 . 69946)) (69948 70113 (
+CLOS-BROWSER::THIS-CLASS-NODE-P 69948 . 70113)) (70115 70217 (CLOS::CLASS-DIRECT-METHODS 70115 . 70217
+)) (86738 87753 (CLOS-BROWSER::REPLACE-SPECIALIZERS 86738 . 87753)) (88064 89648 (CLOS-BROWSER::IN-SELECT-PACKAGE
+ 88064 . 89648)) (89650 90900 (CLOS-BROWSER::CLASSES-IN-PACKAGE 89650 . 90900)))))
 IL:STOP

docs/man-page/man_medley.html

@@ -284,6 +284,15 @@ environment variable LDEREPEATCM.</p>
 <p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
 Medley file system, not the host Windows file system.</p>
 </dd>
+<dt>-am, –automation</dt>
+<dd>
+<p>Useful only when using –vnc (and always on WSL1). When calling medley
+as part of an automation script, often Medley will run for a very short
+time (&lt; a couple of seconds). This can cause issues with medley code
+that detects Xvnc server failures. Setting this flag notifies Medley
+that very short Medley sessions are possible and the Xvnc error
+detection needs to be adjusted accordingly.</p>
+</dd>
 </dl>
 <h2>Other Options</h2>
 <dl>

docs/man-page/medley.1

@@ -386,6 +386,15 @@ environment variable LDEREPEATCM.
 On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
 Medley file system, not the host Windows file system.
 .RE
+.TP
+-am, \[en]automation
+Useful only when using \[en]vnc (and always on WSL1).
+When calling medley as part of an automation script, often Medley will
+run for a very short time (< a couple of seconds).
+This can cause issues with medley code that detects Xvnc server
+failures.
+Setting this flag notifies Medley that very short Medley sessions are
+possible and the Xvnc error detection needs to be adjusted accordingly.
 .SS Other Options
 .PP
 \ 

docs/man-page/medley.1.md

@@ -216,7 +216,7 @@ specified in the Medley file system, not the host Windows file system.
     If the given value is "-",  Medley will start up without using REM.CM file.
 
     There is no default Medley REM.CM file.
-    
+
     On Windows/Cygwin installations, *FILE* is
 specified in the Medley file system, not the host Windows file system.
 
@@ -254,10 +254,15 @@ for the parameter will be reset to the default value - which in the case of *Hos
 
 -cc \[*FILE* | -], \-\-repeat \[*FILE* | -]
 : Run Medley once.  And then as long as *FILE* exists and is greater then zero length, repeatedly run Medley using *FILE* as the REM.CM file that Medley reads and executes at startup.  Each run of Medley can change the contents of *FILE* to effect the subsequent run of Medley.  To end the cycle, Medley needs to delete *FILE*.  WIthin Medley, *FILE* can be found as the value of the environment variable LDEREPEATCM.
-    
+
     On Windows/Cygwin installations, *FILE* is
 specified in the Medley file system, not the host Windows file system.
 
+-am, --automation
+: Useful only when using --vnc (and always on WSL1).  When calling medley as part of an automation script, often Medley
+will run for a very short time (< a couple of seconds).  This can cause issues with medley code that detects Xvnc server failures.
+Setting this flag notifies Medley that very short Medley sessions are possible and the Xvnc error detection needs to be adjusted accordingly.
+
 
 Other Options
 -------------

installers/deb/build_deb.sh

@@ -71,14 +71,17 @@ popd >/dev/null 2>/dev/null
 
 
 # For linux and wsl create packages for each arch
-for wslp in linux wsl
+for wslp in linux wsl2 wsl1
 do
   # For each arch create a deb file
   for arch_base in x86_64^amd64 armv7l^armhf aarch64^arm64
   do
-    if [[ ${wslp} = wsl && ${arch_base} = armv7l^armhf ]];
+    if [ "${arch_base}" = armv7l^armhf ]
     then
-      continue
+      if [ "${wslp}" = wsl1 ] || [ "${wslp}" = wsl2 ]
+      then
+        continue
+      fi
     fi
     arch=${arch_base%^*}
     debian_arch=${arch_base#*^}
@@ -99,8 +102,14 @@ do
     MEDLEYDIR=${il_dir#${pkg_dir}}/medley
     #    Maiko and Medley files to il_dir (/usr/local/interlisp)
     mkdir -p ${il_dir}
-    tar -x -z -C ${il_dir} \
-              -f "${tarball_dir}/maiko-${maiko_release}-linux.${arch}.tgz"
+    if [ "${wslp}" = wsl1 ]
+    then
+      tar -x -z -C ${il_dir} \
+                -f "${tarball_dir}/maiko-${maiko_release}-wsl1.${arch}.tgz"
+    else
+      tar -x -z -C ${il_dir} \
+                -f "${tarball_dir}/maiko-${maiko_release}-linux.${arch}.tgz"
+    fi
     tar -x -z -C ${il_dir} \
               -f "${tarball_dir}/medley-${medley_release}-runtime.tgz"
     tar -x -z -C ${il_dir} \
@@ -117,14 +126,17 @@ do
     sed -e "s>--MEDLEYDIR-->${MEDLEYDIR}>g" <postrm >${pkg_dir}/DEBIAN/postrm
     chmod +x ${pkg_dir}/DEBIAN/postrm
     #     For wsl scripts, include the vncviewer.exe
-    if [[ ${wslp} = wsl && ${arch} = x86_64 ]];
+    if [ "${wslp}" = wsl1 ] || [ "${wslp}" = wsl2 ]
     then
-      pushd ./tmp >/dev/null
-      rm -rf vncviewer64-1.12.0.exe
-      wget -q https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
-      popd >/dev/null
-      mkdir -p ${il_dir}/wsl
-      cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
+      if [ "${arch}" = x86_64 ]
+      then
+        pushd ./tmp >/dev/null
+        rm -rf vncviewer64-1.12.0.exe
+        wget -q https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
+        popd >/dev/null
+        mkdir -p ${il_dir}/wsl
+        cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
+      fi
     fi
     #
     #  Make sure all files are owned by root

installers/deb/control-wsl2

@@ -0,0 +1,9 @@
+Package: medley-interlisp
+Version: 1.0.0
+Release: --RELEASE--
+Maintainer: info@interlisp.org
+Description: Medley Interlisp for Linux
+Homepage: https://github.com/interlisp/medley
+Architecture: --ARCH--
+Depends: wslu ( >= 4.1 ) | wslu ( << 4.0 ), tigervnc-standalone-server, tigervnc-xorg-extension 
+

internal/MEDLEY-UTILS

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Mar-2025 08:53:43" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;2
 30243  
+
(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8
 31221  
 
-      :EDIT-BY "lmm"
+      :CHANGES-TO (FNS MAKE-INDEX-HTMLS)
 
-      :CHANGES-TO (FNS MAKE-FULLER-DB)
-
-      :PREVIOUS-DATE "14-Jul-2024 12:51:12" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;1)
+      :PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -128,79 +126,89 @@
            "Welcome to Fuller sysout"])
 
 (MAKE-INDEX-HTMLS

-  [LAMBDA (BASE TOP LEVEL)
                                   (* ; "Edited 29-Apr-2024 14:18 by lmm")


+  [LAMBDA (BASE TOP LEVEL ROOT.NAME)
                         (* ; "Edited 29-Apr-2024 14:18 by lmm")


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


                                                              (* ; "Edited 20-Apr-2024 12:34 by lmm")


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

-    [OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
+                                                             (* ; "Edited 13-Apr-2024 21:18 by lmm")


+                                                            (* ; " Edited 16-May-2025 13:17 by fgh")

+    [OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
     (OR (DIRECTORYNAMEP BASE)
         (ERROR BASE "not a directory name"))
     (OR (AND (NUMBERP LEVEL)
              (IGREATERP LEVEL 0))
         (SETQ LEVEL 1))
-    (LET* ((SUBDIRS NIL)
-           (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
-           (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
-                           '}))
-           SLASHED SHORTNAME)
-          (CL:WITH-OPEN-FILE
-           (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
-           (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
-           (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
-           (CL:FORMAT S "<SCRIPT>~%%")
-           (CL:FORMAT S "    function up_onclick(){~%%")
-           (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
-           (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
-           (CL:FORMAT S "     }~%%")
-           (CL:FORMAT S "</SCRIPT>~%%")
-           (CL:FORMAT S "</HEAD>~%%")
-           (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
-           (CL:UNLESS (EQ LEVEL 1)
-                  (CL:FORMAT S 
+    (OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
+    (RESETLST
+        (if
 (EQ LEVEL 1)
+            then
 (RESETSAVE (PSEUDOHOSTS T))
+                 (PSEUDOHOST ROOT.NAME BASE))
+        (SETQ BASE (PSEUDOFILENAME BASE))
+        [LET*
+         ((SUBDIRS NIL)
+          (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
+          (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
+                          '}))
+          SLASHED SHORTNAME)
+         (CL:WITH-OPEN-FILE
+          (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
+          (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
+          (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
+          (CL:FORMAT S "<SCRIPT>~%%")
+          (CL:FORMAT S "    function up_onclick(){~%%")
+          (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
+          (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
+          (CL:FORMAT S "     }~%%")
+          (CL:FORMAT S "</SCRIPT>~%%")
+          (CL:FORMAT S "</HEAD>~%%")
+          (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
+          (CL:UNLESS (EQ LEVEL 1)
+                 (CL:FORMAT S 
       "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
-                         ))
-           (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
-           (FOR
 FULLNAME IN
 (DIRECTORY (CONCAT BASE "*.*;"))
-              DO
 (IF
 (EQ (NTHCHAR FULLNAME -1)
-                         '>)
-                     THEN
 
-                          (* ;; "A directory")

+                        ))
+          (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
+          (for
 FULLNAME in
 (DIRECTORY (CONCAT BASE "*.*;"))
+             do
 (if
 (EQ (NTHCHAR FULLNAME -1)
+                        '>)
+                    then
 
+                         (* ;; "A directory")

 
-                          (IF
 (NOT (DIRECTORYNAMEP FULLNAME))
-                              THEN
 (HELP "NOT DIRNAME"))
-                          (SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
-                                                         (+ (NCHARS BASE)
-                                                            (IF
 PSEUDOHOST
-                                                                THEN
 2
-                                                              ELSE
 1))
-                                                         -2)))
-                          (CL:UNLESS (OR (MEMB SHORTNAME '(.git))
-                                         (STRPOS ".git" FULLNAME)
-                                         (INFILEP (CONCAT FULLNAME ".skip")))
+                         (if
 (NOT (DIRECTORYNAMEP FULLNAME))
+                             then
 (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
+                         (SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
+                                                        (+ (NCHARS BASE)
+                                                           (if
 PSEUDOHOST
+                                                               then
 2
+                                                             else
 1))
+                                                        -2)))
+                         (CL:UNLESS (OR (MEMB SHORTNAME '(.git))
+                                        (MEMB SHORTNAME '(.GIT))
+                                        [AND (STRPOS ".git" (L-CASE FULLNAME))
+                                             (NOT (STRPOS ".github" (L-CASE FULLNAME]
+                                        (INFILEP (CONCAT FULLNAME ".skip")))
 
-                              (* ;; ".skip in the directory itself -- don't index any of it")

+                             (* ;; ".skip in the directory itself -- don't index any of it")

 
-                              (SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
-                              (CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
-                   ELSEIF
 (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
-                                                               (SUB1 (OR (STRPOS ".;" FULLNAME)
-                                                                         (STRPOS ";" FULLNAME)
-                                                                         (HELP 
-                                                                              "No ; in non-directory"
-                                                                               ]
-                                '(index.html .skip))
-                     THEN
 
-                          (* ;; "dont index the index")

+                             (SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
+                             (CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
+                  elseif
 (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
+                                                              (SUB1 (OR (STRPOS ".;" FULLNAME)
+                                                                        (STRPOS ";" FULLNAME)
+                                                                        (HELP (CONCAT 
+                                                                            "No ; in non-directory  "
+                                                                                     FULLNAME]
+                               '(index.html .skip))
+                    then
 
+                         (* ;; "dont index the index")

 
-                   ELSEIF
 (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
-                                '(IMPTR SKIP skip imptr))
-                     THEN
 
-                          (* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")

+                  elseif
 (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
+                               '(IMPTR SKIP skip imptr))
+                    then
 
+                         (* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")

 
-                   ELSE
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
-           (CL:FORMAT S "</UL></BODY></HTML>~%%"))
-          (NCONC SUBDIRS (FOR
 D IN
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
-                                                       (ADD1 LEVEL])
+                  else
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
+          (CL:FORMAT S "</UL></BODY></HTML>~%%"))
+         (NCONC SUBDIRS (for
 D in
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
+                                                      (ADD1 LEVEL])])
 
 (MEDLEY-FIX-LINKS

   [LAMBDA (UNIXPATH)
                                       (* ; "Edited 18-Jan-2021 12:01 by larry")

@@ -293,11 +301,11 @@
       (PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
      (FILESLOAD PDFSTREAM SKETCH)
      (FONTSET 'STANDARD)
-     (WHILE
 DIRLIST
-        DO

-        (SETQ BASE (POP
 DIRLIST))
-        (FOR
 SRCPATH IN
 (DIRECTORY (CONCAT BASE "*.*;"))
-           DO
 (PROG* [(SRC (UNPACKFILENAME SRCPATH))
+     (while
 DIRLIST
+        do

+        (SETQ BASE (pop
 DIRLIST))
+        (for
 SRCPATH in
 (DIRECTORY (CONCAT BASE "*.*;"))
+           do
 (PROG* [(SRC (UNPACKFILENAME SRCPATH))
                       [EXT (U-CASE (LISTGET SRC 'EXTENSION]
                       (DIR (LISTGET SRC 'DIRECTORY))
                       FRDY LDGP DEST (NOV (PACKFILENAME `(VERSION NIL ,@SRC]
@@ -330,13 +338,13 @@
                      (CL:WHEN (INFILEP (CONCAT DEST ".skip"))
                          (PRINTOUT T "Explicit .skip " DEST T)
                          (RETURN))
-                     (IF
 (MEMB 'TEDIT PHASES)
-                         THEN
 (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
+                     (if
 (MEMB 'TEDIT PHASES)
+                         then
 (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
                                            (CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH]
-                                  (IF
 (EQ REDO 'TEST)
-                                      THEN
 (CL:FORMAT T "Testing open ~a..." SRCPATH)
+                                  (if
 (EQ REDO 'TEST)
+                                      then
 (CL:FORMAT T "Testing open ~a..." SRCPATH)
                                            (CLOSEF? (OPENTEXTSTREAM SRCPATH))
-                                    ELSE
 (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
+                                    else
 (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
                                                                              )
                                                             (TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL 
                                                                    NIL 'PDF]
@@ -353,79 +361,89 @@
                          (PRINTOUT T "DONE" T))])
 
 (MAKE-INDEX-HTMLS

-  [LAMBDA (BASE TOP LEVEL)
                                   (* ; "Edited 29-Apr-2024 14:18 by lmm")


+  [LAMBDA (BASE TOP LEVEL ROOT.NAME)
                         (* ; "Edited 29-Apr-2024 14:18 by lmm")


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


                                                              (* ; "Edited 20-Apr-2024 12:34 by lmm")


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

-    [OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
+                                                             (* ; "Edited 13-Apr-2024 21:18 by lmm")


+                                                            (* ; " Edited 16-May-2025 13:17 by fgh")

+    [OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
     (OR (DIRECTORYNAMEP BASE)
         (ERROR BASE "not a directory name"))
     (OR (AND (NUMBERP LEVEL)
              (IGREATERP LEVEL 0))
         (SETQ LEVEL 1))
-    (LET* ((SUBDIRS NIL)
-           (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
-           (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
-                           '}))
-           SLASHED SHORTNAME)
-          (CL:WITH-OPEN-FILE
-           (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
-           (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
-           (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
-           (CL:FORMAT S "<SCRIPT>~%%")
-           (CL:FORMAT S "    function up_onclick(){~%%")
-           (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
-           (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
-           (CL:FORMAT S "     }~%%")
-           (CL:FORMAT S "</SCRIPT>~%%")
-           (CL:FORMAT S "</HEAD>~%%")
-           (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
-           (CL:UNLESS (EQ LEVEL 1)
-                  (CL:FORMAT S 
+    (OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
+    (RESETLST
+        (if
 (EQ LEVEL 1)
+            then
 (RESETSAVE (PSEUDOHOSTS T))
+                 (PSEUDOHOST ROOT.NAME BASE))
+        (SETQ BASE (PSEUDOFILENAME BASE))
+        [LET*
+         ((SUBDIRS NIL)
+          (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
+          (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
+                          '}))
+          SLASHED SHORTNAME)
+         (CL:WITH-OPEN-FILE
+          (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
+          (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
+          (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
+          (CL:FORMAT S "<SCRIPT>~%%")
+          (CL:FORMAT S "    function up_onclick(){~%%")
+          (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
+          (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
+          (CL:FORMAT S "     }~%%")
+          (CL:FORMAT S "</SCRIPT>~%%")
+          (CL:FORMAT S "</HEAD>~%%")
+          (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
+          (CL:UNLESS (EQ LEVEL 1)
+                 (CL:FORMAT S 
       "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
-                         ))
-           (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
-           (FOR
 FULLNAME IN
 (DIRECTORY (CONCAT BASE "*.*;"))
-              DO
 (IF
 (EQ (NTHCHAR FULLNAME -1)
-                         '>)
-                     THEN
 
-                          (* ;; "A directory")

+                        ))
+          (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
+          (for
 FULLNAME in
 (DIRECTORY (CONCAT BASE "*.*;"))
+             do
 (if
 (EQ (NTHCHAR FULLNAME -1)
+                        '>)
+                    then
 
+                         (* ;; "A directory")

 
-                          (IF
 (NOT (DIRECTORYNAMEP FULLNAME))
-                              THEN
 (HELP "NOT DIRNAME"))
-                          (SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
-                                                         (+ (NCHARS BASE)
-                                                            (IF
 PSEUDOHOST
-                                                                THEN
 2
-                                                              ELSE
 1))
-                                                         -2)))
-                          (CL:UNLESS (OR (MEMB SHORTNAME '(.git))
-                                         (STRPOS ".git" FULLNAME)
-                                         (INFILEP (CONCAT FULLNAME ".skip")))
+                         (if
 (NOT (DIRECTORYNAMEP FULLNAME))
+                             then
 (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
+                         (SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
+                                                        (+ (NCHARS BASE)
+                                                           (if
 PSEUDOHOST
+                                                               then
 2
+                                                             else
 1))
+                                                        -2)))
+                         (CL:UNLESS (OR (MEMB SHORTNAME '(.git))
+                                        (MEMB SHORTNAME '(.GIT))
+                                        [AND (STRPOS ".git" (L-CASE FULLNAME))
+                                             (NOT (STRPOS ".github" (L-CASE FULLNAME]
+                                        (INFILEP (CONCAT FULLNAME ".skip")))
 
-                              (* ;; ".skip in the directory itself -- don't index any of it")

+                             (* ;; ".skip in the directory itself -- don't index any of it")

 
-                              (SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
-                              (CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
-                   ELSEIF
 (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
-                                                               (SUB1 (OR (STRPOS ".;" FULLNAME)
-                                                                         (STRPOS ";" FULLNAME)
-                                                                         (HELP 
-                                                                              "No ; in non-directory"
-                                                                               ]
-                                '(index.html .skip))
-                     THEN
 
-                          (* ;; "dont index the index")

+                             (SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
+                             (CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
+                  elseif
 (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
+                                                              (SUB1 (OR (STRPOS ".;" FULLNAME)
+                                                                        (STRPOS ";" FULLNAME)
+                                                                        (HELP (CONCAT 
+                                                                            "No ; in non-directory  "
+                                                                                     FULLNAME]
+                               '(index.html .skip))
+                    then
 
+                         (* ;; "dont index the index")

 
-                   ELSEIF
 (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
-                                '(IMPTR SKIP skip imptr))
-                     THEN
 
-                          (* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")

+                  elseif
 (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
+                               '(IMPTR SKIP skip imptr))
+                    then
 
+                         (* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")

 
-                   ELSE
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
-           (CL:FORMAT S "</UL></BODY></HTML>~%%"))
-          (NCONC SUBDIRS (FOR
 D IN
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
-                                                       (ADD1 LEVEL])
+                  else
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
+          (CL:FORMAT S "</UL></BODY></HTML>~%%"))
+         (NCONC SUBDIRS (for
 D in
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
+                                                      (ADD1 LEVEL])])
 )
 
 (PUTPROPS MEDLEY-UTILS
 FILETYPE
 :COMPILE-FILE)
@@ -532,9 +550,9 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1104 12495 (GATHER-INFO 1114 . 6496) (MAKE-FULLER-DB 6498 . 7407) (MAKE-INDEX-HTMLS 
-7409 . 11864) (MEDLEY-FIX-LINKS 11866 . 12259) (MEDLEY-FIX-DATES 12261 . 12493)) (13674 16462 (
-MAKE-EXPORTS-ALL 13684 . 14743) (MAKE-WHEREIS-HASH 14745 . 15934) (MAKE-WHEREIS-LOOPS 15936 . 16460)) 
-(16463 25195 (HCFILES 16473 . 20736) (MAKE-INDEX-HTMLS 20738 . 25193)) (25445 30057 (RECOMPILE-ONE 
-25455 . 27352) (RECMPL 27354 . 27957) (COMPILE-SETUP 27959 . 28583) (REMAKEFILES 28585 . 30055)))))
+  (FILEMAP (NIL (1086 12975 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7389) (MAKE-INDEX-HTMLS 
+7391 . 12344) (MEDLEY-FIX-LINKS 12346 . 12739) (MEDLEY-FIX-DATES 12741 . 12973)) (14154 16942 (
+MAKE-EXPORTS-ALL 14164 . 15223) (MAKE-WHEREIS-HASH 15225 . 16414) (MAKE-WHEREIS-LOOPS 16416 . 16940)) 
+(16943 26173 (HCFILES 16953 . 21216) (MAKE-INDEX-HTMLS 21218 . 26171)) (26423 31035 (RECOMPILE-ONE 
+26433 . 28330) (RECMPL 28332 . 28935) (COMPILE-SETUP 28937 . 29561) (REMAKEFILES 29563 . 31033)))))
 STOP

internal/loadups/man-page/loadup.1

@@ -1,19 +1,5 @@
-.\" Automatically generated by Pandoc 3.1.3
+.\" Automatically generated by Pandoc 2.9.2.1
 .\"
-.\" Define V font for inline verbatim, using C font in formats
-.\" that render this, and otherwise B font.
-.ie "\f[CB]x\f[]"x" \{\
-. ftr V B
-. ftr VI BI
-. ftr VB B
-. ftr VBI BI
-.\}
-.el \{\
-. ftr V CR
-. ftr VI CI
-. ftr VB CB
-. ftr VBI CBI
-.\}
 .ad l
 .TH "loadup" "1" "" "" "Run the Medley loadup procedure"
 .nh
@@ -22,8 +8,7 @@
 \f[B]loadup\f[R] \[em] runs a loadup procedure for Medley Interlisp
 .SH SYNOPSIS
 .PP
-\f[B]<MEDLEYDIR>/scripts/loadup\f[R] [ options \&...
-]
+\f[B]<MEDLEYDIR>/scripts/loadup\f[R] [ options \&... ]
 .SH DESCRIPTION
 .PP
 Runs all or part of the \f[B]loadup\f[R] procedure for Medley Interlisp.
@@ -103,14 +88,16 @@ The target files are copied from this work directory to the loadups
 directory if the loadup is successful.
 Each stage of the loadup also creates a dribble file containing the
 terminal output from within the Medley environment.
-These dribble files are not copied to the loadups directory, but remain
-available in the work directory after the loadup completes.
+These dribble files are also copied to the loadups directory, but also
+remain available in the work directory after the loadup completes.
 .PP
 Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
-(The lock file is in the work directory and is named
-\f[B]\f[BI]lock\f[B]\f[R].
-It can be removed in case of an uncontrolled failure of the loadup
-procedure.)
+There is lock file to prevent simultaneous loadups in the work directory
+(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
+The lock can also be automatically overridden (see the \[en]override
+flag below).
+Alternatively, if a lock is encountered at run time, the user will be
+asked to choose whether to override or simply exit the loadup.
 .PP
 Note: \f[B]MEDLEYDIR\f[R] is an environment variable set by the loadup
 script.
@@ -253,6 +240,12 @@ Synonym for \[lq]\[en]target apps\[rq]
 \f[B]-a-, --apps-, -apps-, -5-\f[R]
 Synonym for \[lq]\[en]target apps\[rq]
 .TP
+\f[B]-ov, --override, -override\f[R]
+Automatically override the lock that prevents two loadups from running
+simultaneously.
+If this flag is not set and an active lock is encountered, the user will
+be asked to choose whether to override or exit.
+.TP
 \f[B]-nc, --nocopy, -nocopy\f[R]
 Run the specified loadups, but do not copy results into loadups
 directory.
@@ -265,13 +258,20 @@ all versioned (\f[I].\[ti][0-9]\f[R]\[ti]) files.
 Before running loadups (if any), thin the loadups directory by deleting
 all versioned (\f[I].\[ti][0-9]\f[R]\[ti]) files.
 .TP
-\f[B]-d DIR --maikodir DIR, -maikodir DIR\f[R]
+\f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
 Use DIR as the directory from which to execute lde (Miko) when running
 Medley in the loadup process.
 If this flag is not present, the value of the environment variable
 MAIKODIR will be used instead.
 And if MAIKODIR does not exist, then the default Maiko directory search
 within Medley will be used.
+.TP
+\f[B]-v, --vnc, -vnc\f[R]
+Relevant to Linux (including WSLv1 and WSLv2) platforms only.
+Use Xvnc for the Medley display during this loadup.
+By default, the Medley display will use X Windows.
+This flag is most useful on Windows System for Linux v1, where Xvnc is
+commonly used in running Medley in the absence of an Xwindows server.
 .SH DEFAULTS
 .PP
 The defaults for the Options context-dependent and somewhat complicated

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

@@ -48,10 +48,10 @@ The two independent stages that can be run if the first 4 sequential stages comp
 >+ **DB:**: creates the *fuller.database* file.  Fuller.database is a Mastercope database created by analyzing all of the source code included in full.sysout. (Stage 4)  Fuller.database is copied into the loadups directory.
 
 
-Loadup does all of its work in a work directory (\<MEDLEYDIR>loadups/build).  The target files are copied from this work directory to the loadups directory if the loadup is successful.  Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment.  These dribble files are not copied to the loadups directory, but remain available in the work directory after the loadup completes.
+Loadup does all of its work in a work directory (\<MEDLEYDIR>loadups/build).  The target files are copied from this work directory to the loadups directory if the loadup is successful.  Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment.  These dribble files are also copied to the loadups directory, but also remain available in the work directory after the loadup completes.
 
 
-Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time.  (The lock file is in the work directory and is named ***lock***.  It can be removed in case of an uncontrolled failure of the loadup procedure.)
+Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time.  There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed.  The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
 
 Note: **MEDLEYDIR** is an environment variable set by the loadup script.  It is set to the top level directory of the Medley installation that contains the specific loadup script that
 is invoked after all symbolic links are resolved.  In the standard global installation this will 
@@ -120,6 +120,9 @@ OPTIONS
 **-a-, \-\-apps-, -apps-, -5-**
 : Synonym for "--target apps"
 
+**-ov, \-\-override, -override**
+: Automatically override the lock that prevents two loadups from running simultaneously.  If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
+
 **-nc, \-\-nocopy, -nocopy**
 : Run the specified loadups, but do not copy results into loadups directory.
 
@@ -129,9 +132,15 @@ OPTIONS
 **-tl, \-\-thinl, -thinl**
 : Before running loadups (if any), thin the loadups directory by deleting all versioned (*.~[0-9]*~) files.
 
-**-d DIR \-\-maikodir DIR, -maikodir DIR**
+**-d DIR, \-\-maikodir DIR, -maikodir DIR**
 :  Use DIR as the directory from which to execute lde (Miko) when running Medley in the loadup process.  If this flag is not present, the value of the environment variable MAIKODIR will be used instead.  And if MAIKODIR does not exist, then the default Maiko directory search within Medley will be used.
 
+**-v, \-\-vnc, -vnc**
+: Relevant to Linux (including WSLv1 and WSLv2) platforms only.  Use Xvnc for the Medley display during this loadup.
+By default, the Medley display will use X Windows.
+This flag is most useful on Windows System for Linux v1, where Xvnc is commonly used in
+running Medley in the absence of an Xwindows server.
+
 DEFAULTS
 ====
 The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts.  All of the following defaults rules hold independent of the --maikodir (-d) option.

internal/loadups/man-page/man_loadup.html

@@ -1,269 +1,159 @@
 <h1>NAME</h1>
-<p><strong>loadup</strong> — runs a loadup procedure for Medley
-Interlisp</p>
+<p><strong>loadup</strong> — runs a loadup procedure for Medley Interlisp</p>
 <h1>SYNOPSIS</h1>
 <p><strong>&lt;MEDLEYDIR&gt;/scripts/loadup</strong> [ options ... ]</p>
 <h1>DESCRIPTION</h1>
-<p>Runs all or part of the <strong>loadup</strong> procedure for Medley
-Interlisp. The loadup procedure is used to create the standard sysout
-files from which you can start a Medley session as well as other
-standard files that are useful in running Medley. After cloning Medley
-from GitHub or after making significant changes to the Medley source,
-you need to run the loadup procedure to (re)create these standard
-files.</p>
-<p>The complete loadup procedure happens in 5 sequential stages with
-each stage depending on successful completion of the previous stage.
-There are two other non-sequential stages (Aux and DB), which depend
-only on the completion of Stage 4 (full.sysout).</p>
-<p>You need not run all 5 stages, depending on what sysout files you
-need to create for your work. The target files created in each stage are
-copied into a loadups directory (&lt;MEDLEYDIR&gt;/loadups). The
-<em>medley</em> run script and other Medley tools look for these files
-in the loadups directory.</p>
+<p>Runs all or part of the <strong>loadup</strong> procedure for Medley Interlisp. The loadup procedure is used to create the standard sysout files from which you can start a Medley session as well as other standard files that are useful in running Medley. After cloning Medley from GitHub or after making significant changes to the Medley source, you need to run the loadup procedure to (re)create these standard files.</p>
+<p>The complete loadup procedure happens in 5 sequential stages with each stage depending on successful completion of the previous stage. There are two other non-sequential stages (Aux and DB), which depend only on the completion of Stage 4 (full.sysout).</p>
+<p>You need not run all 5 stages, depending on what sysout files you need to create for your work. The target files created in each stage are copied into a loadups directory (&lt;MEDLEYDIR&gt;/loadups). The <em>medley</em> run script and other Medley tools look for these files in the loadups directory.</p>
 <p>The 5 sequential stages and their main products are:</p>
 <blockquote>
 <ol type="1">
-<li><p><strong>Init:</strong> create an <em>init.dlinit</em> sysout
-file. This init.dlinit file is used internally for Stage 2 and is not
-copied into the loadups directory.</p></li>
+<li><p><strong>Init:</strong> create an <em>init.dlinit</em> sysout file. This init.dlinit file is used internally for Stage 2 and is not copied into the loadups directory.</p></li>
 </ol>
 </blockquote>
 <blockquote>
 <ol start="2" type="1">
-<li><p><strong>Mid:</strong> create an <em>init-mid.sysout</em>. This
-init-mid.sysout is used only internally for Stage 3 and is not copied
-into the loadups directory.</p></li>
+<li><p><strong>Mid:</strong> create an <em>init-mid.sysout</em>. This init-mid.sysout is used only internally for Stage 3 and is not copied into the loadups directory.</p></li>
 </ol>
 </blockquote>
 <blockquote>
 <ol start="3" type="1">
-<li><p><strong>Lisp:</strong> create <em>lisp.sysout</em>. Lisp.sysout
-has a minimal set of Medley’s functionality loaded and can be used as
-the basis for running a stripped-down Medley session. Lisp.sysout is
-copied into the loadups directory.</p></li>
+<li><p><strong>Lisp:</strong> create <em>lisp.sysout</em>. Lisp.sysout has a minimal set of Medley’s functionality loaded and can be used as the basis for running a stripped-down Medley session. Lisp.sysout is copied into the loadups directory.</p></li>
 </ol>
 </blockquote>
 <blockquote>
 <ol start="4" type="1">
-<li><p><strong>Full:</strong> create <em>full.sysout</em>. Full.sysout
-has all of the “standard” set of Medley functionality loaded and is the
-primary sysout used for running Medley sessions. Full.sysout is copied
-into the loadups directory.</p></li>
+<li><p><strong>Full:</strong> create <em>full.sysout</em>. Full.sysout has all of the “standard” set of Medley functionality loaded and is the primary sysout used for running Medley sessions. Full.sysout is copied into the loadups directory.</p></li>
 </ol>
 </blockquote>
 <blockquote>
 <ol start="5" type="1">
-<li><p><strong>Apps:</strong>: create <em>apps.sysout</em>. Apps.sysout
-includes everything in full.sysout plus the Medley applications Buttons,
-CLOS, Rooms, and Notecards.</p></li>
+<li><p><strong>Apps:</strong>: create <em>apps.sysout</em>. Apps.sysout includes everything in full.sysout plus the Medley applications Buttons, CLOS, Rooms, and Notecards.</p></li>
 </ol>
 </blockquote>
-<p>The two independent stages that can be run if the first 4 sequential
-stages complete successfully are:</p>
+<p>The two independent stages that can be run if the first 4 sequential stages complete successfully are:</p>
 <blockquote>
 <ul>
-<li><p><strong>Aux:</strong>: create the <em>whereis.hash</em> and
-<em>exports.all</em> files. These are databases that are commonly used
-when working on Medley source code. They are copied into the loadups
-directory.</p></li>
-<li><p><strong>DB:</strong>: creates the <em>fuller.database</em> file.
-Fuller.database is a Mastercope database created by analyzing all of the
-source code included in full.sysout. (Stage 4) Fuller.database is copied
-into the loadups directory.</p></li>
+<li><p><strong>Aux:</strong>: create the <em>whereis.hash</em> and <em>exports.all</em> files. These are databases that are commonly used when working on Medley source code. They are copied into the loadups directory.</p></li>
+<li><p><strong>DB:</strong>: creates the <em>fuller.database</em> file. Fuller.database is a Mastercope database created by analyzing all of the source code included in full.sysout. (Stage 4) Fuller.database is copied into the loadups directory.</p></li>
 </ul>
 </blockquote>
-<p>Loadup does all of its work in a work directory
-(&lt;MEDLEYDIR&gt;loadups/build). The target files are copied from this
-work directory to the loadups directory if the loadup is successful.
-Each stage of the loadup also creates a dribble file containing the
-terminal output from within the Medley environment. These dribble files
-are not copied to the loadups directory, but remain available in the
-work directory after the loadup completes.</p>
-<p>Only one instance (per &lt;MEDLEIDIR&gt;) of loadup can be run at a
-time. (The lock file is in the work directory and is named
-<strong><em>lock</em></strong>. It can be removed in case of an
-uncontrolled failure of the loadup procedure.)</p>
-<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
-the loadup script. It is set to the top level directory of the Medley
-installation that contains the specific loadup script that is invoked
-after all symbolic links are resolved. In the standard global
-installation this will be /usr/local/interlisp/medley. But Medley can be
-installed in multiple places on any given machine and hence MEDLEYDIR is
-computed on each invocation of loadup.</p>
+<p>Loadup does all of its work in a work directory (&lt;MEDLEYDIR&gt;loadups/build). The target files are copied from this work directory to the loadups directory if the loadup is successful. Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment. These dribble files are also copied to the loadups directory, but also remain available in the work directory after the loadup completes.</p>
+<p>Only one instance (per &lt;MEDLEIDIR&gt;) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named <strong><em>lock</em></strong>) that can be manually removed. The lock can also be automatically overridden (see the –override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.</p>
+<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of loadup.</p>
 <h1>OPTIONS</h1>
 <dl>
 <dt><strong>-z, --man, -man</strong></dt>
-<dd>
-<p>Print this manual page on the screen.</p>
+<dd><p>Print this manual page on the screen.</p>
 </dd>
 <dt><strong>-t STAGE, --target STAGE, -target STAGE</strong></dt>
-<dd>
-<p>Run the sequential loadup procedure until the STAGE is complete,
-starting from the files created by the previously run STAGE specified in
-the –start option.</p>
+<dd><p>Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the –start option.</p>
 <p>STAGE can be one of the following:</p>
 <blockquote>
-<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
-Init.dlinit is <em>not</em> copied into the loadups directory.</p>
+<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit). Init.dlinit is <em>not</em> copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
-<p>m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout).
-Init-mid.sysout is <em>not</em> copied into the loadups directory.</p>
+<p>m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout). Init-mid.sysout is <em>not</em> copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
-<p>l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout).
-Lisp.sysout is copied into the loadups directory.</p>
+<p>l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout). Lisp.sysout is copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
-<p>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout).
-Full.sysout is copied into the loadups directory.</p>
+<p>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
-<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
-Also run the Aux stage as if –aux option had been specified. Apps.sysout
-and the Aux files are copied into the loadups directory.</p>
+<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if –aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.</p>
 </blockquote>
 <blockquote>
-<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
-The Aux stage is not run unless otherwise specified. Apps.sysout is
-copied into the loadups directory. Also run the Aux stage as if –aux
-option had been specified.</p>
+<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if –aux option had been specified.</p>
 </blockquote>
 </dd>
 <dt><strong>-s STAGE --start STAGE, -start STAGE</strong></dt>
-<dd>
-<p>Start the loadup process using the files previously created by STAGE.
-These files are looked for first in the loadups directory or, if not
-found there, in the work directory. It is an error if the files created
-by STAGE cannot be found.</p>
+<dd><p>Start the loadup process using the files previously created by STAGE. These files are looked for first in the loadups directory or, if not found there, in the work directory. It is an error if the files created by STAGE cannot be found.</p>
 <p>STAGE can be one of the following:</p>
 <blockquote>
-<p>s, scratch, 0 : Start the loadup process from the beginning. This is
-the default.</p>
+<p>s, scratch, 0 : Start the loadup process from the beginning. This is the default.</p>
 </blockquote>
 <blockquote>
-<p>i, init, 1 : Start the loadup process using the files created by
-Stage 1 (init.dlinit).</p>
+<p>i, init, 1 : Start the loadup process using the files created by Stage 1 (init.dlinit).</p>
 </blockquote>
 <blockquote>
-<p>m, mid, 2 : Start the loadup process using the files created by Stage
-2 (init-mid.sysout).</p>
+<p>m, mid, 2 : Start the loadup process using the files created by Stage 2 (init-mid.sysout).</p>
 </blockquote>
 <blockquote>
-<p>l, lisp, 3 : Start the loadup process using the files created by
-Stage 3 (lisp.sysout)</p>
+<p>l, lisp, 3 : Start the loadup process using the files created by Stage 3 (lisp.sysout)</p>
 </blockquote>
 <blockquote>
-<p>f, full, 4 : Start the loadup process using the files created by
-Stage 4 (full.sysout).</p>
+<p>f, full, 4 : Start the loadup process using the files created by Stage 4 (full.sysout).</p>
 </blockquote>
 </dd>
 <dt><strong>-x, --aux, -aux</strong></dt>
-<dd>
-<p>Run the Aux loadup stage, creating the <em>whereis.hash</em> and
-<em>exports.all</em> files. If loadup completes successfully, these
-files are copied into loadups.</p>
+<dd><p>Run the Aux loadup stage, creating the <em>whereis.hash</em> and <em>exports.all</em> files. If loadup completes successfully, these files are copied into loadups.</p>
 </dd>
 <dt><strong>-b, --db, -db</strong></dt>
-<dd>
-<p>Run the DB loadup stage, creating the <em>fuller.database</em> file.
-If this stage complete successfully, these files are copied into
-loadups.</p>
+<dd><p>Run the DB loadup stage, creating the <em>fuller.database</em> file. If this stage complete successfully, these files are copied into loadups.</p>
 </dd>
 <dt><strong>-i, --init, -init, -1</strong></dt>
-<dd>
-<p>Synonym for “–target init”</p>
+<dd><p>Synonym for “–target init”</p>
 </dd>
 <dt><strong>-m, --mid, -mid, -2</strong></dt>
-<dd>
-<p>Synonym for “–target mid”</p>
+<dd><p>Synonym for “–target mid”</p>
 </dd>
 <dt><strong>-l, --lisp, -lisp, -3</strong></dt>
-<dd>
-<p>Synonym for “–target lisp”</p>
+<dd><p>Synonym for “–target lisp”</p>
 </dd>
 <dt><strong>-f, --full. -full, -4</strong></dt>
-<dd>
-<p>Synonym for “–target full”</p>
+<dd><p>Synonym for “–target full”</p>
 </dd>
 <dt><strong>-a, --apps, -apps, -5</strong></dt>
-<dd>
-<p>Synonym for “–target apps”</p>
+<dd><p>Synonym for “–target apps”</p>
 </dd>
 <dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
-<dd>
-<p>Synonym for “–target apps”</p>
+<dd><p>Synonym for “–target apps”</p>
+</dd>
+<dt><strong>-ov, --override, -override</strong></dt>
+<dd><p>Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.</p>
 </dd>
 <dt><strong>-nc, --nocopy, -nocopy</strong></dt>
-<dd>
-<p>Run the specified loadups, but do not copy results into loadups
-directory.</p>
+<dd><p>Run the specified loadups, but do not copy results into loadups directory.</p>
 </dd>
 <dt><strong>-tw, --thinw, -thinw</strong></dt>
-<dd>
-<p>Before running loadups (if any), thin the working directory by
-deleting all versioned (<em>.~[0-9]</em>~) files.</p>
+<dd><p>Before running loadups (if any), thin the working directory by deleting all versioned (<em>.~[0-9]</em>~) files.</p>
 </dd>
 <dt><strong>-tl, --thinl, -thinl</strong></dt>
-<dd>
-<p>Before running loadups (if any), thin the loadups directory by
-deleting all versioned (<em>.~[0-9]</em>~) files.</p>
+<dd><p>Before running loadups (if any), thin the loadups directory by deleting all versioned (<em>.~[0-9]</em>~) files.</p>
 </dd>
-<dt><strong>-d DIR --maikodir DIR, -maikodir DIR</strong></dt>
-<dd>
-<p>Use DIR as the directory from which to execute lde (Miko) when
-running Medley in the loadup process. If this flag is not present, the
-value of the environment variable MAIKODIR will be used instead. And if
-MAIKODIR does not exist, then the default Maiko directory search within
-Medley will be used.</p>
+<dt><strong>-d DIR, --maikodir DIR, -maikodir DIR</strong></dt>
+<dd><p>Use DIR as the directory from which to execute lde (Miko) when running Medley in the loadup process. If this flag is not present, the value of the environment variable MAIKODIR will be used instead. And if MAIKODIR does not exist, then the default Maiko directory search within Medley will be used.</p>
+</dd>
+<dt><strong>-v, --vnc, -vnc</strong></dt>
+<dd><p>Relevant to Linux (including WSLv1 and WSLv2) platforms only. Use Xvnc for the Medley display during this loadup. By default, the Medley display will use X Windows. This flag is most useful on Windows System for Linux v1, where Xvnc is commonly used in running Medley in the absence of an Xwindows server.</p>
 </dd>
 </dl>
 <h1>DEFAULTS</h1>
-<p>The defaults for the Options context-dependent and somewhat
-complicated due to the goal of maintaining compatibility with legacy
-loadup scripts. All of the following defaults rules hold independent of
-the –maikodir (-d) option.</p>
+<p>The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the –maikodir (-d) option.</p>
 <ol type="1">
-<li><p>If none of –target, –start, –aux, and –db are specified,
-then:</p>
-<p>1A. If neither –thinw nor –thinl are specified, the options default
-to:</p>
+<li><p>If none of –target, –start, –aux, and –db are specified, then:</p>
+<p>1A. If neither –thinw nor –thinl are specified, the options default to:</p>
 <blockquote>
 <p><strong>–target full –start 0 –aux</strong></p>
 </blockquote>
-<p>1B. If either –thinw or –thinl are specified, no loadups are
-run.</p></li>
-<li><p>If neither –start nor –target are specified but either -aux or
--db or both are, then –start defaults to <em>full</em> and –target is
-irrelevant.</p></li>
-<li><p>If –start is specified and –target is not, then –target defaults
-to <em>full</em></p></li>
-<li><p>If –target is specified and –start is not, then –start defaults
-to <em>0</em></p></li>
+<p>1B. If either –thinw or –thinl are specified, no loadups are run.</p></li>
+<li><p>If neither –start nor –target are specified but either -aux or -db or both are, then –start defaults to <em>full</em> and –target is irrelevant.</p></li>
+<li><p>If –start is specified and –target is not, then –target defaults to <em>full</em></p></li>
+<li><p>If –target is specified and –start is not, then –start defaults to <em>0</em></p></li>
 </ol>
 <h1>EXAMPLES</h1>
-<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
-(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).</p>
-<p><strong>./loadup --target full --start lisp</strong> : run loadup
-thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
-(lisp.sysout).</p>
-<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning
-thru Stage 5 (apps.sysout) then run the Aux “stage” to create
-<em>whereis.hash</em> and <em>exports.all</em></p>
-<p><strong>./loadup -db</strong> : just run the DB “stage” starting from
-an existing full.sysout; do not run any of the sequential stages.</p>
-<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup
-sequence from beginning to full plus the loadup Aux stage, while using
-<em>~/il/newmaiko</em> as the location for the lde executables when
-running Medley.</p>
-<p><strong>./loadup -full</strong> : run loadup sequence from beginning
-thru full</p>
-<p><strong>./loadup -apps</strong> : run loadup sequence from beginning
-thru app. Also run the Aux stage loadup.</p>
-<p><strong>./loadup -apps-</strong> : run loadup sequence from beginning
-thru app. Do not run the Aux stage loadup.</p>
+<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).</p>
+<p><strong>./loadup --target full --start lisp</strong> : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).</p>
+<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux “stage” to create <em>whereis.hash</em> and <em>exports.all</em></p>
+<p><strong>./loadup -db</strong> : just run the DB “stage” starting from an existing full.sysout; do not run any of the sequential stages.</p>
+<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup sequence from beginning to full plus the loadup Aux stage, while using <em>~/il/newmaiko</em> as the location for the lde executables when running Medley.</p>
+<p><strong>./loadup -full</strong> : run loadup sequence from beginning thru full</p>
+<p><strong>./loadup -apps</strong> : run loadup sequence from beginning thru app. Also run the Aux stage loadup.</p>
+<p><strong>./loadup -apps-</strong> : run loadup sequence from beginning thru app. Do not run the Aux stage loadup.</p>
 <h1>BUGS</h1>
-<p>See GitHub Issues:
-&lt;https://github.com/Interlisp/medley/issues&gt;</p>
+<p>See GitHub Issues: &lt;https://github.com/Interlisp/medley/issues&gt;</p>
 <h1>COPYRIGHT</h1>
 <p>Copyright(c) 2025 by Interlisp.org</p>

library/PDFSTREAM

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62
 14729  
+
(FILECREATED " 5-Jun-2025 08:42:11" {WMEDLEY}<library>PDFSTREAM.;64
 14885  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS OPEN-PDF-STREAM)
 
-      :PREVIOUS-DATE "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60)
+      :PREVIOUS-DATE "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62)
 
 
 (PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -153,7 +153,8 @@
 (DEFINEQ
 
 (OPEN-PDF-STREAM

-  [LAMBDA (FILE OPTIONS)
                                     (* ; "Edited 23-Feb-2025 12:18 by rmk")


+  [LAMBDA (FILE OPTIONS)
                                     (* ; "Edited  5-Jun-2025 08:41 by rmk")


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


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


                                                              (* ; "Edited 22-Sep-2023 11:04 by rmk")


                                                              (* ; "Edited 24-Jun-2023 14:49 by rmk")

@@ -165,8 +166,6 @@
     (* ;; 
 
    "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.")

 
-    (* ;; "")

-
     (if
 [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST]
         then
 
              (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting.  But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")

@@ -178,8 +177,9 @@
              (* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index.  Nothing to convert")

 
              (OPENPOSTSCRIPTSTREAM FILE OPTIONS)
-      elseif
 (SETQ FILE (OR (AND (NEQ FILE T)
-                                 (OUTFILEP FILE))
+      elseif
 (SETQ FILE (OR [AND (NEQ FILE T)
+                                 (OR (OUTFILEP FILE)
+                                     (OPENSTREAM FILE 'OUTPUT]
                             (ERROR "PDF target file not found" FILE)))
         then
 (CL:UNLESS (ASSOC (PDFCONVERTER
)
                                PDF-CONVERTER-TEMPLATES)
@@ -293,7 +293,7 @@
 )
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
-PDF.TEDIT 5508 . 5875)) (6317 13806 (OPEN-PDF-STREAM 6327 . 8892) (CLOSE-PDF-STREAM 8894 . 10181) (
-PS-TO-PDF 10183 . 13804)) (13807 14371 (SEE-PDF 13817 . 14369)) (14422 14706 (PDFCONVERTER 14432 . 
-14704)))))
+PDF.TEDIT 5508 . 5875)) (6317 13962 (OPEN-PDF-STREAM 6327 . 9048) (CLOSE-PDF-STREAM 9050 . 10337) (
+PS-TO-PDF 10339 . 13960)) (13963 14527 (SEE-PDF 13973 . 14525)) (14578 14862 (PDFCONVERTER 14588 . 
+14860)))))
 STOP

library/PSEUDOHOSTS

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Dec-2024 11:45:23" {WMEDLEY}<library>PSEUDOHOSTS.;177
 29713  
+
(FILECREATED "16-May-2025 12:07:44" {DSK}<home>frank>il>qmedley>library>PSEUDOHOSTS.;2
 31408  
 
-      :EDIT-BY rmk
+      :CHANGES-TO (FNS PSEUDOHOSTS)
 
-      :CHANGES-TO (FNS TRUEDEVICE)
-
-      :PREVIOUS-DATE "25-Dec-2024 07:38:10" {WMEDLEY}<library>PSEUDOHOSTS.;176)
+      :PREVIOUS-DATE "31-Dec-2024 11:45:23" {DSK}<home>frank>il>qmedley>library>PSEUDOHOSTS.;1)
 
 
 (PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -151,10 +149,32 @@
                           DEV)))])
 
 (PSEUDOHOSTS

-  [LAMBDA NIL
                                                (* ; "Edited 17-Jan-2022 18:15 by rmk")

-    (FOR
 DEV IN
 \FILEDEVICES WHEN
 (TYPE?
 FDEV (FETCH
 (PHDEVICE TARGETDEV) OF
 DEV))
-       COLLECT
 (LIST (FETCH
 (FDEV DEVICENAME) OF
 DEV)
-                     (FETCH
 (PHDEVICE PREFIX) OF
 DEV])
+  [LAMBDA (NEW.HOSTS)
                                        (* ; "Edited 17-Jan-2022 18:15 by rmk")


+                                                             (* ; "Edited 16-May-2025 9:16 by fgh")

+
+    (* ;; "")

+
+    (* ;; " Returns existing list of PSEUDOHOST pairs.  If NEW.HOSTS is T, all current pseudohosts are removed by calling (PSEUDOHOST HOST NIL) on each current pseudohost in turn.  Otherwise, NEW.HOSTS should be a list of (HOST PREFIX) pairs and all current pseudohosts are r(PSEUDOHOSTSemoved (as above) and the NEW.HOSTS pairs are used to create new pseudohosts by calling (PSEUDOHOST HOST PREFIX) sequentially in reverse order of the NEW.HOSTS list. Reverse order to ensure that (PSEUDOHOSTS (PSEUDOHOSTS))  doesn't impact the ordering in the PSEUDOHOST list.  This function is designed to be used cleanly with RESETSAVE.")

+
+    (* ;; "")

+
+    (LET [(CURRENT.HOSTS (for
 DEV in
 \FILEDEVICES when
 (type?
 FDEV (fetch
 (PHDEVICE TARGETDEV)
+                                                                      of
 DEV))
+                            collect
 (LIST (fetch
 (FDEV DEVICENAME) of
 DEV)
+                                          (fetch
 (PHDEVICE PREFIX) of
 DEV]
+         [COND
+            ((EQ NEW.HOSTS T)
+             (for
 HOST in
 CURRENT.HOSTS do
 (PSEUDOHOST
 (CAR HOST)
+                                                  NIL)))
+            [[AND (LISTP NEW.HOSTS)
+                  (for
 HOST in
 NEW.HOSTS always
 (AND (LISTP HOST)
+                                                     (NOT (CDDR HOST]
+             (for
 HOST in
 CURRENT.HOSTS do
 (PSEUDOHOST
 (CAR HOST)
+                                                  NIL))
+             (for
 HOST in
 (REVERSE NEW.HOSTS) do
 (PSEUDOHOST
 (CAR HOST)
+                                                        (CADR HOST]
+            (NEW.HOSTS (ERROR (CONCAT "PSEUDOHOSTS: Argument not valid:" NEW.HOSTS]
+         CURRENT.HOSTS])
 
 (TARGETHOST

   [LAMBDA (HOST)
                                             (* ; "Edited 14-Dec-2024 15:26 by rmk")


@@ -562,13 +582,13 @@
        EXPORTS.ALL)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1318 12059 (PSEUDOHOST 1328 . 7036) (PSEUDOHOSTP 7038 . 7867) (PSEUDOHOSTS 7869 . 8230)
- (TARGETHOST 8232 . 9101) (TRUEDEVICE 9103 . 10059) (TRUEFILENAME 10061 . 11186) (PSEUDOFILENAME 11188
- . 12057)) (12087 18102 (EXPAND.PH 12097 . 13350) (CONTRACT.PH 13352 . 16063) (UNSLASHIT 16065 . 17811
-) (GETHOSTINFO.PH 17813 . 18100)) (18103 19004 (CDPSEUDO 18113 . 19002)) (19005 27025 (OPENFILE.PH 
-19015 . 20088) (GETFILENAME.PH 20090 . 20379) (DIRECTORYNAMEP.PH 20381 . 21005) (CLOSEFILE.PH 21007 . 
-21474) (REOPENFILE.PH 21476 . 22041) (DELETEFILE.PH 22043 . 22327) (OPENP.PH 22329 . 22624) (
-UNREGISTERFILE.PH 22626 . 23168) (REGISTERFILE.PH 23170 . 23704) (GENERATEFILES.PH 23706 . 24750) (
-GETFILEINFO.PH 24752 . 25054) (SETFILEINFO.PH 25056 . 25255) (NEXTFILEFN.PH 25257 . 25803) (
-FILEINFOFN.PH 25805 . 26080) (RENAMEFILE.PH 26082 . 27023)))))
+  (FILEMAP (NIL (1331 13754 (PSEUDOHOST 1341 . 7049) (PSEUDOHOSTP 7051 . 7880) (PSEUDOHOSTS 7882 . 9925)
+ (TARGETHOST 9927 . 10796) (TRUEDEVICE 10798 . 11754) (TRUEFILENAME 11756 . 12881) (PSEUDOFILENAME 
+12883 . 13752)) (13782 19797 (EXPAND.PH 13792 . 15045) (CONTRACT.PH 15047 . 17758) (UNSLASHIT 17760 . 
+19506) (GETHOSTINFO.PH 19508 . 19795)) (19798 20699 (CDPSEUDO 19808 . 20697)) (20700 28720 (
+OPENFILE.PH 20710 . 21783) (GETFILENAME.PH 21785 . 22074) (DIRECTORYNAMEP.PH 22076 . 22700) (
+CLOSEFILE.PH 22702 . 23169) (REOPENFILE.PH 23171 . 23736) (DELETEFILE.PH 23738 . 24022) (OPENP.PH 
+24024 . 24319) (UNREGISTERFILE.PH 24321 . 24863) (REGISTERFILE.PH 24865 . 25399) (GENERATEFILES.PH 
+25401 . 26445) (GETFILEINFO.PH 26447 . 26749) (SETFILEINFO.PH 26751 . 26950) (NEXTFILEFN.PH 26952 . 
+27498) (FILEINFOFN.PH 27500 . 27775) (RENAMEFILE.PH 27777 . 28718)))))
 STOP

lispusers/DINFO

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-May-2024 13:19:49" {WMEDLEY}<lispusers>DINFO.;14
 65819  
+
(FILECREATED " 9-May-2025 21:15:54" {WMEDLEY}<lispusers>DINFO.;19
 67369  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS DINFO.OPENTEXTSTREAM DINFO.UPDATE.TEXT.DISPLAY)
+      :CHANGES-TO (FNS DINFO.CLOSEFN DINFO.UPDATE.FROM.GRAPH DINFO.GET.GRAPH.WINDOW 
+                       DINFO.OPENTEXTSTREAM)
 
-      :PREVIOUS-DATE "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13)
+      :PREVIOUS-DATE " 7-May-2025 10:13:33" {WMEDLEY}<lispusers>DINFO.;17)
 
 
 (PRETTYCOMPRINT DINFOCOMS)
@@ -482,12 +483,19 @@
     (WINDOWADDPROP WINDOW 'EXPANDFN 'DINFO.EXPANDFN])
 
 (DINFO.CLOSEFN

-  [LAMBDA (W)
                                                (* drc%: "25-Jan-86 18:26")

+  [LAMBDA (W)
                                                (* ; "Edited  9-May-2025 21:15 by rmk")

+                                                             (* drc%: "25-Jan-86 18:26")

+
+    (* ;; 
+
    "This closes the DINFO text window. When the text window closes, the graph window closes too.")

+
+    (* ;; "There is a potential cycle from the graph to the the text window and then back to the graph.  To clean this up, every window should have a pointer to this window, and this window would point to the DINFOGRAPH.  If we ever wanted to collect (why would we?), we would have a single place to break the link.")

+
     (LET [(GRAPH (WINDOWPROP W 'DINFOGRAPH]
-         (if
 (type?
 DINFOGRAPH GRAPH)
-             then
 (CLOSEW (fetch
 (DINFOGRAPH
 GRAPH.WINDOW) of
 GRAPH)) 
-                                                             (* remove circularity...)

-                  (WINDOWPROP W 'DINFOGRAPH NIL])
+         (CL:WHEN (type?
 DINFOGRAPH GRAPH)
+             (CLOSEW (fetch
 (DINFOGRAPH
 GRAPH.WINDOW) of
 GRAPH))
+                                                             (* ; "remove circularity...")

+             (AND NIL (WINDOWPROP W 'DINFOGRAPH NIL)))])
 
 (DINFO.SHRINKFN

   [LAMBDA (W)
                                                (* drc%: "25-Jan-86 18:26")

@@ -856,20 +864,28 @@
                        (fetch
 (DINFONODE LABEL) of
 (fetch
 (DINFOGRAPH
 CURRENTNODE) of
 DINFO.GRAPH])
 
 (DINFO.UPDATE.FROM.GRAPH

-  [LAMBDA (GRAPHER.NODE GRAPH.WINDOW)
                        (* ; "Edited  9-Mar-2024 14:21 by rmk")

+  [LAMBDA (GRAPHER.NODE GRAPH.WINDOW)
                        (* ; "Edited  9-May-2025 16:16 by rmk")


+                                                             (* ; "Edited  9-Mar-2024 14:21 by rmk")

                                                              (* drc%: "12-Dec-85 18:34")

-    (AND GRAPHER.NODE (ADD.PROCESS `[DINFO.UPDATE
 ',(WINDOWPROP GRAPH.WINDOW 'DINFOGRAPH)
-                                           ',(fetch
 (GRAPHNODE NODEID) of
 GRAPHER.NODE]
-                             'NAME "DInfo From Graph"])
+    (CL:WHEN GRAPHER.NODE
+        (ADD.PROCESS `[DINFO.UPDATE
 ',(WINDOWPROP GRAPH.WINDOW 'DINFOGRAPH)
+                             ',(fetch
 (GRAPHNODE NODEID) of
 GRAPHER.NODE]
+               'NAME "DInfo From Graph"))])
 
 (DINFO.GET.GRAPH.WINDOW

-  [LAMBDA (GRAPH REGION)
                                     (* drc%: "25-Jan-86 18:05")

+  [LAMBDA (GRAPH REGION)
                                     (* ; "Edited  9-May-2025 16:21 by rmk")

+                                                             (* drc%: "25-Jan-86 18:05")

+
+    (* ;; "Given a graph, this creates the window with the nodes to click on.  The graph points to the graph window, and the graph window points to the graph. On closing the cycle is broken by removing the window's pointer to the graph.")

+
+    (* ;; "Note that the DINFO text window is not part of this.")

+
     (LET ((W (fetch
 (DINFOGRAPH
 GRAPH.WINDOW) of
 GRAPH)))
          (COND
             ((WINDOWP W))
             (T (SETQ W (DINFO.CREATE.GRAPH.WINDOW
 GRAPH REGION))
-               [WINDOWPROP W 'CLOSEFN (FUNCTION (LAMBDA (W)
-                                                  (WINDOWPROP W 'DINFOGRAPH NIL]
+               [AND NIL (WINDOWPROP W 'CLOSEFN (FUNCTION (LAMBDA (W)
+                                                           (WINDOWPROP W 'DINFOGRAPH NIL]
                (replace
 (DINFOGRAPH
 GRAPH.WINDOW) of
 GRAPH with
 W)))
          (WINDOWPROP W 'DINFOGRAPH GRAPH)
          W])
@@ -988,7 +1004,8 @@
 (DEFINEQ
 
 (DINFO.UPDATE.TEXT.DISPLAY

-  [LAMBDA (GRAPH NODE SEL OFF?)
                              (* ; "Edited 25-May-2024 13:16 by rmk")

+  [LAMBDA (GRAPH NODE SEL OFF?)
                              (* ; "Edited  6-May-2025 23:45 by rmk")


+                                                             (* ; "Edited 25-May-2024 13:16 by rmk")

                                                              (* drc%: "25-Jan-86 18:18")

                                                              (* drc%: "25-Jan-86 18:18")

     (LET ((WINDOW (fetch
 (DINFOGRAPH
 WINDOW) of
 GRAPH))
@@ -1005,7 +1022,7 @@
                          WINDOW NIL NIL PROPS)
                   (replace
 (DINFOGRAPH
 LAST.TEXT) of
 GRAPH with
 NIL)
            elseif
 (SETQ FULLFILENAME (MKATOM (INFILEP FILENAME)))
-             then
 (SETQ TEXTSTREAM (DINFO.OPENTEXTSTREAM
 FULLFILENAME WINDOW FROM TO PROPS))
+             then
 (SETQ TEXTSTREAM (DINFO.OPENTEXTSTREAM
 FULLFILENAME GRAPH WINDOW FROM TO PROPS))
                   (DINFO.SHOWSEL
 TEXTSTREAM SEL)
            else
 (OPENTEXTSTREAM (OPENSTRINGSTREAM (CONCAT "Sorry, can't find the text for this node."
                                                          (MKSTRING (CHARACTER (CHARCODE CR)))
@@ -1037,7 +1054,9 @@
                 (PROMPTPRINT "DInfo is busy"])
 
 (DINFO.OPENTEXTSTREAM

-  [LAMBDA (FILE WINDOW FROM TO PROPS)
                        (* ; "Edited 25-May-2024 13:17 by rmk")


+  [LAMBDA (FILE GRAPH WINDOW FROM TO PROPS)
                  (* ; "Edited  9-May-2025 12:37 by rmk")


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


+                                                             (* ; "Edited 25-May-2024 13:17 by rmk")


                                                              (* ; "Edited 10-Apr-2024 23:46 by rmk")


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

                                                              (* drc%: "25-Jan-86 18:24")

@@ -1054,9 +1073,10 @@
                   else
 (CL:WHEN TEXTSTREAM (TEDIT.KILL TEXTSTREAM))
                        (CLEARW T)
                        (CLEARW WINDOW)
+                       (WINDOWPROP WINDOW 'DINFOGRAPH GRAPH)
                        [RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
                        (PROG1 (TEDIT (OPENTEXTSTREAM FILE NIL FROM TO PROPS)
-                                     WINDOW)
+                                     (OR WINDOW 'DINFO))
                            (replace
 (DINFOGRAPH
 LAST.TEXT) of
 (DINFOGRAPH
 WINDOW) with
 THIS.TEXT))])
 
 (DINFO.SHOWSEL

@@ -1113,21 +1133,21 @@
 (SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4582 6041 (DINFOGRAPHPROP 4582 . 6041)) (7295 24433 (DINFO 7305 . 8919) (DINFO.UPDATE 
-8921 . 11785) (DINFOGRAPH 11787 . 12205) (DINFO.SPECIAL.UPDATE 12207 . 13905) (DINFO.READ.GRAPH 13907
- . 15762) (DINFO.WRITE.GRAPH 15764 . 16854) (DINFO.SELECT.GRAPH 16856 . 17763) (DINFO.DEFAULT.MENU 
-17765 . 20289) (DINFO.FIND 20291 . 22877) (DINFO.LOOKUP 22879 . 24431)) (24434 27128 (
-DINFO.READ.KOTO.GRAPH 24444 . 27126)) (27129 29443 (DINFO.SETUP.WINDOW 27139 . 27820) (DINFO.CLOSEFN 
-27822 . 28255) (DINFO.SHRINKFN 28257 . 28453) (DINFO.EXPANDFN 28455 . 29012) (DINFO.ICONFN 29014 . 
-29441)) (29444 40766 (DINFO.ADD.FMENU 29454 . 30549) (DINFO.CREATE.FMENU 30551 . 34578) (
-DINFO.FMW.CLOSEFN 34580 . 35425) (DINFO.FMENU.HANDLER 35427 . 36066) (DINFO.UPDATE.FMENU 36068 . 38257
-) (DINFO.TOGGLE.MENU 38259 . 38849) (DINFO.TOGGLE.GRAPH 38851 . 39350) (DINFO.TOGGLE.HISTORY 39352 . 
-39896) (DINFO.TOGGLE.TEXT 39898 . 40764)) (40767 48562 (DINFO.UPDATE.MENU.DISPLAY 40777 . 44898) (
-DINFO.UPDATE.FROM.MENU 44900 . 45199) (DINFO.UPDATE.HISTORY 45201 . 47731) (DINFO.HISTORIC.UPDATE 
-47733 . 48560)) (48563 58892 (DINFO.UPDATE.GRAPH.DISPLAY 48573 . 50025) (DINFO.UPDATE.FROM.GRAPH 50027
- . 50503) (DINFO.GET.GRAPH.WINDOW 50505 . 51090) (DINFO.CREATE.GRAPH.WINDOW 51092 . 52209) (
-DINFO.SHOWGRAPH 52211 . 53936) (DINFO.INVERT.NODE 53938 . 55326) (DINFO.LAYOUTGRAPH 55328 . 58890)) (
-58893 65232 (DINFO.UPDATE.TEXT.DISPLAY 58903 . 60963) (DINFO.TITLEMENUFN 60965 . 62090) (
-DINFO.OPENTEXTSTREAM 62092 . 63592) (DINFO.SHOWSEL 63594 . 64327) (DINFO.GET.FILENAME 64329 . 65230)))
+  (FILEMAP (NIL (4641 6100 (DINFOGRAPHPROP 4641 . 6100)) (7354 24492 (DINFO 7364 . 8978) (DINFO.UPDATE 
+8980 . 11844) (DINFOGRAPH 11846 . 12264) (DINFO.SPECIAL.UPDATE 12266 . 13964) (DINFO.READ.GRAPH 13966
+ . 15821) (DINFO.WRITE.GRAPH 15823 . 16913) (DINFO.SELECT.GRAPH 16915 . 17822) (DINFO.DEFAULT.MENU 
+17824 . 20348) (DINFO.FIND 20350 . 22936) (DINFO.LOOKUP 22938 . 24490)) (24493 27187 (
+DINFO.READ.KOTO.GRAPH 24503 . 27185)) (27188 30053 (DINFO.SETUP.WINDOW 27198 . 27879) (DINFO.CLOSEFN 
+27881 . 28865) (DINFO.SHRINKFN 28867 . 29063) (DINFO.EXPANDFN 29065 . 29622) (DINFO.ICONFN 29624 . 
+30051)) (30054 41376 (DINFO.ADD.FMENU 30064 . 31159) (DINFO.CREATE.FMENU 31161 . 35188) (
+DINFO.FMW.CLOSEFN 35190 . 36035) (DINFO.FMENU.HANDLER 36037 . 36676) (DINFO.UPDATE.FMENU 36678 . 38867
+) (DINFO.TOGGLE.MENU 38869 . 39459) (DINFO.TOGGLE.GRAPH 39461 . 39960) (DINFO.TOGGLE.HISTORY 39962 . 
+40506) (DINFO.TOGGLE.TEXT 40508 . 41374)) (41377 49172 (DINFO.UPDATE.MENU.DISPLAY 41387 . 45508) (
+DINFO.UPDATE.FROM.MENU 45510 . 45809) (DINFO.UPDATE.HISTORY 45811 . 48341) (DINFO.HISTORIC.UPDATE 
+48343 . 49170)) (49173 60036 (DINFO.UPDATE.GRAPH.DISPLAY 49183 . 50635) (DINFO.UPDATE.FROM.GRAPH 50637
+ . 51208) (DINFO.GET.GRAPH.WINDOW 51210 . 52234) (DINFO.CREATE.GRAPH.WINDOW 52236 . 53353) (
+DINFO.SHOWGRAPH 53355 . 55080) (DINFO.INVERT.NODE 55082 . 56470) (DINFO.LAYOUTGRAPH 56472 . 60034)) (
+60037 66782 (DINFO.UPDATE.TEXT.DISPLAY 60047 . 62222) (DINFO.TITLEMENUFN 62224 . 63349) (
+DINFO.OPENTEXTSTREAM 63351 . 65142) (DINFO.SHOWSEL 65144 . 65877) (DINFO.GET.FILENAME 65879 . 66780)))
 ))
 STOP

lispusers/GITFNS

@@ -1,28 +1,29 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539
 133841 
+(FILECREATED "29-Apr-2025 15:17:37" {WMEDLEY}<lispusers>GITFNS.;541 134267 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS GIT-GET-FILE GIT-RESULT-TO-LINES)
+      :CHANGES-TO (VARS GITFNSCOMS)
+                  (FNS GIT-WORKING-COMPARE-DIRECTORIES)
 
-      :PREVIOUS-DATE "21-Mar-2025 19:07:34" {WMEDLEY}<lispusers>GITFNS.;536)
+      :PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
 
-(RPAQQ GITFNSCOMS

+(RPAQQ GITFNSCOMS
        (
-        (* ;; "Set up")

+        (* ;; "Set up")
 
         (FILES (SYSLOAD FROM LISPUSERS)
                COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER
                )
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "GIT projects")

+        (* ;; "GIT projects")
 
         (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD 
                    GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH 
@@ -43,94 +44,94 @@
         (P (GIT-INIT))
         (ADDVARS (AROUNDEXITFNS GIT-INIT))
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "Lisp exec commands")

+        (* ;; "Lisp exec commands")
 
         (INITVARS (GIT-MERGE-COMPARES T)
                (GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
         (COMMANDS gwc bbc prc cob b? cdg cdw)
         (FNS PRC-COMMAND)
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "File correspondents")

+        (* ;; "File correspondents")
 
         (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
         (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
         (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
         (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "Git commands")

+        (* ;; "Git commands")
 
         (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? 
              GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY 
              GIT-FETCH)
         
-        (* ;; "Differences")

+        (* ;; "Differences")
 
         (FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "Branches")

+        (* ;; "Branches")
 
         (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES 
              GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-BRANCH-WHENSELECTEDFN 
              GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
         
-        (* ;; "My branches")

+        (* ;; "My branches")
 
         (FNS GIT-MY-CURRENT-BRANCH GIT-MY-BRANCHP GIT-MY-NEXT-BRANCH GIT-MY-BRANCHES)
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "Worktrees")

+        (* ;; "Worktrees")
 
         (FNS GIT-ADD-WORKTREE GIT-REMOVE-WORKTREE GIT-LIST-WORKTREES WORKTREEDIR)
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "Comparisons")

+        (* ;; "Comparisons")
 
         (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES
              GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN 
              GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE)
         (INITVARS (FROMGITN 0))
         
-        (* ;; "")

+        (* ;; "")
 
         
-        (* ;; "Utilities")

+        (* ;; "Utilities")
 
         (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES 
              STRIPLOCAL)
-        (PROPS (GITFNS FILETYPE))))
+        (PROPS (GITFNS FILETYPE))))
 
 
 
-(* ;; "Set up")

+(* ;; "Set up")
 
 
-(FILESLOAD (SYSLOAD FROM LISPUSERS)
+(
FILESLOAD (SYSLOAD FROM LISPUSERS)
        COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER)
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "GIT projects")

+(* ;; "GIT projects")
 
 (DEFINEQ
 
@@ -401,15 +402,15 @@
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(TYPERECORD GIT-PROJECT
 (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
+(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
 
-(RECORD PULLREQUEST
 (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
+(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
 )
 )
 
-(RPAQ? GIT-DEFAULT-PROJECT
 'MEDLEY)
+(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
 
-(RPAQ? GIT-DEFAULT-PROJECTS

+(RPAQ? GIT-DEFAULT-PROJECTS
        '((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
                 (greetfiles scripts sources library lispusers internal doctools rooms))
          (NOTECARDS)
@@ -417,120 +418,120 @@
          (TEST)
          (MAIKO)))
 
-(RPAQ? GIT-PROJECTS
 NIL)
+(RPAQ? GIT-PROJECTS NIL)
 
-(RPAQ? GIT-PRC-MENUS
 NIL)
+(RPAQ? GIT-PRC-MENUS NIL)
 
-(GIT-INIT
)
+(GIT-INIT)
 
-(ADDTOVAR AROUNDEXITFNS
 GIT-INIT)
+(ADDTOVAR AROUNDEXITFNS GIT-INIT)
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "Lisp exec commands")

+(* ;; "Lisp exec commands")
 
 
-(RPAQ? GIT-MERGE-COMPARES
 T)
+(RPAQ? GIT-MERGE-COMPARES T)
 
-(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS
 T)
+(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
 
 (DEFCOMMAND gwc (SUBDIR . OTHERS)
 
-   (* ;; "Compares the specified local git-medley subdirectories against my working Medley.  The SUBDIRS are the arguments up to one that looks like a project")

+   (* ;; "Compares the specified local git-medley subdirectories against my working Medley.  The SUBDIRS are the arguments up to one that looks like a project")
 
-    (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
+    (
LET ((SUBDIRS (
AND SUBDIR (
CONS SUBDIR OTHERS)))
           PROJECT)
-         (SETQ SUBDIRS (FOR
 STAIL ON
 SUBDIRS COLLECT
 (IF
 (GIT-GET-PROJECT
 (CAR STAIL)
+         (
SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (
CAR STAIL)
                                                                 NIL T)
-                                                         THEN
 (SETQ PROJECT (CAR STAIL))
-                                                              (GO $$OUT))
-                                                   (CAR STAIL)))
-         (GIT-WORKING-COMPARE-DIRECTORIES
 SUBDIRS NIL NIL NIL T PROJECT)))
+                                                         THEN (
SETQ PROJECT (
CAR STAIL))
+                                                              (
GO $$OUT))
+                                                   (
CAR STAIL)))
+         (GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
 
 (DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
 
-   (* ;; "Compares 2 git branches.  Defaults to local/ if LOCAL, otherwise defaults to origin/.  BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")

+   (* ;; "Compares 2 git branches.  Defaults to local/ if LOCAL, otherwise defaults to origin/.  BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
 
-    (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-   (GIT-FETCH
 PROJECT)
-   (SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
+    (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
+   (GIT-FETCH PROJECT)
+   (
SETQ BRANCH1 (
SELECTQ (
U-CASE BRANCH1)
                      ((NIL T) 
-                          (GIT-MY-CURRENT-BRANCH
 PROJECT))
+                          (GIT-MY-CURRENT-BRANCH PROJECT))
                      ((LOCAL REMOTE ORIGIN) 
-                          (GIT-PICK-BRANCH
 (GIT-BRANCHES
 BRANCH1 PROJECT T)))
-                     (OR (GIT-LONG-NAME
 BRANCH1 NIL PROJECT)
+                          (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
+                     (
OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
                          BRANCH1)))
-   (SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
+   (
SETQ BRANCH2 (
SELECTQ (
U-CASE BRANCH2)
                      ((NIL T) 
-                          (GIT-MAINBRANCH
 PROJECT LOCAL))
+                          (GIT-MAINBRANCH PROJECT LOCAL))
                      ((LOCAL REMOTE ORIGIN) 
-                          (GIT-PICK-BRANCH
 (GIT-BRANCHES
 BRANCH2 PROJECT T)))
-                     (OR (GIT-LONG-NAME
 BRANCH2 NIL PROJECT)
+                          (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
+                     (
OR (GIT-LONG-NAME BRANCH2 NIL PROJECT)
                          BRANCH2)))
-   (GIT-BRANCHES-COMPARE-DIRECTORIES
 BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH
 PROJECT LOCAL))
+   (GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (
OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
           LOCAL PROJECT))
 
 (DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT)
 
-   (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")

+   (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
 
-    (PRC-COMMAND
 REMOTEBRANCH DRAFTS PROJECT))
+    (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
 
 (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
 
-   (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name.  Default is to bring up a menu of locally available branches.")

+   (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name.  Default is to bring up a menu of locally available branches.")
 
-    (CL:UNLESS (STRINGP NEXTTITLESTRING)
-           (SETQ PROJECT NEXTTITLESTRING))
+    (CL:UNLESS (
STRINGP NEXTTITLESTRING)
+           (
SETQ PROJECT NEXTTITLESTRING))
    (CL:UNLESS PROJECT
-       (CL:WHEN (GIT-GET-PROJECT
 BRANCH NIL T)
-           (SETQ PROJECT BRANCH)
-           (SETQ BRANCH NIL)))
-   (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-   (GIT-FETCH
 PROJECT)
-   (SELECTQ (U-CASE BRANCH)
-       (T (GIT-CHECKOUT
 (GIT-MY-CURRENT-BRANCH
 PROJECT)
+       (CL:WHEN (GIT-GET-PROJECT BRANCH NIL T)
+           (
SETQ PROJECT BRANCH)
+           (
SETQ BRANCH NIL)))
+   (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
+   (GIT-FETCH PROJECT)
+   (
SELECTQ (
U-CASE BRANCH)
+       (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
                  PROJECT))
        ((NEW NEXT) 
-            (GIT-MAKE-BRANCH
 NIL NEXTTITLESTRING PROJECT))
-       (CL:WHEN [SETQ BRANCH (IF
 BRANCH
-                                 THEN
 (GIT-LONG-NAME
 BRANCH NIL PROJECT)
-                               ELSE
 (GIT-PICK-BRANCH
 (GIT-BRANCHES
 'LOCAL PROJECT T)
-                                           (CONCAT (L-CASE (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME)
+            (GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT))
+       (CL:WHEN [
SETQ BRANCH (IF BRANCH
+                                 THEN (GIT-LONG-NAME BRANCH NIL PROJECT)
+                               ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
+                                           (
CONCAT (
L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
                                                           T)
                                                   " branches"]
-              (GIT-CHECKOUT
 BRANCH PROJECT))))
+              (GIT-CHECKOUT BRANCH PROJECT))))
 
-(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-   (GIT-FETCH
 PROJECT)
-   (CONCAT (L-CASE (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME)
+(DEFCOMMAND b? (PROJECT) (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
+   (GIT-FETCH PROJECT)
+   (
CONCAT (
L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
                   T)
           " "
-          (GIT-WHICH-BRANCH
 PROJECT)))
+          (GIT-WHICH-BRANCH PROJECT)))
 
-(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT
 PROJECT NIL T)
-                                     (SETQ SUBDIR PROJECT)
-                                     (SETQ PROJECT GIT-DEFAULT-PROJECT))
-   (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
-                             (CHARCODE (> /]
-       (SETQ SUBDIR (CONCAT SUBDIR "/")))
-   (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT
 PROJECT 'GITHOST)
-                           (OR SUBDIR "")))
+(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
+                                     (
SETQ SUBDIR PROJECT)
+                                     (
SETQ PROJECT GIT-DEFAULT-PROJECT))
+   (CL:WHEN [
AND SUBDIR (
NOT (
MEMB (
CHCON1 SUBDIR))
+                             (
CHARCODE (
> /]
+       (
SETQ SUBDIR (
CONCAT SUBDIR "/")))
+   (
SLASHIT (
/CNDIR (
CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST)
+                           (
OR SUBDIR "")))
           T))
 
-(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT
 PROJECT NIL T)
-                                     (SETQ SUBDIR PROJECT)
-                                     (SETQ PROJECT GIT-DEFAULT-PROJECT))
-   (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
-                             (CHARCODE (> /]
-       (SETQ SUBDIR (CONCAT SUBDIR "/")))
-   (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT
 PROJECT 'WHOST)
-                           (OR SUBDIR "")))
+(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
+                                     (
SETQ SUBDIR PROJECT)
+                                     (
SETQ PROJECT GIT-DEFAULT-PROJECT))
+   (CL:WHEN [
AND SUBDIR (
NOT (
MEMB (
CHCON1 SUBDIR))
+                             (
CHARCODE (
> /]
+       (
SETQ SUBDIR (
CONCAT SUBDIR "/")))
+   (
SLASHIT (
/CNDIR (
CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
+                           (
OR SUBDIR "")))
           T))
 (DEFINEQ
 
@@ -616,12 +617,12 @@
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "File correspondents")

+(* ;; "File correspondents")
 
 (DEFINEQ
 
@@ -864,12 +865,12 @@
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "Git commands")

+(* ;; "Git commands")
 
 (DEFINEQ
 
@@ -1073,7 +1074,7 @@
 
 
 
-(* ;; "Differences")

+(* ;; "Differences")
 
 (DEFINEQ
 
@@ -1261,12 +1262,12 @@
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "Branches")

+(* ;; "Branches")
 
 (DEFINEQ
 
@@ -1574,7 +1575,7 @@
 
 
 
-(* ;; "My branches")

+(* ;; "My branches")
 
 (DEFINEQ
 
@@ -1641,12 +1642,12 @@
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "Worktrees")

+(* ;; "Worktrees")
 
 (DEFINEQ
 
@@ -1717,12 +1718,12 @@
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "Comparisons")

+(* ;; "Comparisons")
 
 (DEFINEQ
 
@@ -1934,98 +1935,100 @@
                     else
 '(0 differences))
            else
 '(0 differences])
 
-(GIT-WORKING-COMPARE-DIRECTORIES

+(GIT-WORKING-COMPARE-DIRECTORIES
   [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
 
-    (* ;; "Edited 12-Jun-2024 22:52 by mth")

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

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

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

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

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

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

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

+    (* ;; "Edited 17-May-2022 17:39 by rmk")
+
+    (* ;; "Edited 10-May-2022 10:41 by rmk")
 
     (* ;; 
-
  "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")

+  "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
 
-    (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-    (CL:WHEN UPDATE (GIT-REMOTE-UPDATE
 NIL PROJECT))         (* ; "Doesn't matter if we are looking only at local files in the current branch.  We aren't fetching or checking out.")

-    (CL:UNLESS (AND (fetch
 GITHOST of
 PROJECT)
-                    (fetch
 WHOST of
 PROJECT))
-        (ERROR (fetch
 PROJECTNAME of
 PROJECT)
+    (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
+    (CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT))         (* ; "Doesn't matter if we are looking only at local files in the current branch.  We aren't fetching or checking out.")
+    (CL:UNLESS (
AND (fetch GITHOST of PROJECT)
+                    (fetch WHOST of PROJECT))
+        (
ERROR (fetch PROJECTNAME of PROJECT)
                " does not have both git and working directories"))
-    (CL:WHEN (AND (LISTP SUBDIRS)
-                  (NULL (CDR SUBDIRS)))
-        (SETQ SUBDIRS (CAR SUBDIRS)))
+    (CL:WHEN (
AND (
LISTP SUBDIRS)
+                  (
NULL (
CDR SUBDIRS)))
+        (
SETQ SUBDIRS (
CAR SUBDIRS)))
     (CL:UNLESS SUBDIRS
-        (SETQ SUBDIRS (OR (fetch
 DEFAULTSUBDIRS of
 PROJECT)
+        (
SETQ SUBDIRS (
OR (fetch DEFAULTSUBDIRS of PROJECT)
                           'ALL)))
-    (SETQ SUBDIRS (L-CASE SUBDIRS))
-    (LET ((SUBDIRSTRING (if
 (EQ SUBDIRS 'all)
-                            then
 (SETQ SUBDIRS (ALLSUBDIRS
 PROJECT))
+    (
SETQ SUBDIRS (
L-CASE SUBDIRS))
+    (
LET ((SUBDIRSTRING (if (
EQ SUBDIRS 'all)
+                            then (
SETQ SUBDIRS (ALLSUBDIRS PROJECT))
                                  "ALL subdirectories"
-                          else
 SUBDIRS)))
-         (for
 SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
+                          else SUBDIRS)))
+         (for SUBDIR TITLE CDVAL (WPROJ _ (
CONCAT "Working " (
L-CASE (fetch PROJECTNAME of PROJECT)
                                                                     T)))
               (NENTRIES _ 0)
-              (BRANCH2 _ (GIT-WHICH-BRANCH
 PROJECT T))
-            first
 (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
-                  (BKSYSBUF " ") inside
 SUBDIRS
-            collect
 (TERPRI T)
-                  (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR
 SUBDIR T PROJECT)
-                                     (GITSUBDIR
 SUBDIR T PROJECT)
-                                     (OR SELECT '(> < ~= -* *-))
-                                     NIL
-                                     (for
 E DPOS in
 (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS)
-                                        collect
 (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
+              (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
+            first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
+                  (
BKSYSBUF " ") inside SUBDIRS
+            collect (
TERPRI T)
+                  (
SETQ CDVAL (
COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
+                                     (GITSUBDIR SUBDIR T PROJECT)
+                                     (
OR SELECT '(
> < ~= -* *-))
+                                     '(*.* *>*.* .* *>.*)
+                                     (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
+                                        collect (
SETQ DPOS (
STRPOS SUBDIR (
FILENAMEFIELD E
                                                                                  'DIRECTORY)
                                                                   1 NIL T T FILEDIRCASEARRAY))
                                               (CL:IF DPOS
-                                                  (SUBSTRING E (ADD1 DPOS))
+                                                  (
SUBSTRING E (
ADD1 DPOS))
                                                   E))
                                      NIL NIL NIL FIXDIRECTORYDATES))
-                  [for
 CDE in
 (fetch
 CDENTRIES of
 CDVAL)
-                     do
 (CL:WHEN (fetch
 INFO1 of
 CDE)
-                            (change
 (fetch
 (CDINFO FULLNAME) of
 (fetch
 INFO1 of
 CDE))
-                                   (UNSLASHIT DATUM T)))
-                        (CL:WHEN (fetch
 INFO2 of
 CDE)
-                            (change
 (fetch
 (CDINFO FULLNAME) of
 (fetch
 INFO2 of
 CDE))
-                                   (SLASHIT DATUM T)))]
+                  [for CDE in (fetch CDENTRIES of CDVAL)
+                     do (CL:WHEN (fetch INFO1 of CDE)
+                            (change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE))
+                                   (
UNSLASHIT DATUM T)))
+                        (CL:WHEN (fetch INFO2 of CDE)
+                            (change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE))
+                                   (
SLASHIT DATUM T)))]
                   CDVAL
-            finally
 
+            finally 
 
-                  (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")

+                  (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")
 
-                  (CL:WHEN (AND (CDR $$VAL)
+                  (CL:WHEN (
AND (
CDR $$VAL)
                                 GIT-MERGE-COMPARES)
-                      (SETQ $$VAL (CDMERGE $$VAL))
-                      [SETQ SUBDIRS (CONCATLIST (for
 SUBDIR in
 SUBDIRS collect
 (CONCAT SUBDIR "  "])
-                  [for
 CDVAL TITLE in
 $$VAL as
 SUBDIR inside
 SUBDIRS
-                     do
 (SETQ TITLE (CONCAT WPROJ "  vs.   " BRANCH2 "      " SUBDIR "         "
-                                           (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVAL))
+                      (
SETQ $$VAL (
CDMERGE $$VAL))
+                      [
SETQ SUBDIRS (
CONCATLIST (for SUBDIR in SUBDIRS collect (
CONCAT SUBDIR "  "])
+                  [for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS
+                     do (
SETQ TITLE (
CONCAT WPROJ "  vs.   " BRANCH2 "      " SUBDIR "         "
+                                           (
LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
                                            " files"))
-                        [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
+                        [
CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
                                `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN 
                                        GIT-CD-LABELFN PROJECT ,PROJECT)
                                GIT-CDBROWSER-SEPARATE-DIRECTIONS
                                `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
-                                       ,@(CL:UNLESS (GIT-MAINBRANCH?
 BRANCH2 PROJECT T)
+                                       ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
                                              '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
-                        (CONS (CONCAT SUBDIR "/")
-                              (for
 CDENTRY in
 (fetch
 CDENTRIES of
 CDVAL)
-                                 collect
 (fetch
 MATCHNAME of
 CDENTRY)))
-                        (add
 NENTRIES (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVAL]
-                  (SETQ LAST-WMEDLEY-CDVALUES $$VAL)
-                  (TERPRI T)
-                  (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
+                        (
CONS (
CONCAT SUBDIR "/")
+                              (for CDENTRY in (fetch CDENTRIES of CDVAL)
+                                 collect (fetch MATCHNAME of CDENTRY)))
+                        (add NENTRIES (
LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL]
+                  (
SETQ LAST-WMEDLEY-CDVALUES $$VAL)
+                  (
TERPRI T)
+                  (
RETURN (
LIST NENTRIES (CL:IF (
EQ NENTRIES 1)
                                              'difference
                                              'differences)])
 
@@ -2270,16 +2273,16 @@
            RB NIL PROJECT])
 )
 
-(RPAQ? FROMGITN
 0)
+(RPAQ? FROMGITN 0)
 
 
 
-(* ;; "")

+(* ;; "")
 
 
 
 
-(* ;; "Utilities")

+(* ;; "Utilities")
 
 (DEFINEQ
 
@@ -2427,35 +2430,35 @@
     STRING])
 )
 
-(PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
+(PUTPROPS GITFNS FILETYPE :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4202 20781 (GIT-CLONEP 4212 . 5540) (GIT-INIT 5542 . 6172) (GIT-MAKE-PROJECT 6174 . 
-13839) (GIT-GET-PROJECT 13841 . 15766) (GIT-PUT-PROJECT-FIELD 15768 . 17409) (GIT-PROJECT-PATH 17411
- . 18455) (FIND-ANCESTOR-DIRECTORY 18457 . 18806) (GIT-FIND-CLONE 18808 . 19889) (GIT-MAINBRANCH 19891
- . 20286) (GIT-MAINBRANCH? 20288 . 20779)) (26244 31173 (PRC-COMMAND 26254 . 31171)) (31229 34017 (
-ALLSUBDIRS 31239 . 32525) (MEDLEYSUBDIRS 32527 . 33220) (GITSUBDIRS 33222 . 34015)) (34018 38808 (
-TOGIT 34028 . 35434) (FROMGIT 35436 . 36417) (GIT-DELETE-FILE 36419 . 37265) (MYMEDLEY-DELETE-FILES 
-37267 . 38806)) (38809 41812 (MYMEDLEYSUBDIR 38819 . 39275) (GITSUBDIR 39277 . 39720) (STRIPDIR 39722
- . 40093) (STRIPHOST 40095 . 40335) (STRIPNAME 40337 . 41090) (STRIPWHERE 41092 . 41810)) (41813 43715
- (GFILE4MFILE 41823 . 42186) (MFILE4GFILE 42188 . 42757) (GIT-REPO-FILENAME 42759 . 43713)) (43764 
-54019 (GIT-COMMIT 43774 . 44600) (GIT-PUSH 44602 . 45362) (GIT-PULL 45364 . 46116) (GIT-APPROVAL 46118
- . 46467) (GIT-GET-FILE 46469 . 48384) (GIT-FILE-EXISTS? 48386 . 48660) (GIT-REMOTE-UPDATE 48662 . 
-49497) (GIT-REMOTE-ADD 49499 . 49806) (GIT-FILE-DATE 49808 . 50855) (GIT-FILE-HISTORY 50857 . 52791) (
-GIT-PRINT-FILE-HISTORY 52793 . 53843) (GIT-FETCH 53845 . 54017)) (54049 65169 (GIT-BRANCH-DIFF 54059
- . 60806) (GIT-COMMIT-DIFFS 60808 . 61481) (GIT-BRANCH-RELATIONS 61483 . 65167)) (65214 84600 (
-GIT-BRANCH-NUM 65224 . 65797) (GIT-CHECKOUT 65799 . 67085) (GIT-WHICH-BRANCH 67087 . 67494) (
-GIT-MAKE-BRANCH 67496 . 70075) (GIT-BRANCHES 70077 . 72672) (GIT-BRANCH-EXISTS? 72674 . 73545) (
-GIT-PICK-BRANCH 73547 . 74037) (GIT-BRANCH-MENU 74039 . 74920) (GIT-BRANCH-WHENSELECTEDFN 74922 . 
-77461) (GIT-PULL-REQUESTS 77463 . 80981) (GIT-SHORT-BRANCH-NAME 80983 . 81274) (GIT-LONG-NAME 81276 . 
-81593) (GIT-PRC-BRANCHES 81595 . 84598)) (84630 88078 (GIT-MY-CURRENT-BRANCH 84640 . 85010) (
-GIT-MY-BRANCHP 85012 . 85630) (GIT-MY-NEXT-BRANCH 85632 . 86126) (GIT-MY-BRANCHES 86128 . 88076)) (
-88124 92199 (GIT-ADD-WORKTREE 88134 . 89741) (GIT-REMOVE-WORKTREE 89743 . 90673) (GIT-LIST-WORKTREES 
-90675 . 91479) (WORKTREEDIR 91481 . 92197)) (92247 125381 (GIT-GET-DIFFERENT-FILES 92257 . 98681) (
-GIT-BRANCHES-COMPARE-DIRECTORIES 98683 . 105914) (GIT-WORKING-COMPARE-DIRECTORIES 105916 . 111364) (
-GIT-COMPARE-WORKTREE 111366 . 115344) (GITCDOBJBUTTONFN 115346 . 119836) (GIT-CD-LABELFN 119838 . 
-120920) (GIT-CD-MENUFN 120922 . 123362) (GIT-WORKING-COMPARE-FILES 123364 . 123984) (
-GIT-BRANCHES-COMPARE-FILES 123986 . 125150) (GIT-PR-COMPARE 125152 . 125379)) (125451 133774 (CDGITDIR
- 125461 . 126148) (GIT-COMMAND 126150 . 127708) (GITORIGIN 127710 . 128407) (GIT-INITIALS 128409 . 
-128713) (GIT-COMMAND-TO-FILE 128715 . 132200) (GIT-RESULT-TO-LINES 132202 . 133107) (STRIPLOCAL 133109
- . 133772)))))
+  (FILEMAP (NIL (4225 20804 (GIT-CLONEP 4235 . 5563) (GIT-INIT 5565 . 6195) (GIT-MAKE-PROJECT 6197 . 
+13862) (GIT-GET-PROJECT 13864 . 15789) (GIT-PUT-PROJECT-FIELD 15791 . 17432) (GIT-PROJECT-PATH 17434
+ . 18478) (FIND-ANCESTOR-DIRECTORY 18480 . 18829) (GIT-FIND-CLONE 18831 . 19912) (GIT-MAINBRANCH 19914
+ . 20309) (GIT-MAINBRANCH? 20311 . 20802)) (26471 31400 (PRC-COMMAND 26481 . 31398)) (31448 34236 (
+ALLSUBDIRS 31458 . 32744) (MEDLEYSUBDIRS 32746 . 33439) (GITSUBDIRS 33441 . 34234)) (34237 39027 (
+TOGIT 34247 . 35653) (FROMGIT 35655 . 36636) (GIT-DELETE-FILE 36638 . 37484) (MYMEDLEY-DELETE-FILES 
+37486 . 39025)) (39028 42031 (MYMEDLEYSUBDIR 39038 . 39494) (GITSUBDIR 39496 . 39939) (STRIPDIR 39941
+ . 40312) (STRIPHOST 40314 . 40554) (STRIPNAME 40556 . 41309) (STRIPWHERE 41311 . 42029)) (42032 43934
+ (GFILE4MFILE 42042 . 42405) (MFILE4GFILE 42407 . 42976) (GIT-REPO-FILENAME 42978 . 43932)) (43975 
+54230 (GIT-COMMIT 43985 . 44811) (GIT-PUSH 44813 . 45573) (GIT-PULL 45575 . 46327) (GIT-APPROVAL 46329
+ . 46678) (GIT-GET-FILE 46680 . 48595) (GIT-FILE-EXISTS? 48597 . 48871) (GIT-REMOTE-UPDATE 48873 . 
+49708) (GIT-REMOTE-ADD 49710 . 50017) (GIT-FILE-DATE 50019 . 51066) (GIT-FILE-HISTORY 51068 . 53002) (
+GIT-PRINT-FILE-HISTORY 53004 . 54054) (GIT-FETCH 54056 . 54228)) (54256 65376 (GIT-BRANCH-DIFF 54266
+ . 61013) (GIT-COMMIT-DIFFS 61015 . 61688) (GIT-BRANCH-RELATIONS 61690 . 65374)) (65413 84799 (
+GIT-BRANCH-NUM 65423 . 65996) (GIT-CHECKOUT 65998 . 67284) (GIT-WHICH-BRANCH 67286 . 67693) (
+GIT-MAKE-BRANCH 67695 . 70274) (GIT-BRANCHES 70276 . 72871) (GIT-BRANCH-EXISTS? 72873 . 73744) (
+GIT-PICK-BRANCH 73746 . 74236) (GIT-BRANCH-MENU 74238 . 75119) (GIT-BRANCH-WHENSELECTEDFN 75121 . 
+77660) (GIT-PULL-REQUESTS 77662 . 81180) (GIT-SHORT-BRANCH-NAME 81182 . 81473) (GIT-LONG-NAME 81475 . 
+81792) (GIT-PRC-BRANCHES 81794 . 84797)) (84825 88273 (GIT-MY-CURRENT-BRANCH 84835 . 85205) (
+GIT-MY-BRANCHP 85207 . 85825) (GIT-MY-NEXT-BRANCH 85827 . 86321) (GIT-MY-BRANCHES 86323 . 88271)) (
+88311 92386 (GIT-ADD-WORKTREE 88321 . 89928) (GIT-REMOVE-WORKTREE 89930 . 90860) (GIT-LIST-WORKTREES 
+90862 . 91666) (WORKTREEDIR 91668 . 92384)) (92426 125819 (GIT-GET-DIFFERENT-FILES 92436 . 98860) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 98862 . 106093) (GIT-WORKING-COMPARE-DIRECTORIES 106095 . 111802) (
+GIT-COMPARE-WORKTREE 111804 . 115782) (GITCDOBJBUTTONFN 115784 . 120274) (GIT-CD-LABELFN 120276 . 
+121358) (GIT-CD-MENUFN 121360 . 123800) (GIT-WORKING-COMPARE-FILES 123802 . 124422) (
+GIT-BRANCHES-COMPARE-FILES 124424 . 125588) (GIT-PR-COMPARE 125590 . 125817)) (125881 134204 (CDGITDIR
+ 125891 . 126578) (GIT-COMMAND 126580 . 128138) (GITORIGIN 128140 . 128837) (GIT-INITIALS 128839 . 
+129143) (GIT-COMMAND-TO-FILE 129145 . 132630) (GIT-RESULT-TO-LINES 132632 . 133537) (STRIPLOCAL 133539
+ . 134202)))))
 STOP

lispusers/JSON

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36
 9198   
+
(FILECREATED " 7-May-2025 13:57:04" {WMEDLEY}<lispusers>JSON.;38
 9891   
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS JSON-GET)
 
-      :PREVIOUS-DATE "13-May-2024 19:23:02" {WMEDLEY}<lispusers>JSON.;33)
+      :PREVIOUS-DATE "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36)
 
 
 (PRETTYCOMPRINT JSONCOMS)
@@ -177,14 +177,24 @@
          NIL])
 
 (JSON-GET

-  [LAMBDA (OBJECT ATTRIBUTES)
                                (* ; "Edited 13-May-2024 22:35 by rmk")


+  [LAMBDA (OBJECT ATTRIBUTES)
                                (* ; "Edited  7-May-2025 13:56 by rmk")


+                                                             (* ; "Edited 13-May-2024 22:35 by rmk")


                                                              (* ; "Edited 30-Apr-2024 14:26 by rmk")

 
     (* ;; "Returns the value at the end of a chain of ATTRIBUTES in OBJECT")

 
-    (for
 A (OBJ _ OBJECT) inside
 ATTRIBUTES do
 (if
 (EQ 'OBJECT (CAR (LISTP OBJ)))
-                                                   then
 [SETQ OBJ (CADR (ASSOC A (CDR OBJ]
-                                                 else
 (RETURN NIL)) finally
 (RETURN OBJ])
+    (for
 A (OBJ _ OBJECT) inside
 ATTRIBUTES do
 (SELECTQ (CAR (LISTP OBJ))
+                                                   (OBJECT [SETQ OBJ (CADR (ASSOC A (CDR OBJ])
+                                                   (ARRAY (CL:UNLESS (AND (FIXP A)
+                                                                          (IGEQ A 0))
+                                                                 (ERROR A 
+                                                                        " cannot index a JSON array")
+                                                                 )
+
+                                                          (* ;; "ADD1 because zero-origin")

+
+                                                          [SETQ OBJ (CAR (NTH OBJ (ADD1 A])
+                                                   (RETURN NIL)) finally
 (RETURN OBJ])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -201,7 +211,7 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (559 8839 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
+  (FILEMAP (NIL (559 9532 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
 JSON-STRING 1564 . 2362) (JSON-ARRAY 2364 . 3502) (JSON-OBJECT 3504 . 4961) (JSON-AVPAIR 4963 . 5405) 
-(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 8837)))))
+(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 9530)))))
 STOP

lispusers/TALK

@@ -1,616 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "22-Jul-88 15:43:07" |{MCS:MCS:STANFORD}<LANE>TALK.;10|
 38505  
-
-      previous date%: "16-Jun-88 09:25:17" |{MCS:MCS:STANFORD}<LANE>TALK.;9|)
-
-
-(* "
-Copyright (c) 1987, 1988 by Stanford University.  All rights reserved.
-")
-
-(PRETTYCOMPRINT TALKCOMS)
-
-(RPAQQ TALKCOMS
 ((* TALK client/server code)
-                     (LOCALVARS . T)
-                     (FNS TALK)
-                     (FNS TALK.RECONNECT TALK.PROCESS TALK.DISPLAY TALK.LISTEN TALK.CLOSEFN 
-                          TALK.ANSWER TALK.ANSWER.WINDOW TALK.ANSWER.USERNAME TALK.GET.NAME 
-                          TALK.ADD.NAME TALK.FLASH.CARET TALK.WHENSELECTEDFN TALK.RINGBELLS 
-                          TALK.START.SERVER)
-                     (FNS TALK.ICON.BUTTONEVENTFN TALK.ICON.CLOSEFN)
-                     (* TALK data)
-                     (DECLARE%: DONTCOPY (RECORDS TALK.SERVICETYPE TALK.PROTOCOLTYPE))
-                     (VARS TALK.MENU.ITEMS TALK.USER.MESSAGES)
-                     (INITVARS TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES 
-                            TALK.ICON.WINDOWS (TALK.ANSWER.WAIT 15)
-                            (TALK.READTABLE (COPYREADTABLE 'ORIG))
-                            (TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500))
-                            (TALK.CLOSED.STRING " -- Connection Closed")
-                            (TALK.ICON.FONT LITTLEFONT))
-                     (GLOBALVARS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES 
-                            TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES TALK.ICON.WINDOWS 
-                            TALK.ANSWER.WAIT TALK.READTABLE TALK.DEFAULT.REGION TALK.CLOSED.STRING 
-                            TALK.ICON.FONT)
-                     (ALISTS (BackgroundMenuCommands Talk))
-                     (VARS (BackgroundMenu))
-                     (APPENDVARS (BACKGROUNDFNS TALK.START.SERVER)
-                            (AFTERMAKESYSFORMS (TALK.START.SERVER NIL T)))
-                     (BITMAPS TALK.ICON.BITMAP)
-                     (GLOBALVARS TALK.ICON.BITMAP)
-                     (P (SETSYNTAX (CHARCODE SPACE)
-                               (CHARCODE A)
-                               TALK.READTABLE))))
-
-
-
-(* TALK client/server code)

-
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(LOCALVARS . T)
-)
-(DEFINEQ
-
-(TALK

-  [LAMBDA (USER.OR.HOSTNAME SERVICE PROTOCOL)
            (* ; "Edited  9-Jun-88 12:32 by cdl")

-                                                             (* DECLARATIONS%: (RECORD RESULT
-
                                                           (SERVICETYPE INPUTSTREAM
-
                                                                                    . OUTPUTSTREAM)))

-    (PROG (USER PROTOCOLTYPE PROTOCOLTYPES SERVICETYPE SERVICETYPES RESULT ADDRESSABLE?)
-          (if
 (NULL USER.OR.HOSTNAME)
-              then
 (if
 (SETQ USER.OR.HOSTNAME (TALK.GET.NAME
))
-                           then
 (if
 (LISTP USER.OR.HOSTNAME)
-                                        then
 (RETURN (TALK.RECONNECT
 USER.OR.HOSTNAME)))
-                         else
 (RETURN)))
-          (if
 SERVICE
-              then
 (if
 [SETQ SERVICETYPE (for
 SERVICETYPE in
 TALK.SERVICETYPES
-                                                    thereis
 (with
 TALK.SERVICETYPE 
-                                                                       SERVICETYPE (STRING-EQUAL
-                                                                                    SERVICE 
-                                                                                    TALK.SERVICENAME]
-                           then
 (SETQ SERVICETYPES (LIST SERVICETYPE))
-                         else
 (RETURN (LIST "Unknown service type!" SERVICE)))
-            else
 (if
 (NULL (SETQ SERVICETYPES TALK.SERVICETYPES))
-                         then
 (RETURN "No services available!")))
-          (if
 PROTOCOL
-              then
 (if
 (SETQ PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES))
-                           then
 (SETQ PROTOCOLTYPES (LIST PROTOCOLTYPE))
-                         else
 (RETURN (LIST "Unknown protocol!" PROTOCOL)))
-            else
 (if
 (NULL (SETQ PROTOCOLTYPES TALK.PROTOCOLTYPES))
-                         then
 (RETURN "No protocols available!")))
-          (if
 [SETQ PROTOCOLTYPE (bind
 ADDRESS for
 PROTOCOLTYPE in
 PROTOCOLTYPES
-                                        when
 (with
 TALK.PROTOCOLTYPE PROTOCOLTYPE
-                                                        (SETQ ADDRESS (APPLY* TALK.HOSTNAMEFN 
-                                                                             USER.OR.HOSTNAME)))
-                                        thereis
 (PROGN (TALK.ADD.NAME
 USER.OR.HOSTNAME 
-                                                                  ADDRESS (with
 TALK.PROTOCOLTYPE
-                                                                                 PROTOCOLTYPE 
-                                                                                 TALK.PROTOCOLNAME))
-                                                           (SETQ ADDRESSABLE? T)
-                                                           (SELECTQ (SETQ RESULT
-                                                                     (with
 TALK.PROTOCOLTYPE 
-                                                                            PROTOCOLTYPE
-                                                                            (APPLY* TALK.CONNECTFN 
-                                                                                   ADDRESS 
-                                                                                   SERVICETYPES)))
-                                                               (ANSWER (RETURN))
-                                                               (LISTP RESULT]
-              then
 (with
 RESULT RESULT (RETURN (TALK.PROCESS
 INPUTSTREAM OUTPUTSTREAM 
-                                                              SERVICETYPE PROTOCOLTYPE 'CLIENT 
-                                                              USER.OR.HOSTNAME T)))
-            else
 (RETURN (if
 ADDRESSABLE?
-                                 then
 (SELECTQ RESULT
-                                              (ANSWER "No answer from TALK service!")
-                                              (LIST "Can't connect to host!" USER.OR.HOSTNAME))
-                               else
 (LIST "Host not found!" USER.OR.HOSTNAME])
-)
-(DEFINEQ
-
-(TALK.RECONNECT

-  [LAMBDA (DESTINATION)
                                  (* ; "Edited 10-Jun-88 14:59 by cdl")

-                                                             (* DECLARATIONS%: (RECORD RESULT
-
                                                           (SERVICETYPE INPUTSTREAM
-
                                                                                    . OUTPUTSTREAM))
-
                                                           (RECORD DESTINATION
-
                                                           (NAME . ENTRIES)) (RECORD ENTRY
-
                                                           (PROTOCOL . ADDRESS)))

-    (DECLARE
 (SPECVARS DESTINATION))
-    (if
 TALK.SERVICETYPES
-        then

-        [LET (PROTOCOLTYPE RESULT ENTRY ADDRESS)             (* try all the protocols but prefer 
-
                                                           those that have already succeeded)

-             (if
 [SETQ PROTOCOLTYPE
-                      (for
 PROTOCOLTYPE in
 [SORT (APPEND TALK.PROTOCOLTYPES)
-                                                         (FUNCTION (LAMBDA (PROTOCOLTYPE)
-                                                             (* DECLARATIONS%: (RECORD 
-
                                                           DESTINATION (NAME . ENTRIES)))

-                                                                     (with
 TALK.PROTOCOLTYPE 
-                                                                            PROTOCOLTYPE
-                                                                            (with
 DESTINATION 
-                                                                                   DESTINATION
-                                                                                   (ASSOC 
-                                                                                    TALK.PROTOCOLNAME
-                                                                                          ENTRIES]
-                         when
 [with
 TALK.PROTOCOLTYPE PROTOCOLTYPE
-                                         (AND [SETQ ADDRESS (with
 DESTINATION DESTINATION
-                                                                   (if
 (SETQ ENTRY
-                                                                            (ASSOC TALK.PROTOCOLNAME
-                                                                                   ENTRIES))
-                                                                       then
 (with
 ENTRY ENTRY
-                                                                                       ADDRESS)
-                                                                     else
 (APPLY* TALK.HOSTNAMEFN
-                                                                                     NAME]
-                                              (SETQ RESULT (APPLY* TALK.CONNECTFN ADDRESS 
-                                                                  TALK.SERVICETYPES]
-                         thereis
 (SELECTQ RESULT
-                                         (ANSWER (RETURN))
-                                         (LISTP RESULT]
-                 then
 (with
 RESULT RESULT (TALK.PROCESS
 INPUTSTREAM OUTPUTSTREAM 
-                                                         SERVICETYPE PROTOCOLTYPE 'CLIENT
-                                                         (with
 DESTINATION DESTINATION NAME)
-                                                         T))
-               else
 (SELECTQ RESULT
-                            (ANSWER "No answer from TALK service!")
-                            (LIST "Can't connect to host!" (with
 DESTINATION DESTINATION NAME]
-      else
 "No services available!"])
-
-(TALK.PROCESS

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER SPAWN?)

-                                                             (* ; "Edited  9-Jun-88 12:35 by cdl")

-    (if
 (LITATOM SERVICETYPE)
-        then
 (SETQ SERVICETYPE (ASSOC SERVICETYPE TALK.SERVICETYPES)))
-    (if
 (LITATOM PROTOCOLTYPE)
-        then
 (SETQ PROTOCOLTYPE (ASSOC PROTOCOLTYPE TALK.PROTOCOLTYPES)))
-    (LET ((DISPLAYSTREAM (TALK.DISPLAY
 INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE 
-                                USER)))
-         (if
 SPAWN?
-             then
 [ADD.PROCESS `(TALK.LISTEN
 ,INPUTSTREAM ,OUTPUTSTREAM ,(KWOTE SERVICETYPE)
-                                           ,(KWOTE PROTOCOLTYPE)
-                                           ,DISPLAYSTREAM]
-           else
 (TALK.LISTEN
 INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE DISPLAYSTREAM])
-
-(TALK.DISPLAY

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER)

-                                                             (* ; "Edited  9-Jun-88 14:46 by cdl")

-                                                             (* DECLARATIONS%: (ASSOCRECORD 
-
                                                           MESSAGES (GREETING)))

-    (LET (MAINWINDOW WINDOW REGION GREETING)
-         (DECLARE
 (SPECVARS GREETING))
-         (SETQ USER (with
 TALK.PROTOCOLTYPE PROTOCOLTYPE (APPLY* TALK.USERNAMEFN INPUTSTREAM 
-                                                                    OUTPUTSTREAM SERVICETYPE MODE 
-                                                                    USER)))
-         (with
 REGION (SETQ REGION (if
 (REGIONP TALK.DEFAULT.REGION)
-                                           then
 (with
 REGION TALK.DEFAULT.REGION
-                                                           (GETBOXREGION WIDTH HEIGHT))
-                                         else
 (GETREGION)))
-                (SETQ HEIGHT (QUOTIENT HEIGHT 2)))
-         (SETQ MAINWINDOW (CREATEW (with
 REGION REGION (create
 REGION
-                                                                  BOTTOM _ (PLUS BOTTOM HEIGHT)
-                                                              using
 REGION))
-                                 (PACK* "TALK (" (with
 TALK.SERVICETYPE SERVICETYPE 
-                                                        TALK.SERVICENAME)
-                                        ")")))
-         (SETQ WINDOW (CREATEW REGION (CONCAT "(" (with
 TALK.PROTOCOLTYPE PROTOCOLTYPE 
-                                                         TALK.PROTOCOLNAME)
-                                             ") Talk from " USER)))
-         (WINDOWPROP MAINWINDOW 'STREAMS (CONS INPUTSTREAM OUTPUTSTREAM))
-         (WINDOWADDPROP MAINWINDOW 'CLOSEFN (FUNCTION TALK.CLOSEFN))
-         (ATTACHWINDOW WINDOW MAINWINDOW 'BOTTOM)
-         (ATTACHMENU (create
 MENU
-                            ITEMS _ TALK.MENU.ITEMS
-                            CENTERFLG _ T
-                            MENUBORDERSIZE _ 1
-                            WHENSELECTEDFN _ (FUNCTION TALK.WHENSELECTEDFN))
-                WINDOW
-                'BOTTOM)
-         (with
 TALK.SERVICETYPE SERVICETYPE (APPLY* TALK.DISPLAYFN MAINWINDOW WINDOW INPUTSTREAM
-                                                       OUTPUTSTREAM PROTOCOLTYPE USER))
-         (if
 (AND (SETQ GREETING (CAR (with
 MESSAGES TALK.USER.MESSAGES GREETING)))
-                      (SETQ GREETING (ERRORSET GREETING)))
-             then
 (BKSYSBUF (CAR GREETING)))
-         WINDOW])
-
-(TALK.LISTEN

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE WINDOW)

-                                                             (* ; "Edited  7-Jun-88 08:42 by cdl")

-    (PROG (ICON? (MAINWINDOW (MAINWINDOW WINDOW)))
-          (with
 TALK.SERVICETYPE SERVICETYPE (APPLY* TALK.LISTENFN MAINWINDOW WINDOW INPUTSTREAM
-                                                        OUTPUTSTREAM PROTOCOLTYPE))
-          (TTY.PROCESS T)
-          (CLOSEF? INPUTSTREAM)
-          (if
 [OR (OPENWP WINDOW)
-                      (for
 PROP in
 '(ICON ICONWINDOW) thereis
 (SETQ ICON?
-                                                                           (OPENWP (WINDOWPROP 
-                                                                                          MAINWINDOW
-                                                                                          PROP]
-              then
 (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
-                                                        TALK.CLOSED.STRING))
-                    (for
 WINDOW in
 (ATTACHEDWINDOWS WINDOW) when
 (WINDOWPROP WINDOW
-                                                                                    'MENU)
-                       do
 (if
 (DETACHWINDOW WINDOW)
-                                  then
 (CLOSEW WINDOW)))
-                    (if
 ICON?
-                        then
 (SHRINKW MAINWINDOW)
-                      else
 (FLASHWINDOW WINDOW])
-
-(TALK.CLOSEFN

-  [LAMBDA (WINDOW)
                                       (* ; "Edited  9-Jun-88 14:45 by cdl")

-                                                             (* DECLARATIONS%: (RECORD STREAMS
-
                                                           (INPUTSTREAM . OUTPUTSTREAM)))

-    (LET ((STREAMS (WINDOWPROP WINDOW 'STREAMS NIL)))
-         (if
 STREAMS
-             then
 (with
 STREAMS STREAMS (CLOSEF? INPUTSTREAM)
-                             (CLOSEF? OUTPUTSTREAM])
-
-(TALK.ANSWER

-  [LAMBDA (USER SERVICE PROTOCOL ADDRESS)
                (* ; "Edited  9-Jun-88 09:20 by cdl")

-    (LET [WINDOW REGION (EVENT (CREATE.EVENT))
-                (TIME (DATE '(DATEFORMAT NO.SECONDS]
-         (DECLARE
 (GLOBALVARS \IDLING))
-         (PROGN                                              (* Only really necessary if you're 
-
                                                           talking to yourself)

-                (SPAWN.MOUSE))
-         (WINDOWPROP (SETQ WINDOW (TALK.ANSWER.WINDOW
 USER))
-                'EVENT EVENT)
-         (BITBLT TALK.ICON.BITMAP NIL NIL WINDOW)
-         [SETQ REGION (with
 REGION (DSPCLIPPINGREGION NIL WINDOW)
-                             (CREATEREGION LEFT BOTTOM WIDTH (QUOTIENT HEIGHT 3]
-         (CENTERPRINTINREGION (CONCAT SERVICE "(" PROTOCOL ")")
-                (with
 REGION REGION (CREATEREGION LEFT BOTTOM WIDTH (DIFFERENCE HEIGHT 7)))
-                WINDOW)
-         (DSPFONT (PROG1 (DSPFONT TALK.ICON.FONT WINDOW)
-                      (CENTERPRINTINREGION (CONCAT (SUBSTRING TIME 1 6)
-                                                  (SUBSTRING TIME 10 -1))
-                             (with
 REGION REGION (add
 BOTTOM HEIGHT)
-                                    (CREATEREGION LEFT BOTTOM WIDTH (DIFFERENCE HEIGHT 7)))
-                             WINDOW))
-                WINDOW)
-         (if
 USER
-             then
 (TALK.ADD.NAME
 USER ADDRESS PROTOCOL)
-                   (with
 REGION REGION (add
 BOTTOM HEIGHT)
-                          (TALK.ANSWER.USERNAME
 USER (CREATEREGION LEFT BOTTOM WIDTH
-                                                                (DIFFERENCE HEIGHT 7))
-                                 WINDOW)))
-         (TALK.RINGBELLS
 WINDOW)
-         (if
 (AND [STRINGP (AWAIT.EVENT EVENT (TIMES TALK.ANSWER.WAIT 1000 (if
 \IDLING
-                                                                                   then
 
-                                                             (* Provide extra time to login)

-                                                                                         2
-                                                                                 else
 1]
-                      USER)
-             then
                                        (* We timed out, leave the icon up 
-
                                                           but change its functionality)

-                   (WINDOWPROP WINDOW 'TALK (LIST USER (CONS PROTOCOL ADDRESS)))
-                   (WINDOWPROP WINDOW 'EVENT NIL)
-                   (INVERTW WINDOW)
-           else
 (WINDOWPROP WINDOW 'EVENT NIL)
-                 (CLOSEW WINDOW))
-         (WINDOWPROP WINDOW 'RESULT])
-
-(TALK.ANSWER.WINDOW

-  [LAMBDA (USER)
                                         (* ; "Edited  9-Jun-88 10:27 by cdl")

-    (PROG (WINDOW REGION)
-          [if
 TALK.ICON.WINDOWS
-              then

-              [if
 [AND USER (SETQ WINDOW (for
 WINDOW in
 TALK.ICON.WINDOWS
-                                                thereis
 (EQUAL USER (CAR (WINDOWPROP WINDOW
-                                                                                    'TALK]
-                  then
 (RETURN WINDOW)
-                else
 (SETQ REGION
-                          (with
 REGION (WINDOWPROP (CAR TALK.ICON.WINDOWS)
-                                                  'REGION)
-                                 (if
 (LESSP (PLUS PRIGHT WIDTH)
-                                                SCREENWIDTH)
-                                     then
 (CREATEREGION PRIGHT BOTTOM WIDTH HEIGHT)
-                                   else
 (CREATEREGION (OR (fetch
 (REGION LEFT)
-                                                                 of
 (REGIONP TALK.DEFAULT.REGION)
-                                                                     )
-                                                              0)
-                                                   (if
 (LESSP (PLUS PTOP HEIGHT)
-                                                                  SCREENHEIGHT)
-                                                       then
 PTOP
-                                                     else
 (OR (fetch
 (REGION BOTTOM)
-                                                                     of
 (REGIONP 
-                                                                                  TALK.DEFAULT.REGION
-                                                                                   ))
-                                                                  0))
-                                                   WIDTH HEIGHT]
-            else
 (SETQ REGION (with
 BITMAP TALK.ICON.BITMAP
-                                         (if
 (REGIONP TALK.DEFAULT.REGION)
-                                             then
 (with
 REGION TALK.DEFAULT.REGION
-                                                             (CREATEREGION LEFT BOTTOM BITMAPWIDTH 
-                                                                    BITMAPHEIGHT))
-                                           else
 (CREATEREGION 0 0 BITMAPWIDTH BITMAPHEIGHT]
-          (push
 TALK.ICON.WINDOWS (SETQ WINDOW (CREATEW REGION NIL 0 T)))
-          (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION TALK.ICON.BUTTONEVENTFN))
-          (WINDOWPROP WINDOW 'CLOSEFN (FUNCTION TALK.ICON.CLOSEFN))
-          (RETURN WINDOW])
-
-(TALK.ANSWER.USERNAME

-  [LAMBDA (USER REGION WINDOW)
                           (* cdl "10-Jun-87 08:38")

-    (LET (PTR FONTHEIGHT (FONT (DSPFONT NIL WINDOW)))
-         (if
 (AND (GREATERP (NCHARS USER)
-                             (QUOTIENT (BITMAPWIDTH TALK.ICON.BITMAP)
-                                    (CHARWIDTH (CHARCODE A)
-                                           FONT)))
-                      (SETQ PTR (STRPOS (CONSTANT (CHARACTER (CHARCODE SPACE)))
-                                       USER)))
-             then
 (DSPFONT TALK.ICON.FONT WINDOW)
-                   (SETQ FONTHEIGHT (QUOTIENT (FONTPROP TALK.ICON.FONT 'HEIGHT)
-                                           2))
-                   (CENTERPRINTINREGION (SUBSTRING USER 1 (SUB1 PTR))
-                          (with
 REGION REGION (CREATEREGION LEFT (PLUS BOTTOM FONTHEIGHT)
-                                                         WIDTH HEIGHT))
-                          WINDOW)
-                   (CENTERPRINTINREGION (SUBSTRING USER (ADD1 PTR)
-                                               -1)
-                          (with
 REGION REGION (CREATEREGION LEFT (DIFFERENCE BOTTOM FONTHEIGHT)
-                                                         WIDTH HEIGHT))
-                          WINDOW)
-                   (DSPFONT FONT WINDOW)
-           else
 (CENTERPRINTINREGION USER REGION WINDOW])
-
-(TALK.GET.NAME

-  [LAMBDA NIL
                                            (* ; "Edited 16-Jun-88 09:24 by cdl")

-                                                             (* DECLARATIONS%: (RECORD ENTRY
-
                                                           (NAME . PAIRS)) (RECORD PAIR
-
                                                           (PROTOCOL . ADDRESS)))

-    (LET
-     [HOSTNAME HOSTNAMES MENU (ITEM '("" NIL ""]
-     (if

-      (SETQ HOSTNAMES
-       (for
 ENTRY in
 TALK.HOSTNAMES
-          collect

-          (if
 (LISTP ENTRY)
-              then

-              [with

-               ENTRY ENTRY
-               `(,NAME ,(KWOTE ENTRY)
-                       NIL
-                       (SUBITEMS ,@(for
 PAIR in
 PAIRS
-                                      collect
 (with
 PAIR PAIR
-                                                         `(,(CONCAT PROTOCOL " " ADDRESS)
-                                                           ,(KWOTE (LIST NAME PAIR]
-            else
 ENTRY)))
-         then
 (push
 HOSTNAMES ITEM))
-     [SETQ MENU (create
 MENU
-                       TITLE _ "TALK"
-                       ITEMS _ `(("Prompt for User/Host" 'PROMPT "Prompt for a new user or hostname."
-                                        )
-                                 (,(if
 TALK.GAG
-                                       then
 "Turn TALK On"
-                                     else
 "Turn TALK Off")
-                                  (PROGN (SETQ TALK.GAG (NOT TALK.GAG))
-                                         NIL)
-                                  "Toggle TALK connection accept/refuse switch.")
-                                 ,@HOSTNAMES]
-     [if
 HOSTNAMES
-         then
 (SHADEITEM ITEM MENU BLACKSHADE)           (* Kludge to make entire line of 
-
                                                           menu inverted, not just up to 
-
                                                           subitem arrows)

-               (with
 REGION (MENUITEMREGION ITEM MENU)
-                      (with
 MENU MENU (BLTSHADE BLACKSHADE (with
 WINDOW IMAGE SAVE)
-                                                 (PLUS LEFT MENUOUTLINESIZE)
-                                                 (PLUS BOTTOM MENUOUTLINESIZE)
-                                                 WIDTH HEIGHT]
-     (SELECTQ (SETQ HOSTNAME (MENU MENU))
-         (PROMPT (SETQ HOSTNAME (MKATOM (PROMPTFORWORD "User or host?" NIL NIL PROMPTWINDOW)))
-                 (TERPRI PROMPTWINDOW))
-         NIL)
-     HOSTNAME])
-
-(TALK.ADD.NAME

-  [LAMBDA (NAME ADDRESS PROTOCOL)
                        (* ; "Edited  9-Jun-88 12:39 by cdl")

-                                                             (* DECLARATIONS%: (RECORD ENTRY
-
                                                           (NAME . PAIRS)))

-    (LET (ENTRY)
-         (if
 (NOT (EQUAL NAME ADDRESS))
-             then
 (if
 (SETQ ENTRY (bind
 HOSTNAME (NCHARS _ (NCHARS NAME)) for
 ENTRY
-                                             in
 TALK.HOSTNAMES
-                                             eachtime
 (SETQ HOSTNAME
-                                                           (if
 (LISTP ENTRY)
-                                                               then
 (with
 ENTRY ENTRY NAME)
-                                                             else
 ENTRY))
-                                             thereis
 (STRING-EQUAL HOSTNAME NAME)))
-                          then
 (if
 (NLISTP ENTRY)
-                                       then
 (SETQ TALK.HOSTNAMES (DREMOVE ENTRY TALK.HOSTNAMES))
-                                             (push
 TALK.HOSTNAMES (LIST NAME (CONS PROTOCOL 
-                                                                                       ADDRESS)))
-                                     else
 (PUTASSOC PROTOCOL ADDRESS (with
 ENTRY ENTRY PAIRS)
-                                                     ))
-                        else
 (push
 TALK.HOSTNAMES (LIST NAME (CONS PROTOCOL ADDRESS])
-
-(TALK.FLASH.CARET

-  [LAMBDA (WINDOW POSITION FLG)
                          (* ; "Edited  2-Jun-88 15:17 by cdl")

-    (DECLARE
 (GLOBALVARS DEFAULTCARET))
-    (if
 (OPENWP WINDOW)
-        then
 (SELECTQ FLG
-                     (OFF [with
 POSITION POSITION
-                                 (if
 XCOORD
-                                     then
 (with
 CURSOR DEFAULTCARET
-                                                     (BITBLT CUIMAGE NIL NIL WINDOW XCOORD YCOORD NIL
-                                                            NIL NIL 'INVERT])
-                     (ON [with
 POSITION POSITION (with
 CURSOR DEFAULTCARET
-                                                            (BITBLT CUIMAGE NIL NIL WINDOW
-                                                                   (SETQ XCOORD
-                                                                    (DIFFERENCE (DSPXPOSITION NIL 
-                                                                                       WINDOW)
-                                                                           CUHOTSPOTX))
-                                                                   (SETQ YCOORD
-                                                                    (DIFFERENCE (DSPYPOSITION NIL 
-                                                                                       WINDOW)
-                                                                           CUHOTSPOTY))
-                                                                   NIL NIL NIL 'INVERT])
-                     NIL])
-
-(TALK.WHENSELECTEDFN

-  [LAMBDA (ITEM FROMMENU BUTTON)
                         (* ; "Edited  9-Jun-88 14:50 by cdl")

-                                                             (* DECLARATIONS%: (RECORD STREAMS
-
                                                           (INPUTSTREAM . OUTPUTSTREAM)))

-    (LET [MAINWINDOW TEXTSTREAM STREAMS (WINDOW (MAINWINDOW (WFROMMENU FROMMENU]
-         (DECLARE
 (SPECVARS WINDOW MAINWINDOW TEXTSTREAM STREAMS))
-         (SETQ TEXTSTREAM (WINDOWPROP (SETQ MAINWINDOW (MAINWINDOW WINDOW))
-                                 'TEXTSTREAM))
-         (if
 (AND (SETQ STREAMS (WINDOWPROP MAINWINDOW 'STREAMS))
-                      (OPENP (with
 STREAMS STREAMS OUTPUTSTREAM)))
-             then
 (ERRORSET (CADR ITEM])
-
-(TALK.RINGBELLS

-  [LAMBDA (WINDOW)
                                       (* cdl "16-Mar-87 08:01")

-    (DECLARE
 (GLOBALVARS RINGBELLS.L1 RINGBELLS.L2))
-    (PLAYTUNE RINGBELLS.L1)                                  (* Dorados and Dolphins can't do 
-
                                                           PLAYTUNE but let BEEPON/BEEPOFF 
-
                                                           handle that)

-    (FLASHWINDOW WINDOW)
-    (PLAYTUNE RINGBELLS.L2])
-
-(TALK.START.SERVER

-  [LAMBDA (PROTOCOL RESTART)
                             (* ; "Edited  8-Jun-88 15:06 by cdl")

-    (DECLARE
 (SPECVARS RESTART))
-    (if
 PROTOCOL
-        then
 (LET ((PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)))
-                      (DECLARE
 (SPECVARS PROTOCOLTYPE))
-                      (if
 PROTOCOLTYPE
-                          then
 [with
 TALK.PROTOCOLTYPE PROTOCOLTYPE
-                                          (if
 TALK.STARTSERVERFN
-                                              then
 (CAR (NLSETQ (APPLY* TALK.STARTSERVERFN 
-                                                                           RESTART]
-                        else
 (ERROR PROTOCOL "Unknown protocol!")))
-      else
 (for
 PROTOCOLTYPE declare%:
 (SPECVARS PROTOCOLTYPE) in
 TALK.PROTOCOLTYPES
-                  do
 (with
 TALK.PROTOCOLTYPE PROTOCOLTYPE
-                                (if
 TALK.STARTSERVERFN
-                                    then
 (NLSETQ (APPLY* TALK.STARTSERVERFN RESTART])
-)
-(DEFINEQ
-
-(TALK.ICON.BUTTONEVENTFN

-  [LAMBDA (WINDOW)
                                       (* ; "Edited  9-Jun-88 10:02 by cdl")

-                                                             (* DECLARATIONS%: (RECORD 
-
                                                           DESTINATION (NAME (PROTOCOL . ADDRESS))))

-    (RESETFORM (INVERTW WINDOW)
-           (until
 (MOUSESTATE UP) do
))
-    (ALLOW.BUTTON.EVENTS)
-    (if
 (WINDOWPROP WINDOW 'EVENT)
-        then
 (WINDOWPROP WINDOW 'RESULT T)
-              (NOTIFY.EVENT (WINDOWPROP WINDOW 'EVENT NIL)
-                     T)
-      else
 (LET ((DESTINATION (WINDOWPROP WINDOW 'TALK))
-                     RESULT)
-                    (if
 (MOUSECONFIRM (CONCAT "(Re)Connect to " (with
 DESTINATION DESTINATION
-                                                                           NAME)
-                                                 "?"))
-                        then
 (if
 (PROCESSP (SETQ RESULT (TALK.RECONNECT
 DESTINATION)))
-                                     then
 (CLOSEW WINDOW)
-                                   else
 (FLASHWINDOW WINDOW)
-                                         (PROMPTPRINT RESULT])
-
-(TALK.ICON.CLOSEFN

-  [LAMBDA (WINDOW)
                                       (* cdl "10-May-87 10:07")

-    (LET ((EVENT (WINDOWPROP WINDOW 'EVENT NIL)))
-         (if
 EVENT
-             then
 (NOTIFY.EVENT EVENT T)))
-    (SETQ TALK.ICON.WINDOWS (DREMOVE WINDOW TALK.ICON.WINDOWS])
-)
-
-
-
-(* TALK data)

-
-(DECLARE%: DONTCOPY 
-(DECLARE%: EVAL@COMPILE
-
-(RECORD TALK.SERVICETYPE
 (TALK.SERVICENAME TALK.DISPLAYFN TALK.LISTENFN))
-
-(RECORD TALK.PROTOCOLTYPE
 (TALK.PROTOCOLNAME TALK.HOSTNAMEFN TALK.USERNAMEFN TALK.CONNECTFN 
-                                     TALK.EVENTFN TALK.STARTSERVERFN TALK.CASEARRAY))
-)
-)
-
-(RPAQQ TALK.MENU.ITEMS
 ((Disconnect (TALK.CLOSEFN MAINWINDOW)
-                                   "Close TALK connection and keep window open.")
-                            (RingBells (PROGN (PRINTCCODE (CHARCODE ^G)
-                                                     (CDR STREAMS))
-                                              (FORCEOUTPUT (CDR STREAMS))
-                                              (FLASHWINDOW MAINWINDOW))
-                                   "Execute a (RINGBELLS) on the remote machine.")
-                            (Message (LET [(MESSAGE (MENU (create MENU ITEMS _ TALK.USER.MESSAGES]
-                                          (if [AND MESSAGE (TTY.PROCESSP (WINDOWPROP MAINWINDOW
-                                                                                'PROCESS]
-                                              then
-                                              (BKSYSBUF MESSAGE)))
-                                   "Insert a generic message.")))
-
-(RPAQQ TALK.USER.MESSAGES
 (("One moment please" "One moment please..." NIL (SUBITEMS (
-                                                                                "the phone's ringing"
-                                                                                          
-                                                          "One moment please, the phone's ringing..."
-                                                                                          )
-                                                                                      (
-                                                                        "there's someone at the door"
-                                                                                       
-                                                  "One moment please, there's someone at the door..."
-                                                                                       )
-                                                                                      (
-                                                                    "someone is trying to TALK to me"
-                                                                                       
-                                              "One moment please, someone is trying to TALK to me..."
-                                                                                       )))
-                               (DATE (DATE)
-                                     "The current date and time.")
-                               "Bye."))
-
-(RPAQ? TALK.SERVICETYPES
 NIL)
-
-(RPAQ? TALK.PROTOCOLTYPES
 NIL)
-
-(RPAQ? TALK.GAG
 NIL)
-
-(RPAQ? TALK.HOSTNAMES
 NIL)
-
-(RPAQ? TALK.ICON.WINDOWS
 NIL)
-
-(RPAQ? TALK.ANSWER.WAIT
 15)
-
-(RPAQ? TALK.READTABLE
 (COPYREADTABLE 'ORIG))
-
-(RPAQ? TALK.DEFAULT.REGION
 (CREATEREGION 0 0 500 500))
-
-(RPAQ? TALK.CLOSED.STRING
 " -- Connection Closed")
-
-(RPAQ? TALK.ICON.FONT
 LITTLEFONT)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG 
-       TALK.HOSTNAMES TALK.ICON.WINDOWS TALK.ANSWER.WAIT TALK.READTABLE TALK.DEFAULT.REGION 
-       TALK.CLOSED.STRING TALK.ICON.FONT)
-)
-
-(ADDTOVAR BackgroundMenuCommands
 (Talk '(PRINTOUT PROMPTWINDOW T (TALK)
-                                                   T)
-                                           "Start a TALK session with another user/host."))
-
-(RPAQQ BackgroundMenu
 NIL)
-
-(APPENDTOVAR BACKGROUNDFNS
 TALK.START.SERVER)
-
-(APPENDTOVAR AFTERMAKESYSFORMS
 (TALK.START.SERVER NIL T))
-
-(RPAQQ TALK.ICON.BITMAP
 #*(80 78)OOOOOOOOOOOOOOOOOOOOLAIKKGHHDBNOOOOOOOOOOGFKJOKKEJDMOOOOOOOOOG@KHOHHEJJOOOOOOOOOOGFKJOKJMJNMOOOOOOOOOGFHKGKKDBNOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOOLAKGDGOOOOOOOOOOOOOOOGKBENOOOOOOOOOOOOOOOGKEDGOOOOOOOOOOOOOOOGKGENOOOOOOOOOOOOOOOGKGDGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOOMM@HLGOOOOOOOOOOOOOOLIFKENOOOOOOOOOOOOOOMEFKDGOOOOOOOOOOOOOOMMFKENOOOOOOOOOOOOOOMM@HLGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOO
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS TALK.ICON.BITMAP)
-)
-
-(SETSYNTAX (CHARCODE SPACE)
-       (CHARCODE A)
-       TALK.READTABLE)
-(PUTPROPS TALK COPYRIGHT ("Stanford University" 1987 1988))
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2377 6659 (TALK 2387 . 6657)) (6660 31221 (TALK.RECONNECT 6670 . 10485) (TALK.PROCESS 
-10487 . 11403) (TALK.DISPLAY 11405 . 14118) (TALK.LISTEN 14120 . 15633) (TALK.CLOSEFN 15635 . 16150) (
-TALK.ANSWER 16152 . 18935) (TALK.ANSWER.WINDOW 18937 . 21688) (TALK.ANSWER.USERNAME 21690 . 23092) (
-TALK.GET.NAME 23094 . 25712) (TALK.ADD.NAME 25714 . 27266) (TALK.FLASH.CARET 27268 . 28866) (
-TALK.WHENSELECTEDFN 28868 . 29649) (TALK.RINGBELLS 29651 . 30143) (TALK.START.SERVER 30145 . 31219)) (
-31222 32752 (TALK.ICON.BUTTONEVENTFN 31232 . 32451) (TALK.ICON.CLOSEFN 32453 . 32750)))))
-STOP

obsolete/lispusers/IPTALK

@@ -1,240 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "22-Jul-88 14:16:28" |{MCS:MCS:STANFORD}<LANE>IPTALK.;1|
 12755  )
-
-
-(PRETTYCOMPRINT IPTALKCOMS)
-
-(RPAQQ IPTALKCOMS
 ((* TALK (Interim)
-                          IP Interface)
-                       (LOCALVARS . T)
-                       (FNS TALK.IP.SERVER)
-                       (FNS TALK.IP.USERNAME TALK.IP.CONNECT TALK.IP.EVENT TALK.START.IP.SERVER)
-                       (INITVARS (TALK.UDP.PORT 517))
-                       (GLOBALVARS TALK.UDP.PORT TALK.IP.CONSTANTS)
-                       (DECLARE%: DONTCOPY (RECORDS TALK.IP.PACKET)
-                              (CONSTANTS * TALK.IP.CONSTANTS))
-                       (* etc)
-                       (FILES TALK TCP TCPUDP)
-                       (APPENDVARS (TALK.PROTOCOLTYPES (IP DODIP.HOSTP TALK.IP.USERNAME 
-                                                           TALK.IP.CONNECT TALK.IP.EVENT 
-                                                           TALK.START.IP.SERVER)))
-                       (DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS TCPEXPORTS)
-                              )
-                       (P (TALK.START.IP.SERVER))))
-
-
-
-(* TALK (Interim) IP Interface)

-
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(LOCALVARS . T)
-)
-(DEFINEQ
-
-(TALK.IP.SERVER

-  [LAMBDA NIL
                                            (* ; "Edited 17-Jun-88 13:45 by cdl")

-    (DECLARE
 (GLOBALVARS \IP.READY))
-    (LET (SOCKET)
-         (DECLARE
 (SPECVARS SOCKET))
-         (RESETLST
-             [RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET TALK.UDP.PORT]
-             [bind
 PACKET RESPONSE SERVICE GAP.SERVICETYPE TALK.SERVICETYPE INPUTSTREAM 
-                    OUTPUTSTREAM PORT USER while
 \IP.READY
-                do
 (SETQ PACKET (UDP.GET SOCKET T))
-                      (UDP.SETUP (SETQ RESPONSE (\ALLOCATE.ETHERPACKET))
-                             (with
 IP PACKET IPSOURCEADDRESS)
-                             (with
 UDP PACKET UDPSOURCEPORT)
-                             0 SOCKET 'FREE)
-                      (UDP.APPEND.BYTE RESPONSE (with
 TALK.IP.PACKET PACKET TALK.SERVICE.BYTE))
-                      (if
 [OR [NULL (if
 (SETQ GAP.SERVICETYPE (ASSOC (with
 TALK.IP.PACKET
-                                                                                    PACKET 
-                                                                                    TALK.SERVICE.BYTE
-                                                                                    )
-                                                                             GAP.SERVICETYPES))
-                                            then
 (SETQ SERVICE (with
 GAP.SERVICETYPE 
-                                                                          GAP.SERVICETYPE 
-                                                                          GAP.SERVICENAME]
-                                  (NULL (SETQ TALK.SERVICETYPE (ASSOC SERVICE TALK.SERVICETYPES]
-                          then
 (UDP.APPEND.BYTE RESPONSE \IPTALK.NOSERVICE)
-                                (UDP.SEND SOCKET RESPONSE)
-                        elseif
 [OR TALK.GAG (NOT (TALK.ANSWER (SETQ USER (with
 TALK.IP.PACKET
-                                                                                    PACKET 
-                                                                                    TALK.IP.USERNAME)
-                                                                   )
-                                                            SERVICE
-                                                            'IP
-                                                            (with
 IP PACKET IPSOURCEADDRESS]
-                          then
 (UDP.APPEND.BYTE RESPONSE \IPTALK.NOANSWER)
-                                (UDP.SEND SOCKET RESPONSE)
-                        else
 (UDP.APPEND.BYTE RESPONSE \IPTALK.SUCCESS)
-                              (UDP.APPEND.WORD RESPONSE (SETQ PORT (\TCP.SELECT.PORT)))
-                              (UDP.SEND SOCKET RESPONSE)
-                              (if
 (SETQ INPUTSTREAM (TCP.OPEN (with
 IP PACKET IPSOURCEADDRESS
-                                                                         )
-                                                               NIL PORT 'PASSIVE 'INPUT))
-                                  then
 (TALK.PROCESS INPUTSTREAM (TCP.OTHER.STREAM INPUTSTREAM)
-                                                  TALK.SERVICETYPE
-                                                  'IP
-                                                  'SERVER USER T])])
-)
-(DEFINEQ
-
-(TALK.IP.USERNAME

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE MODE USER)

-                                                             (* ; "Edited  8-Jun-88 15:45 by cdl")

-    (SELECTQ (with
 TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME)
-        ((TTY Sketch)                                        (* For (backward) compatibility)

-             USER)
-        (LET ((NAME (USERNAME)))
-             (PRINTOUT OUTPUTSTREAM (if
 (NOT (STREQUAL NAME (CONSTANT null)))
-                                        then
 NAME)
-                    T)
-             (FORCEOUTPUT OUTPUTSTREAM)
-             (SETQ NAME (RATOM INPUTSTREAM TALK.READTABLE))  (* Eat EOL)

-             (BIN INPUTSTREAM)
-             (OR NAME USER])
-
-(TALK.IP.CONNECT

-  [LAMBDA (HOST SERVICETYPES)
                            (* ; "Edited 13-Jun-88 17:54 by cdl")

-    (DECLARE
 (SPECVARS HOST SERVICETYPES))
-    (LET
-     (SOCKET)
-     (DECLARE
 (SPECVARS SOCKET))
-     (RESETLST
-         [RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET]
-         [PROG (NAME REQUEST RESPONSE INPUTSTREAM RESULT)
-               (while
 (STREQUAL (SETQ NAME (USERNAME))
-                                 (CONSTANT null)) do
 (LOGIN))
-               (if

-                [LITATOM
-                 (SETQ RESULT
-                  (for
 SERVICETYPE in
 SERVICETYPES
-                     thereis
 (PROGN (UDP.SETUP (SETQ REQUEST (\ALLOCATE.ETHERPACKET))
-                                               HOST TALK.UDP.PORT 0 SOCKET 'FREE)
-                                        (UDP.APPEND.BYTE
-                                         REQUEST
-                                         (with
 GAP.SERVICETYPE
-                                                [for
 GAP.SERVICETYPE in
 GAP.SERVICETYPES
-                                                   thereis
 (with
 GAP.SERVICETYPE 
-                                                                      GAP.SERVICETYPE
-                                                                      (with
 TALK.SERVICETYPE 
-                                                                             SERVICETYPE
-                                                                             (EQ GAP.SERVICENAME 
-                                                                                 TALK.SERVICENAME]
-                                                GAP.UNSPECIFIED))
-                                        (UDP.APPEND.BYTE REQUEST 0)
-                                        (UDP.APPEND.WORD REQUEST 0)
-                                        (UDP.APPEND.WORD REQUEST (NCHARS NAME))
-                                        (UDP.APPEND.STRING REQUEST NAME)
-                                        (if
 [SETQ RESPONSE
-                                                 (UDP.EXCHANGE SOCKET REQUEST
-                                                        (TIMES TALK.ANSWER.WAIT
-                                                               (CONSTANT (PROGN 
-                                                             (* Convert to milliseconds and 
-
                                                           double in case they are idle)

-                                                                                (TIMES 2 1000]
-                                            then
 (SELECT (with
 TALK.IP.PACKET RESPONSE 
-                                                                    TALK.STATUS)
-                                                            (\IPTALK.SUCCESS T)
-                                                            (\IPTALK.NOSERVICE NIL)
-                                                            (\IPTALK.NOANSWER (RETURN 'ANSWER))
-                                                            (RETURN 'CONNECT))
-                                          else
           (* Can't connect)

-                                                (RETURN 'CONNECT]
-                   then
 (RETURN RESULT)
-                 else
 (if
 (STREAMP (SETQ INPUTSTREAM (TCP.OPEN HOST (with
 TALK.IP.PACKET
-                                                                                   RESPONSE 
-                                                                                   TALK.TEDIT.PORT)
-                                                                    NIL
-                                                                    'ACTIVE
-                                                                    'INPUT T)))
-                              then
 [RETURN (CONS RESULT (CONS INPUTSTREAM (TCP.OTHER.STREAM
-                                                                               INPUTSTREAM]
-                            else
 (RETURN 'CONNECT])])
-
-(TALK.IP.EVENT

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM)
                     (* cdl "18-May-87 16:29")

-    (while
 (AND (OPENP INPUTSTREAM)
-                    (OPENP OUTPUTSTREAM)
-                    (NOT (READP INPUTSTREAM))) do
 (if
 (EOFP INPUTSTREAM)
-                                                          then
 (CLOSEF? INPUTSTREAM))
-                                                     (BLOCK])
-
-(TALK.START.IP.SERVER

-  [LAMBDA (RESTART)
                                      (* ; "Edited 17-Jun-88 12:20 by cdl")

-    [LET [(DEVICE (\GETDEVICEFROMNAME 'TCP 'NOERROR 'DONTCREATE]
-         (if
 DEVICE
-             then
                                        (* (Temporary) patch to make TCP 
-
                                                           streams handle NS character codes)

-                   (with
 FDEV DEVICE (if
 (NULL READCHARCODE)
-                                             then
 (SETQ READCHARCODE (FUNCTION \GENERIC.READCCODE
-                                                                          ]
-    (bind
 PROCESS while
 (AND (SETQ PROCESS (FIND.PROCESS 'TALK.IP.SERVER))
-                                     RESTART) do
 (DEL.PROCESS PROCESS)
-                                                    (BLOCK)
-       yield
 (if
 PROCESS
-                     then
 PROCESS
-                   elseif
 \IP.READY
-                     then
 (ADD.PROCESS '(TALK.IP.SERVER
)
-                                     'RESTARTABLE
-                                     'SYSTEM])
-)
-
-(RPAQ? TALK.UDP.PORT
 517)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS TALK.UDP.PORT TALK.IP.CONSTANTS)
-)
-(DECLARE%: DONTCOPY 
-(DECLARE%: EVAL@COMPILE
-
-(ACCESSFNS TALK.IP.PACKET
 [(TALK.PACKET.BASE (with
 UDP DATUM UDPCONTENTS))
-                               (TALK.IP.USERNAME (\GETBASESTRING (with
 UDP DATUM UDPCONTENTS)
-                                                        6
-                                                        (with
 TALK.IP.PACKET DATUM 
-                                                               TALK.USERNAME.LENGTH]
-                              (BLOCKRECORD TALK.PACKET.BASE ((TALK.SERVICE.BYTE BYTE)
-                                                             (TALK.STATUS BYTE)
-                                                             (TALK.TEDIT.PORT WORD)
-                                                             (TALK.USERNAME.LENGTH WORD))))
-)
-
-
-(RPAQQ TALK.IP.CONSTANTS
 ((\IPTALK.SUCCESS 0)
-                              (\IPTALK.NOSERVICE 1)
-                              (\IPTALK.NOANSWER 2)))
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ \IPTALK.SUCCESS
 0)
-
-(RPAQQ \IPTALK.NOSERVICE
 1)
-
-(RPAQQ \IPTALK.NOANSWER
 2)
-
-
-(CONSTANTS (\IPTALK.SUCCESS 0)
-       (\IPTALK.NOSERVICE 1)
-       (\IPTALK.NOANSWER 2))
-)
-)
-
-
-
-(* etc)

-
-
-(FILESLOAD TALK TCP TCPUDP)
-
-(APPENDTOVAR TALK.PROTOCOLTYPES
 (IP DODIP.HOSTP TALK.IP.USERNAME TALK.IP.CONNECT TALK.IP.EVENT 
-                                        TALK.START.IP.SERVER))
-(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE 
-
-(FILESLOAD ETHERRECORDS TCPEXPORTS)
-)
-
-(TALK.START.IP.SERVER
)
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1313 4720 (TALK.IP.SERVER 1323 . 4718)) (4721 11119 (TALK.IP.USERNAME 4731 . 5475) (
-TALK.IP.CONNECT 5477 . 9538) (TALK.IP.EVENT 9540 . 9963) (TALK.START.IP.SERVER 9965 . 11117)))))
-STOP

obsolete/lispusers/NSTALK

@@ -1,319 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "27-Jul-88 09:09:52" |{MCS:MCS:STANFORD}<LANE>NSTALK.;3|
 16112  
-
-      changes to%:  (FNS DEFINE.GAP.SERVER)
-
-      previous date%: "16-Jun-88 17:33:04" |{MCS:MCS:STANFORD}<LANE>NSTALK.;1|)
-
-
-(PRETTYCOMPRINT NSTALKCOMS)
-
-(RPAQQ NSTALKCOMS
 ((* TALK NS (GAP)
-                          Interface)
-                       (LOCALVARS . T)
-                       (FNS CH.USER.WORKSTATION TALK.NS.SERVER)
-                       (FNS TALK.NS.USERNAME TALK.NS.CONNECT TALK.NS.EVENT TALK.NS.CREDENTIALS)
-                       (* GAP Server)
-                       (FNS GAP.SERVER DEFINE.GAP.SERVER)
-                       (INITVARS GAP.SERVICETYPES [TALK.GAP.HANDLE '((0 0]
-                              (TALK.GAP.UNKNOWN "(Viewpoint or XDE User)"))
-                       (VARS TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
-                       (GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.UNKNOWN 
-                              TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
-                       (DECLARE%: DONTCOPY (RECORDS GAP.SERVICETYPE))
-                       (* etc)
-                       (FILES TALK COURIERSERVE)
-                       (APPENDVARS (TALK.PROTOCOLTYPES (NS COERCE-TO-NSADDRESS TALK.NS.USERNAME 
-                                                           TALK.NS.CONNECT TALK.NS.EVENT 
-                                                           COURIER.START.SERVER)))
-                       [DECLARE%: DOCOPY (COMS (DECLARE%: EVAL@LOADWHEN (NOT (HASDEF 'GAP
-                                                                                    'COURIERPROGRAM))
-                                                      (FILES NSTALKGAP]
-                       (* DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS SPPDECLS)
-                          (* Also need to load EXPORTS.ALL))
-                       (* COURIER.RESET.SOCKET used to be defined by TALK, now defined in 
-                          COURIERSERVE module)
-                       (APPENDVARS (BEFORELOGOUTFORMS (COURIER.RESET.SOCKET)))
-                       (P (DEFINE.GAP.SERVER)
-                          (COURIER.START.SERVER))))
-
-
-
-(* TALK NS (GAP) Interface)

-
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(LOCALVARS . T)
-)
-(DEFINEQ
-
-(CH.USER.WORKSTATION

-  [LAMBDA (USER WORKSTATION)
                             (* ; "Edited  3-Jun-88 09:18 by cdl")

-    (if
 WORKSTATION
-        then
 (LET (NSADDRESS)
-                      (if
 (SETQ NSADDRESS (COERCE-TO-NSADDRESS WORKSTATION (ZERO)))
-                          then
 (CH.DELETE.PROPERTY USER 'ADDRESS.LIST)
-                                (CH.ADD.ITEM.PROPERTY USER 'ADDRESS.LIST (SETQ NSADDRESS (CONS 
-                                                                                            NSADDRESS
-                                                                                               ))
-                                       '(SEQUENCE NSADDRESS))
-                                (CONS USER NSADDRESS)
-                        else
 (ERROR WORKSTATION "Address for host not found!")))
-      else
 (CH.DELETE.PROPERTY USER 'ADDRESS.LIST])
-
-(TALK.NS.SERVER

-  [LAMBDA (INPUTSTREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)

-                                                             (* ; "Edited 15-Jun-88 11:10 by cdl")

-                                                             (* DECLARATIONS%: (ASSOCRECORD ALST
-
                                                           (service)))

-    (LET ((USER (TALK.NS.CREDENTIALS
 CREDENTIALS))
-          (ADDRESS (create
 NSADDRESS
-                          NSSOCKET _ (ZERO) using
 (SPP.DESTADDRESS INPUTSTREAM)))
-          SERVICETYPE)
-         (with
 GAP.SERVICETYPE [for
 SERVICETYPE in
 GAP.SERVICETYPES
-                                      thereis
 (for
 NUMBER
-                                                     in
 (CAR (with
 ALST TRANSPORT service))
-                                                     thereis
 (with
 GAP.SERVICETYPE 
-                                                                        SERVICETYPE (EQP NUMBER 
-                                                                                      GAP.UNSPECIFIED
-                                                                                         ]
-                (if
 (OR TALK.GAG (NOT (TALK.ANSWER (OR USER TALK.GAP.UNKNOWN)
-                                                 GAP.SERVICENAME
-                                                 'NS ADDRESS)))
-                    then
 (if
 (AND (EQ GAP.SERVICENAME 'TTY)
-                                          (NULL VERIFIER))
-                                 then
 
-
-         (* Should be noAnswerOrBusy, but that 915's XDE/Viewpoint so use VERIFIER to 
-
       determine if called by Lisp, can't count on this for future)

-
-                                       '(ABORT serviceNotFound)
-                               else
 '(ABORT noAnswerOrBusy))
-                  else
 (COURIER.RETURN INPUTSTREAM PROGRAM PROCEDURE TALK.GAP.HANDLE)
-                        (TALK.PROCESS INPUTSTREAM (SPPOUTPUTSTREAM INPUTSTREAM)
-                               GAP.SERVICENAME
-                               'NS
-                               'SERVER USER])
-)
-(DEFINEQ
-
-(TALK.NS.USERNAME

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE MODE USER)

-                                                             (* ; "Edited  9-Jun-88 12:42 by cdl")

-    (LET (OBJECT NAME (SERVICE (with
 TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME)))
-         (DECLARE
 (GLOBALVARS LOCAL.CLEARINGHOUSE CH.NET.HINT))
-         (if
 (OR (EQ SERVICE 'TEdit)
-                     (EQ MODE 'CLIENT))
-             then
 (if
 (STREQUAL (SETQ NAME (USERNAME))
-                                     (CONSTANT null))
-                          then
 (SETQ NAME NIL)
-                        elseif
 (OR LOCAL.CLEARINGHOUSE CH.NET.HINT)
-                          then
 (if
 (SETQ OBJECT (CH.LOOKUP.OBJECT NAME))
-                                       then
 (SETQ NAME OBJECT)))
-                   (PRINTOUT OUTPUTSTREAM NAME T)
-                   (FORCEOUTPUT OUTPUTSTREAM))
-         (if
 (OR (EQ SERVICE 'TEdit)
-                     (EQ MODE 'SERVER))
-             then
 (if
 (SETQ OBJECT (RATOM INPUTSTREAM TALK.READTABLE))
-                          then
 (SETQ USER OBJECT))       (* Eat EOL)

-                   (BIN INPUTSTREAM))
-         (SELECTQ SERVICE
-             (TTY (with
 SPPCON (with
 SPPSTREAM OUTPUTSTREAM SPP.CONNECTION)
-                         (SETQ SPPEOMONFORCEOUT T)))
-             NIL)
-         USER])
-
-(TALK.NS.CONNECT

-  [LAMBDA (HOST SERVICETYPES)
                            (* ; "Edited 15-Jun-88 10:40 by cdl")

-                                                             (* DECLARATIONS%: (RECORD 
-
                                                           AUTHENTICATOR (CREDENTIALS VERIFIER)))

-    (PROG (USER STREAM SERVICETYPE RESULT (CREDENTIALS (with
 AUTHENTICATOR (CH.GETAUTHENTICATOR
-                                                                                T)
-                                                              CREDENTIALS))
-                (VERIFIER (with
 AUTHENTICATOR (CH.GETAUTHENTICATOR)
-                                 VERIFIER)))
-          (DECLARE
 (GLOBALVARS SPP.USER.TIMEOUT))
-          (if
 (SETQ STREAM (COURIER.OPEN HOST NIL T (PACK* 'TALK# HOST)))
-              then

-              (if

-               (SETQ SERVICETYPE
-                (for
 SERVICETYPE in
 SERVICETYPES
-                   thereis

-                   (SELECTQ [CAR
-                             (SETQ RESULT
-                              (COURIER.CALL
-                               STREAM
-                               'GAP
-                               'Create TALK.GAP.PARAMETERS
-                               `([service (,(with
 GAP.SERVICETYPE
-                                                   [for
 TYPE in
 GAP.SERVICETYPES
-                                                      thereis
 (with
 GAP.SERVICETYPE TYPE
-                                                                         (with
 TALK.SERVICETYPE 
-                                                                                SERVICETYPE
-                                                                                (EQ GAP.SERVICENAME 
-                                                                                    TALK.SERVICENAME]
-                                                   GAP.UNSPECIFIED]
-                                 ,@TALK.GAP.TRANSPORT)
-                               SPP.USER.TIMEOUT CREDENTIALS VERIFIER 'RETURNERRORS]
-                       (ERROR (SELECTQ (CADR RESULT)
-                                  (noAnswerOrBusy            (* User hung up or didn't answer, 
-
                                                           don't try another service)

-                                       (RETURN))
-                                  (serviceNotFound 
-
-         (* Old Lisp TTY service returns this when it really means noAnswerOrBusy for 
-
       compatibility with Tajo/Viewpoint.)

-
-                                       (if
 (with
 TALK.SERVICETYPE SERVICETYPE
-                                                      (EQ TALK.SERVICENAME 'TTY))
-                                           then
 
-
-         (* Don't try services following TTY service for NS we don't know if remote 
-
       service wasn't there or remote user refused connection so we may annoy the 
-
       remote user, of course we may miss a possible connection)

-
-                                                 (RETURN)))
-                                  NIL))
-                       RESULT)))
-                  then
 [RETURN (CONS SERVICETYPE (CONS STREAM (SPPOUTPUTSTREAM STREAM]
-                else
 (CLOSEF? STREAM)
-                      (RETURN 'ANSWER))
-            else
 (RETURN 'CONNECT])
-
-(TALK.NS.EVENT

-  [LAMBDA (INPUTSTREAM OUTPUTSTREAM)
                     (* cdl "10-Jun-87 07:55")

-    (if
 (AND (OPENP INPUTSTREAM)
-                 (OPENP OUTPUTSTREAM)
-                 (NOT (READP INPUTSTREAM)))
-        then
 (AWAIT.EVENT (with
 SPPCON (with
 SPPSTREAM INPUTSTREAM SPP.CONNECTION)
-                                     SPPINPUTEVENT)))
-    (if
 (OPENP INPUTSTREAM)
-        then
 (SELECTQ (EOFP INPUTSTREAM)
-                     (ATTENTION (SPP.CLEARATTENTION INPUTSTREAM)
-                                (BIN INPUTSTREAM))
-                     (EOM (SPP.CLEAREOM INPUTSTREAM))
-                     (T (CLOSEF INPUTSTREAM))
-                     NIL])
-
-(TALK.NS.CREDENTIALS

-  [LAMBDA (CREDENTIALS)
                                  (* cdl " 6-May-87 15:58")

-    (if
 (AND CREDENTIALS (SETQ CREDENTIALS (CADR CREDENTIALS)))
-        then
 (SUBATOM (COURIER.READ.REP CREDENTIALS 'CLEARINGHOUSE 'NAME)
-                        1 -2])
-)
-
-
-
-(* GAP Server)

-
-(DEFINEQ
-
-(GAP.SERVER

-  [LAMBDA (STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)

-                                                             (* ; "Edited  9-Jun-88 12:06 by cdl")

-                                                             (* DECLARATIONS%: (ASSOCRECORD ALST
-
                                                           (service)))

-    (LET (SERVICETYPE)
-         (if
 [OR [for
 NUMBER in
 (CAR (with
 ALST TRANSPORT service))
-                        thereis
 (SETQ SERVICETYPE (for
 SERVICETYPE in
 GAP.SERVICETYPES
-                                                         thereis
 (with
 GAP.SERVICETYPE 
-                                                                            SERVICETYPE
-                                                                            (AND (EQP NUMBER 
-                                                                                      GAP.UNSPECIFIED
-                                                                                      )
-                                                                                 GAP.SERVERFN]
-                     (AND (SETQ SERVICETYPE (ASSOC T GAP.SERVICETYPES))
-                          (with
 GAP.SERVICETYPE SERVICETYPE 
-                                                             (* There was a server in place 
-
                                                           before TALK was loaded)

-                                 (FGETD GAP.SERVERFN]
-             then
 (APPLY* (with
 GAP.SERVICETYPE SERVICETYPE GAP.SERVERFN)
-                             STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS 
-                             VERIFIER)
-           else
 '(ABORT serviceNotFound])
-
-(DEFINE.GAP.SERVER

-  [LAMBDA NIL
                                            (* ; "Edited 27-Jul-88 09:08 by cdl")

-                                                             (* DECLARATIONS%: (ASSOCRECORD 
-
                                                           PROCEDURES (Create))
-
                                                           (PROPRECORD PROCEDURE
-
                                                           (IMPLEMENTEDBY)))

-    (if
 (HASDEF 'GAP 'COURIERPROGRAM)
-        then
 (PROG [SERVERFN PROCEDURE (COURIERDEF (GETDEF 'GAP 'COURIERPROGRAM]
-                       [with
 COURIERPGM COURIERDEF (SETQ PROCEDURE (with
 PROCEDURES 
-                                                                              PROCEDURES Create))
-                              [if
 (SETQ SERVERFN (with
 PROCEDURE PROCEDURE IMPLEMENTEDBY))
-                                  then
 (if
 (EQ SERVERFN 'GAP.SERVER)
-                                               then
 (RETURN)) 
-                                                             (* Make the existing GAP server the 
-
                                                           default)

-                                        (if
 GAP.SERVICETYPES
-                                            then
 (PUTASSOC T `(DEFAULT ,SERVERFN)
-                                                            GAP.SERVICETYPES)
-                                          else
 (push
 GAP.SERVICETYPES
-                                                          `(T DEFAULT ,SERVERFN]
-                              (with
 PROCEDURE PROCEDURE (SETQ IMPLEMENTEDBY 'GAP.SERVER]
-                       (PUTDEF 'GAP 'COURIERPROGRAM COURIERDEF)
-                       (UNMARKASCHANGED 'GAP 'COURIERPROGRAM))
-      else
 (ERROR "Courier program GAP not defined!"])
-)
-
-(RPAQ? GAP.SERVICETYPES
 NIL)
-
-(RPAQ? TALK.GAP.HANDLE
 '((0 0)))
-
-(RPAQ? TALK.GAP.UNKNOWN
 "(Viewpoint or XDE User)")
-
-(RPAQQ TALK.GAP.PARAMETERS
 (ttyHost (seven even two 100 (none 0 0))))
-
-(RPAQQ TALK.GAP.TRANSPORT
 ((teletype)))
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.UNKNOWN TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
-)
-(DECLARE%: DONTCOPY 
-(DECLARE%: EVAL@COMPILE
-
-(RECORD GAP.SERVICETYPE
 (GAP.UNSPECIFIED GAP.SERVICENAME GAP.SERVERFN))
-)
-)
-
-
-
-(* etc)

-
-
-(FILESLOAD TALK COURIERSERVE)
-
-(APPENDTOVAR TALK.PROTOCOLTYPES
 (NS COERCE-TO-NSADDRESS TALK.NS.USERNAME TALK.NS.CONNECT 
-                                        TALK.NS.EVENT COURIER.START.SERVER))
-(DECLARE%: DOCOPY 
-(DECLARE%: EVAL@LOADWHEN 
-(NOT (HASDEF 'GAP 'COURIERPROGRAM)) 
-
-(FILESLOAD NSTALKGAP)
-)
-)
-
-
-
-(* DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS SPPDECLS) (* Also need to load 
-EXPORTS.ALL))

-
-
-
-
-(* COURIER.RESET.SOCKET used to be defined by TALK, now defined in COURIERSERVE module)

-
-
-(APPENDTOVAR BEFORELOGOUTFORMS
 (COURIER.RESET.SOCKET))
-
-(DEFINE.GAP.SERVER
)
-
-(COURIER.START.SERVER)
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2304 5420 (CH.USER.WORKSTATION 2314 . 3215) (TALK.NS.SERVER 3217 . 5418)) (5421 11213 (
-TALK.NS.USERNAME 5431 . 6816) (TALK.NS.CONNECT 6818 . 10218) (TALK.NS.EVENT 10220 . 10917) (
-TALK.NS.CREDENTIALS 10919 . 11211)) (11237 14919 (GAP.SERVER 11247 . 13041) (DEFINE.GAP.SERVER 13043
- . 14917)))))
-STOP

scripts/clean_hcfiles.sh

@@ -23,8 +23,8 @@ main() {
 
     cat >"${shellfile}" <<-'EOF'
 	#!/bin/sh
-	git status --porcelain "$1" | grep --quiet --no-messages "??"
-	if [ $? -eq 0 ]
+	x=$(git ls-files "$1" 2>/dev/null)
+	if [ -z "$x" ]
 	then
 	rm -f "$1"
 	rm -f "$1".~*~

scripts/do_hcfiles.sh

@@ -38,6 +38,13 @@ main() {
 	"
 	EOF
 
+        # Make sure loadups/build is not included in HCFILES
+        if [ -d "${MEDLEYDIR}/loadups/build" ]
+        then
+          touch "${MEDLEYDIR}/loadups/build/.skip"
+        fi
+
+
         /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command"     \
              --config -                                          \
              --id hcfiles_+                                      \

scripts/loadups/loadup

@@ -17,6 +17,10 @@ main() {
         nocopy=false
         thinw=false
         thinl=false
+        override_lock=false
+        ignore_lock=false
+        export LOADUP_USE_VNC="-"
+
         while [ "$#" -ne 0 ];
       	do
           case "$1" in
@@ -144,9 +148,25 @@ main() {
               export MAIKODIR="${maikodir}"
               shift
               ;;
+            -v | -vnc | --vnc)
+              export LOADUP_USE_VNC="+"
+              ;;
+            -ov | -override | --override)
+              override_lock=true
+              ;;
+            --ignore_lock)
+              # internal
+              ignore_lock=true
+              ;;
             --noendmsg)
+              # internal
               noendmsg=true
               ;;
+            --forcevnc)
+              # internal - for testing
+              # WSL only -otherwise warning msg from medley
+              force_vnc="+"
+              ;;
             -z | -man | --man )
               if [ "$(uname)" = "Darwin" ]
               then
@@ -251,7 +271,7 @@ main() {
 
 
         # check and set the run_lock
-        check_run_lock
+        check_run_lock "${override_lock}"
 
         # if requested, thin the loadups and workdirs by eliminating all versioned (*.~[0-9]*~) files
         # from these directories
@@ -280,7 +300,7 @@ main() {
         fi
 
         #
-        #  Do individual loadups as requested
+        #  Do individual "stage" loadups as requested
         #
 
         if [ "${no_loadups}" = false ]
@@ -314,23 +334,11 @@ main() {
 	          /bin/sh "${LOADUP_SCRIPTDIR}/loadup-apps-from-full.sh"
 	          exit_if_failure $? "${noendmsg}"
 	        fi
-
-	        if [ "${aux}" = true ]
-	        then
-	          /bin/sh "${LOADUP_SCRIPTDIR}/loadup-aux.sh"
-	          exit_if_failure $? "${noendmsg}"
-	        fi
-
-	        if [ "${db}" = true ]
-	        then
-	          /bin/sh "${LOADUP_SCRIPTDIR}/loadup-db-from-full.sh"
-	          exit_if_failure $? "${noendmsg}"
-	        fi
         fi
 
 
         #
-        #   Done with loadups, successfully.  Now copy files into loadups dir from workdir
+        #   Done with "stage" loadups, successfully.  Now copy the stages files into loadups dir from workdir
         #
 
         if [ "${nocopy}" = false ]
@@ -348,36 +356,87 @@ main() {
 	        then
 	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}"       \
 	              | sed -e "s#${MEDLEYDIR}/##g"
+	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}"       \
+	              | sed -e "s#${MEDLEYDIR}/##g"
 	        fi
 
 	        if [ $start -le 3 ] && [ $end -ge 4 ]
 	        then
 	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}"       \
 	              | sed -e "s#${MEDLEYDIR}/##g"
+	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}"       \
+	              | sed -e "s#${MEDLEYDIR}/##g"
 	        fi
 
 	        if  [ $start -le 4 ] && [ $end -ge 5 ]
 	        then
 	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/apps.sysout "${LOADUP_OUTDIR}"       \
 	              | sed -e "s#${MEDLEYDIR}/##g"
+	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}"       \
+	              | sed -e "s#${MEDLEYDIR}/##g"
 	        fi
+        fi
 
+
+
+        #
+        #  Now do the "after stages" loadups, if required.  Do the copies as necessary to meet the dependecies
+        #  of one loadup on another's output.
+        #
+
+        # First aux
+
+        if [ "${no_loadups}" = false ]
+        then
+
+	        if [ "${aux}" = true ]
+	        then
+	          /bin/sh "${LOADUP_SCRIPTDIR}/loadup-aux.sh"
+	          exit_if_failure $? "${noendmsg}"
+	        fi
+        fi
+
+        if [ "${nocopy}" = false ]
+        then
 	        if [ "${aux}" = true ]
 	        then
 	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/whereis.hash "${LOADUP_OUTDIR}"      \
 	              | sed -e "s#${MEDLEYDIR}/##g"
 	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/exports.all "${LOADUP_OUTDIR}"       \
 	              | sed -e "s#${MEDLEYDIR}/##g"
+	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}"      \
+	              | sed -e "s#${MEDLEYDIR}/##g"
+	          /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/exports.dribble "${LOADUP_OUTDIR}"       \
+	              | sed -e "s#${MEDLEYDIR}/##g"
 	        fi
+        fi
 
+        # then db, which depends on the output of aux
+
+        if [ "${no_loadups}" = false ]
+        then
+                if [ "${db}" = true ]
+	        then
+	          /bin/sh "${LOADUP_SCRIPTDIR}/loadup-db-from-full.sh"
+	          exit_if_failure $? "${noendmsg}"
+	        fi
+        fi
+
+        if [ "${nocopy}" = false ]
+        then
 	        if [ "${db}" = true ]
 	        then
 		  /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/fuller.database "${LOADUP_OUTDIR}"    \
 	              | sed -e "s#${MEDLEYDIR}/##g"
+		  /bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/fuller.dribble "${LOADUP_OUTDIR}"    \
+	              | sed -e "s#${MEDLEYDIR}/##g"
 	        fi
-
         fi
 
+
+        #
+        #  OK we're done, exit cleanly
+        #
         echo "+++++ loadup: SUCCESS +++++"
         remove_run_lock
         exit 0

scripts/loadups/loadup-aux.sh

@@ -8,6 +8,13 @@ main() {
 
 	loadup_start
 
+	SYSOUT="${LOADUP_OUTDIR}/full.sysout"
+	if [ ! -f "${SYSOUT}" ]
+	then
+	  output_error_msg "Error: cannot find ${SYSOUT}.${EOL}Exiting."
+	  exit 1
+	fi
+
         initfile="-"
 	cat >"${cmfile}" <<-"EOF"
 	"
@@ -33,7 +40,7 @@ main() {
 	"
 	EOF
 
-	run_medley "${LOADUP_WORKDIR}/full.sysout"
+	run_medley "${SYSOUT}"
 
 	loadup_finish "whereis.hash" "whereis.hash" "exports.all"
 }

scripts/loadups/loadup-db-from-full.sh

@@ -6,13 +6,21 @@ main() {
 
 	loadup_start
 
-	SYSOUT="${MEDLEYDIR}/loadups/full.sysout"
-	if [ ! -f "${SYSOUT}" ];
+	SYSOUT="${LOADUP_OUTDIR}/full.sysout"
+	if [ ! -f "${SYSOUT}" ]
 	then
 	  output_error_msg "Error: cannot find ${SYSOUT}.${EOL}Exiting."
 	  exit 1
 	fi
 
+        # Check to make sure exports.all exists and is newer than full.sysout
+        # if not, run loadup-aux to create a new exports.all
+        EXPORTS="${LOADUP_OUTDIR}/exports.all"
+        if [ ! -f "${EXPORTS}" ] || [ "$(find "${SYSOUT}" -newer "${EXPORTS}" -exec echo true \; )" = true ]
+        then
+          "${MEDLEYDIR}"/scripts/loadups/loadup --aux --ignore_lock --noendmsg
+        fi
+
         initfile="-"
 	cat >"${cmfile}" <<-"EOF"
 	"

scripts/loadups/loadup-setup.sh

@@ -161,6 +161,7 @@ loadup_finish () {
   exit ${exit_code}
 }
 
+force_vnc="-"
 run_medley () {
     /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command"         \
              --config -                                          \
@@ -171,6 +172,8 @@ run_medley () {
              --rem.cm "${cmfile}"                                \
              --greet "${initfile}"                               \
              --sysout "$1"                                       \
+             --vnc "${LOADUP_USE_VNC}"                           \
+             --automation                                        \
              "$2" "$3" "$4" "$5" "$6" "$7"                       ;
     exit_code=$?
 }
@@ -247,15 +250,46 @@ process_maikodir() {
 }
 
 export LOADUP_LOCKFILE="${LOADUP_WORKDIR}"/lock
+LOADUP_LOCK=""
+override_lock=false
+ignore_lock=false
 
 check_run_lock() {
-  if [ -e "${LOADUP_LOCKFILE}" ]
+  if [ "${ignore_lock}" = false ]
   then
-    output_error_msg "Error: Another loadup is already running with PID $(cat "${LOADUP_LOCKFILE}")${EOL}Exiting."
-    exit 1
+    if [ -e "${LOADUP_LOCKFILE}" ]
+    then
+      output_warn_msg "Warning: Another loadup is already running with PID $(cat "${LOADUP_LOCKFILE}")"
+      if [ "${override_lock}" = true ]
+      then
+	output_warn_msg "Overriding lock preventing simultaneous loadups due to command line argument --override${EOL}Continuing."
+      else
+        loop_done=false
+        while [ "${loop_done}" = "false" ]
+        do
+          output_warn_msg "Do you want to override the lock guarding against simultaneous loadups?"
+          output_warn_msg "Answer [y, Y, n or N, default n] followed by RETURN"
+          read resp
+          if [ -z "${resp}" ]; then resp=n; fi
+          case "${resp}" in
+            n* | N* )
+              output_error_msg "Ok.  Exiting"
+              exit 5
+              ;;
+            y* | Y* )
+              output_warn_msg "Ok. Overriding lock and continuing"
+              loop_done=true
+              ;;
+            * )
+              output_warn_msg "Answer not one of Y, y, N, or n.  Retry."
+              ;;
+          esac
+        done
+      fi
+    fi
+    echo "$$" > "${LOADUP_LOCKFILE}"
+    LOADUP_LOCK="$$"
   fi
-  echo "$$" > "${LOADUP_LOCKFILE}"
-  LOADUP_LOCK="$$"
 }
 
 remove_run_lock() {

scripts/lsee

@@ -13,7 +13,7 @@
 export LANG=en_US.UTF-8
 tr '\r' '\n' < $1 | \
     sed -e 's/_/←/g'        \
-	-e 's/^/↑/g'        \
+	-e 's/\^/↑/g'        \
 	-e 's/
//g' \
 	-e 's///g'\
 	-e 's///g' \

scripts/medley/medley.command

@@ -586,6 +586,8 @@ flags:
 
     -x - | --logindir -        : use MEDLEYDIR/logindir as LOGINDIR in Medley
 
+    -am | --automation         : this call to medley is being used in automation, adjust timings.  Relevant in -vnc case only.
+
     -cm FILE | --rem.cm FILE   : use FILE as the REM.CM when starting up Medley.  FILE must be absolute pathname.
 
     -cm - | --rem.cm -         : do not use an REM.CM.  Negate any prior setting, e.g., from config file.
@@ -638,6 +640,7 @@ pixelscale_arg=""
 borderwidth_arg=""
 remcm_arg="${LDEREMCM}"
 repeat_cm=""
+automation=false
 
 # Add marker at end of args so we can accumulate pass-on args in args array
 set -- "$@" "--start_of_pass_args"
@@ -915,6 +918,9 @@ do
         fi
         exit 0
         ;;
+      -am | --automation)
+        automation=true
+        ;;
       -nf | -NF | --nofork)
         # for use in loadups
         case $2 in
@@ -1002,12 +1008,6 @@ do
   shift
 done
 
-# if running on WSL1, force use_vnc
-if [ "${wsl}" = true ] && [ "${wsl_ver}" -eq 1 ]
-then
-  use_vnc=true
-fi
-
 
 # Process run_id
 # if it doesn't end in #, make sure that there is not another instance currently running with this same id
@@ -1702,7 +1702,7 @@ do
                  "$(ip_addr)":"${VNC_PORT}"            \
                  >>"${LOG}" 2>&1                       &
   wait $!
-  if [ $(( $(date +%s) - start_time )) -lt 5 ]
+  if [ "${automation}" = false ] && [ $(( $(date +%s) - start_time )) -lt 5 ]
   then
     if [ -z "$(pgrep -f "Xvnc ${DISPLAY}")" ]
     then

scripts/medley/medley_args.sh

@@ -48,6 +48,7 @@ pixelscale_arg=""
 borderwidth_arg=""
 remcm_arg="${LDEREMCM}"
 repeat_cm=""
+automation=false
 
 # Add marker at end of args so we can accumulate pass-on args in args array
 set -- "$@" "--start_of_pass_args"
@@ -325,6 +326,9 @@ do
         fi
         exit 0
         ;;
+      -am | --automation)
+        automation=true
+        ;;
       -nf | -NF | --nofork)
         # for use in loadups
         case $2 in
@@ -412,9 +416,3 @@ do
   shift
 done
 
-# if running on WSL1, force use_vnc
-if [ "${wsl}" = true ] && [ "${wsl_ver}" -eq 1 ]
-then
-  use_vnc=true
-fi
-

scripts/medley/medley_usage.sh

@@ -115,6 +115,8 @@ flags:
 
     -x - | --logindir -        : use MEDLEYDIR/logindir as LOGINDIR in Medley
 
+    -am | --automation         : this call to medley is being used in automation, adjust timings.  Relevant in -vnc case only.
+
     -cm FILE | --rem.cm FILE   : use FILE as the REM.CM when starting up Medley.  FILE must be absolute pathname.
 
     -cm - | --rem.cm -         : do not use an REM.CM.  Negate any prior setting, e.g., from config file.

scripts/medley/medley_vnc.sh

@@ -215,7 +215,7 @@
                  "$(ip_addr)":"${VNC_PORT}"            \
                  >>"${LOG}" 2>&1                       &
   wait $!
-  if [ $(( $(date +%s) - start_time )) -lt 5 ]
+  if [ "${automation}" = false ] && [ $(( $(date +%s) - start_time )) -lt 5 ]
   then
     if [ -z "$(pgrep -f "Xvnc ${DISPLAY}")" ]
     then

sources/MEDLEYDIR

@@ -1,13 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "26-Aug-2024 22:11:48" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;4
 11113  
+
(FILECREATED "15-May-2025 00:18:25" {DSK}<home>frank>il>qmedley>sources>MEDLEYDIR.;2
 11450  
 
-      :EDIT-BY "mth"
+      :CHANGES-TO (VARS MEDLEY-INIT-VARS)
 
-      :CHANGES-TO (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS)
-                  (FNS SET-SYSOUT-COMMIT)
-
-      :PREVIOUS-DATE " 8-Jul-2024 22:49:43" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;3)
+      :PREVIOUS-DATE "26-Aug-2024 22:11:48" {DSK}<home>frank>il>qmedley>sources>MEDLEYDIR.;1)
 
 
 (PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -193,8 +190,12 @@
         (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
         (IRM.DINFOGRAPH)
         (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
-        [LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
-                                          (UNIX-GETENV "HOME"]
+        (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
+                                                     (UNIX-GETENV "HOME"]
+                            (AND (GETD 'PSEUDOHOSTS)
+                                 (TARGETHOST 'LI)
+                                 (PSEUDOHOST 'LI LHD))
+                            LHD))
         [USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM))
                               (CONS LOGINHOST/DIR '("INIT"]
         (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts" "fonts/adobe" 
@@ -206,8 +207,12 @@
                                           NIL NIL T))
         (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox")
                                    NIL NIL T))
-        (LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
-                                          (UNIX-GETENV "HOME")))
+        (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
+                                                     (UNIX-GETENV "HOME"]
+                            (AND (GETD 'PSEUDOHOSTS)
+                                 (TARGETHOST 'LI)
+                                 (PSEUDOHOST 'LI LHD))
+                            LHD)
                RESET)
         (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
                               (CONS LOGINHOST/DIR '("INIT"]
@@ -221,6 +226,6 @@
 (ADDTOVAR GLOBALVARS
 MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1749 8823 (MEDLEY-INIT-VARS 1759 . 5237) (MEDLEYDIR 5239 . 7623) (MEDLEYSUBSTDIR 7625
- . 8603) (SET-SYSOUT-COMMIT 8605 . 8821)))))
+  (FILEMAP (NIL (1661 8735 (MEDLEY-INIT-VARS 1671 . 5149) (MEDLEYDIR 5151 . 7535) (MEDLEYSUBSTDIR 7537
+ . 8515) (SET-SYSOUT-COMMIT 8517 . 8733)))))
 STOP