Fix issue #1749 - type-of NIL doesn't match CLtL2 (#1753)

* Fix issue #1749 - type-of NIL doesn't match CLtL2

* Fix uses of cl:type-of in the LOOP macro to deal with the change to cl:type-of.

.github/workflows/buildReleaseInclDocker.yml

@@ -3,6 +3,7 @@
 #
 # Interlisp webflow to build a Medley release and push it to github.
 # And to build a multiplatform Docker image for the release and push it to Docker Hub.
+# And to kickoff a build and deploy workflow for Medley-online within the online repo.
 #
 # This workflow just calls two reuseable workflows to the two task:
 # buildLoadup.yml and buildDocker.yml
@@ -14,12 +15,12 @@
 # ******************************************************************************
 
 
-name: "Build/Push Release & Docker"
+name: "Build/Push Release, Docker, OIO"
 
 # Run this workflow on ...
 on:
   schedule:
-    - cron: '0 9 * * 1'
+    - cron: '17 9 * * 3'
 
   workflow_dispatch:
     inputs:
@@ -111,3 +112,16 @@ jobs:
 
 ######################################################################################
 
+  # Kickoff workflow in online repo to build and deploy Medley docker image to oio
+  do_oio:
+    runs-on: ubuntu-latest
+    needs: [inputs, do_docker]
+    steps:
+      - name: trigger-oio-buildAndDeploy
+        run: |
+          if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
+          then
+            gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
+          fi
+        env:
+          GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}

.gitignore

@@ -5,6 +5,10 @@ tmp/*
 # releases directory
 releases/*
 
+# maiko directory
+maiko/
+
+
 # all PDFs (those explicitly checked in aren't ignored
 # normally when you have derived files, you ignore them from git
 # because they will get regenerated when you rebuild.
@@ -19,7 +23,8 @@ loadups/exports.all
 library/RDSYS*
 loadups/lisp.sysout
 loadups/full.sysout
-loadups/fuller.sysout   # not currently included but might as well ignore it
+# not currently included but might as well ignore it
+loadups/fuller.sysout
 loadups/*.dribble
 loadups/whereis.hash
 loadups/apps.sysout

docs/man-page/man_medley.html

@@ -15,64 +15,109 @@
 <dd><p>Show the man page for medley</p>
 </dd>
 <dt>-c [<em>FILE</em> | -], --config [<em>FILE</em> | -]</dt>
-<dd><p>Use <em>FILE</em> as the config file for this run of Medley. See information on <em>CONFIG FILE</em> below. If <em>FILE</em> is “-”, then suppress the use of a config file for this run of Medley.</p>
+<dd><p>Use <em>FILE</em> as the config file for this run of Medley. See information on <em>CONFIG FILE</em> below.</p>
+<p>If the given value is “-”, then suppress the use of a config file for this run of Medley.</p>
 </dd>
 <dt>-f, --full</dt>
-<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley.</p>
+<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
 </dd>
 <dt>-l, --lisp</dt>
-<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment.</p>
+<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
 </dd>
 <dt>-a, --apps</dt>
-<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation.</p>
+<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
 </dd>
 <dt>-u, --continue</dt>
-<dd><p>Nullify any prior setting of the sysout file (e.g., from the config file) - causing Medley to start from the virtual memory file resulting from the previous invocation (with the same values for –id and –logindir), if any. If there is no matching virtual memory file, Medley will start from the full.sysout (see -f/–full above). Equivalent to “-y -”. (See <em>SYSOUT FILE</em> section below.)</p>
+<dd><p>Nullify any prior setting of the sysout file (e.g., from the config file) - causing Medley to start from the virtual memory file resulting from the previous invocation (with the same values for –id and –logindir), if any. If there is no matching virtual memory file, Medley will start from the full.sysout (see -f/–full above).</p>
+<p>Equivalent to “-y -”.</p>
+<p>(See <em>SYSOUT FILE</em> section below.)</p>
 </dd>
 <dt>-y [<em>SYSOUT_FILE</em> | -], --sysout [<em>SYSOUT-FILE</em> | -]</dt>
-<dd><p>Start Medley from the specified <em>SYSOUT-FILE</em>. This is an alternative to specifying the <em>SYSOUT-FILE</em> as the last argument on the command line (but before any <em>PASS_ON_ARGS</em>). It can be used to specify the <em>SYSOUT-FILE</em> in the config file (see information on <em>CONFIG FILE</em> below). If <em>SYSOUT-FILE</em> is “-”, then any prior setting of the sysout file (e.g., from the config file) is nullified (see -u/–continue above). (See <em>SYSOUT FILE</em> section below.)</p>
+<dd><p>Start Medley from the specified <em>SYSOUT-FILE</em>. This is an alternative to specifying the <em>SYSOUT-FILE</em> as the last argument on the command line (but before any <em>PASS_ON_ARGS</em>). It can be used to specify the <em>SYSOUT-FILE</em> in the config file (see information on <em>CONFIG FILE</em> below).</p>
+<p>If the given value is “-”, then any prior setting of the sysout file (e.g., from the config file) is nullified (see -u/–continue above).</p>
+<p>(See <em>SYSOUT FILE</em> section below.)</p>
 </dd>
 <dt>-e [+ | -], --interlisp [+ | -]</dt>
-<dd><p>If value is “+” or no value, make the initial Exec window within Medley be an Interlisp Exec. If value is “-”, make the initial Exec window be the default XCL Exec. This flag applies only when the –apps flag is used.</p>
+<dd><p>If value is “+” or no value, make the initial Exec window within Medley be an Interlisp Exec. If value is “-”, make the initial Exec window be the default XCL Exec.</p>
+<p>This flag applies only when the –apps flag is used.</p>
 </dd>
 <dt>-n [+ | -], --noscroll [+ | -]</dt>
-<dd><p>Medley ordinarily displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window. Specifying “-n +” (–noscroll +) turns off scroll bars. Specifying “-n -” (–scroll -) turns on scroll bars. Specifying -n (–noscroll) with no value is equivalent to specifying “–noscroll +”. Default is scroll bars off. Note: If scroll bars are off and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
+<dd><p>Medley ordinarily displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window.</p>
+<p>Specifying “-n +” (–noscroll +) turns off scroll bars. Specifying “-n -” (–scroll -) turns on scroll bars. Specifying -n (–noscroll) with no value is equivalent to specifying “–noscroll +”.</p>
+<p>Default is scroll bars off.</p>
+<p>Note: If scroll bars are off and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
 </dd>
 <dt>-g [<em>WxH</em> | -], --geometry [<em>WxH</em> | -]</dt>
-<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported). If a value of “-” is given, geometry is set to the default value. If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set. (Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
+<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported).</p>
+<p>If a value of “-” is given, geometry is set to the default value.</p>
+<p>If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set.</p>
+<p>(Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
 </dd>
 <dt>-s [<em>WxH</em> | -], --screensize [<em>WxH</em> | -]</dt>
-<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. If a value of “-” is given, screensize is set to the default value. The Medley window is an unscaled viewport onto this virtual display. If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900. (Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
+<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. The Medley window is an unscaled viewport onto this virtual display.</p>
+<p>If a value of “-” is given, screensize is set to the default value.</p>
+<p>If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900.</p>
+<p>(Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
 </dd>
 <dt>-ps [<em>N</em> | -], –pixelscale [<em>N</em> | -] ** <strong>Applicable only when display is SDL-based (e.g., on Windows/Cygwin)</strong> **</dt>
-<dd><p>Sets the pixel scaling factor to <em>N</em>. If value of “-” is given, the pixel scale factor is set to its default of 1.</p>
+<dd><p>Sets the pixel scaling factor to <em>N</em>, an integer</p>
+<p>If value of “-” is given, the pixel scale factor is set to its default of 1.</p>
 </dd>
 <dt>-t [<em>STRING</em> | -], --title [<em>STRING</em> | -]</dt>
-<dd><p>Use STRING as title of Medley window. If the value of “-” is given, sets the title to its default value (“Medley Interlisp”). Ignored when when the --vnc flag is set.</p>
+<dd><p>Use <em>STRING</em> as title of Medley window.</p>
+<p>If <em>STRING</em> includes the character sequence “%i”, then the value of the id string (see –id flag below) prefixed by “::” will be substituited for the “%i”. Example: if the id is “run_45” and <em>STRING</em> is “Medley Interlisp %i”, then the actual window title will be “Medley Interlisp :: run_45”.</p>
+<p>If the value of “-” is given, sets the title to its default value (“Medley Interlisp %i”).</p>
+<p>This flag is ignored when when the --vnc flag is set.</p>
 </dd>
 <dt>-d [<em>:N</em> | -], --display [<em>:N</em> | -]</dt>
-<dd><p>Use X display :N. If value is “-”, reset display to its default value. Default value is the value of $DISPLAY. On platforms that support X Windows as well as SDL, the value of -d (–display) should be set to “SDL” to select using SDL instead of X Windows. This flag is ignored on the Windows/Cygwin platform and when the --vnc flag is set on Windows System for Linux.</p>
+<dd><p>Use X display <em>:N</em>.</p>
+<p>If value is “-”, reset display to its default value. Default value is the value of $DISPLAY.</p>
+<p>On platforms that support both SDL and X Windows, set the value of -d (–display) to “SDL” to select using SDL instead of X Windows.</p>
+<p>This flag is ignored on the Windows/Cygwin platform and when the --vnc flag is set on Windows System for Linux.</p>
 </dd>
 <dt>-v [+ | -] , --vnc [+ | -] ** <strong>Applicable only to WSL installations</strong> **</dt>
-<dd><p>If value is “+” or no value is given, then use a VNC window running on the Windows side instead of an X window. If value is “-”, then do not use a VNC window, relying instead on a standard X Window. A VNC window will folllow the Windows desktop scaling setting allowing for much more usable Medley on high resolution displays. On WSL, X windows do not scale well. This flag is always set for WSL1 installations.</p>
+<dd><p>If value is “+” or no value is given, then use a VNC window running on the Windows side instead of an X window. If value is “-”, then do not use a VNC window, relying instead on a standard X Window.</p>
+<p>A VNC window will folllow the Windows desktop scaling setting allowing for much more usable Medley on high resolution displays. On WSL, X windows do not scale well.</p>
+<p>This flag is always set for WSL1 installations.</p>
 </dd>
 <dt>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - | --]</dt>
-<dd><p>Use ID_STRING as the id for this run of Medley, unless ID_STRING is “-”, “--”, or “---”. If ID_STRING is “-”, then reset the id to “default” (e.g., if it was previously set in the config file). If ID_STRING is “--”, then use the basename of $MEDLEYDIR as the id. If ID_STRING is “---”, then use the basename of the parent directory of $MEDLEYDIR as the id. Only one instance of Medley with a given id can run at a time. The id is used to distinguish the virtual memory stores so that multiple instances of Medley can run simultaneously. Default id is “default”.</p>
+<dd><p>Use <em>ID_STRING</em> as the id for this run of Medley, unless the given value is “-”, “--”, or “---”.</p>
+<p>Only one instance of Medley can be run simultaneously for any given id.</p>
+<p><em>ID-STRING</em> can consist of any alphanumeric character plus the underscore (_) character, ending (optionally) in a “+” character. If <em>ID_STRING</em> ends with a “+” (including just a singleton “+”), then Medley will add a number to the id to make it unique among currently running Medley intsances.</p>
+<p>If the given value is “-”, then the id will be (re)set to “default” (e.g., if it was previously set in the config file). If it is “--”, then id will be set to the basename of $MEDLEYDIR. If ID_STRING is “---”, then id will be set to the basename of the parent directory of $MEDLEYDIR.</p>
+<p>Default id is “default”.</p>
 </dd>
 <dt>-m [<em>N</em> | -], --mem [<em>N</em> | -]</dt>
-<dd><p>Set Medley to run in <em>N</em> MB of virtual memory. Defaults to 256MB. If a value of “-” is given, resets to default value.</p>
+<dd><p>Set Medley to run in <em>N</em> MB of virtual memory. Defaults to 256MB.</p>
 </dd>
+</dl>
+<p>If a value of “-” is given, resets to default value.</p>
+<dl>
 <dt>-p [<em>FILE</em> | -], --vmem [<em>FILE</em> | -]</dt>
-<dd><p>Use FILE as the Medley virtual memory (vmem) store. FILE must be writeable by the current user. Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously. The --id flag will not protect against vmem collisions when the --vmem flag is used. If the value “-” is given, then resets the vmem file to the default. Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where III is the id of this Medley run (see --id flag above). See --logindir below for setting of LOGINDIR.</p>
+<dd><p>Use <em>FILE</em> as the Medley virtual memory (vmem) store. <em>FILE</em> must be writeable by the current user.</p>
+<p>Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously. The --id flag will not protect against vmem collisions when the --vmem flag is used.</p>
+<p>If the value “-” is given, then resets the vmem file to the default.</p>
+<p>Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where III is the id of this Medley run (see --id flag above). See --logindir below for setting of LOGINDIR.</p>
 </dd>
 <dt>-r [<em>FILE</em> | -], --greet [<em>FILE</em> | -]</dt>
-<dd><p>Use FILE as the Medley greetfile, unless FILE is “-” in which case Medley will start up without using a greetfile. The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT. On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
+<dd><p>Use <em>FILE</em> as the Medley greetfile.</p>
+<p>If the given value is “-”, Medley will start up without using a greetfile.</p>
+<p>The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.</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>-x [<em>DIR</em> | - | –], --logindir [<em>DIR</em> | - | –]</dt>
-<dd><p>Use DIR as LOGINDIR in Medley. If the value is “–”, use $MEDLEYDIR/logindir as LOGINDIR. If a value of “-” is given, then reset LOGINDIR to its default value. DIR (or $MEDLEYDIR/logindir) must be writeable by the current user. LOGINDIR defaults to $HOME/il. LOGINDIR is used by Medley as the working directory on start-up and where it loads any “personal” initialization file from. On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
+<dd><p>Use <em>DIR</em> as LOGINDIR in Medley. <em>DIR</em> must be writeable by the current user.</p>
+<p>LOGINDIR is used by Medley as the working directory on start-up and where it loads any “personal” initialization file from.</p>
+<p>If the given value is “-”, then reset LOGINDIR to its default value. If the given value is “–”, uses $MEDLEYDIR/logindir as LOGINDIR.</p>
+<p>LOGINDIR defaults to $HOME/il.</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>-nh <em>Host:Port:Mac:Debug</em>, --nethub <em>Host:Port:Mac:Debug</em></dt>
-<dd><p>Set the parameters for using Nethub XNS networking. <em>Host</em> is the full domain name of the nethub host. <em>Port</em> is the port on <em>Host</em> that nethub is using. <em>Mac</em> is the Mac address that this instance of Medley should use when contacting the nethub host. <em>Debug</em> is the level of nethub debug information that should be printed on stdout (value is 0, 1, or 2). A <em>Host</em> value is required and serves to turn nethub functionality on. <em>Port</em>, <em>Mac</em> and <em>Debug</em> parameters are optional and will default if left off. Finally, if any of the parameters have a value of “-”, any previous setting (e.g., in a config file) for the parameter will be reset to the default value - which in the case of <em>Host</em> is the null string, turning nethub functionality off.</p>
+<dd><p>Set the parameters for using Nethub XNS networking. <em>Host</em> is the full domain name of the nethub host. <em>Port</em> is the port on <em>Host</em> that nethub is using. <em>Mac</em> is the Mac address that this instance of Medley should use when contacting the nethub host. <em>Debug</em> is the level of nethub debug information that should be printed on stdout (value is 0, 1, or 2). A <em>Host</em> value is required and serves to turn nethub functionality on. <em>Port</em>, <em>Mac</em> and <em>Debug</em> parameters are optional and will default if left off.</p>
+<p>If any of the parameters have a value of “-”, any previous setting (e.g., in a config file) for the parameter will be reset to the default value - which in the case of <em>Host</em> is the null string, turning nethub functionality off.</p>
 </dd>
 <dt>-nf, -NF, –nofork</dt>
 <dd><p>No fork. Relevant only to the Medley loadup workflow.</p>

docs/man-page/medley.1

@@ -37,31 +37,43 @@ Show the man page for medley
 -c [\f[I]FILE\f[R] | -], --config [\f[I]FILE\f[R] | -]
 Use \f[I]FILE\f[R] as the config file for this run of Medley.
 See information on \f[I]CONFIG FILE\f[R] below.
-If \f[I]FILE\f[R] is \[lq]-\[rq], then suppress the use of a config file
-for this run of Medley.
+.RS
+.PP
+If the given value is \[lq]-\[rq], then suppress the use of a config
+file for this run of Medley.
+.RE
 .TP
 -f, --full
 Start Medley from the standard \[lq]full\[rq] sysout.
 full.sysout includes a complete Interlisp and CommonLisp environment
 with a standard set of development tools.
 It does not include any of the applications built using Medley.
+.RS
+.PP
 (See \f[I]SYSOUT_FILE\f[R] below for more information on starting
 sysouts.)
+.RE
 .TP
 -l, --lisp
 Start Medley from the standard \[lq]lisp\[rq] sysout.
 lisp.sysout only includes the basic Interlisp and CommonLisp
 environment.
+.RS
+.PP
 (See \f[I]SYSOUT_FILE\f[R] below for more information on starting
 sysouts.)
+.RE
 .TP
 -a, --apps
 Start Medley from the standard \[lq]apps\[rq] sysout.
 apps.sysout includes everything in full.sysout plus Medley applications
 including Notecards, Rooms and CLOS.
 It also includes pre-installed links to key Medley documentation.
+.RS
+.PP
 (See \f[I]SYSOUT_FILE\f[R] below for more information on starting
 sysouts.)
+.RE
 .TP
 -u, --continue
 Nullify any prior setting of the sysout file (e.g., from the config
@@ -70,8 +82,12 @@ from the previous invocation (with the same values for \[en]id and
 \[en]logindir), if any.
 If there is no matching virtual memory file, Medley will start from the
 full.sysout (see -f/\[en]full above).
+.RS
+.PP
 Equivalent to \[lq]-y -\[rq].
+.PP
 (See \f[I]SYSOUT FILE\f[R] section below.)
+.RE
 .TP
 -y [\f[I]SYSOUT_FILE\f[R] | -], --sysout [\f[I]SYSOUT-FILE\f[R] | -]
 Start Medley from the specified \f[I]SYSOUT-FILE\f[R].
@@ -80,145 +96,219 @@ last argument on the command line (but before any
 \f[I]PASS_ON_ARGS\f[R]).
 It can be used to specify the \f[I]SYSOUT-FILE\f[R] in the config file
 (see information on \f[I]CONFIG FILE\f[R] below).
-If \f[I]SYSOUT-FILE\f[R] is \[lq]-\[rq], then any prior setting of the
-sysout file (e.g., from the config file) is nullified (see
--u/\[en]continue above).
+.RS
+.PP
+If the given value is \[lq]-\[rq], then any prior setting of the sysout
+file (e.g., from the config file) is nullified (see -u/\[en]continue
+above).
+.PP
 (See \f[I]SYSOUT FILE\f[R] section below.)
+.RE
 .TP
 -e [+ | -], --interlisp [+ | -]
 If value is \[lq]+\[rq] or no value, make the initial Exec window within
 Medley be an Interlisp Exec.
 If value is \[lq]-\[rq], make the initial Exec window be the default XCL
 Exec.
+.RS
+.PP
 This flag applies only when the \[en]apps flag is used.
+.RE
 .TP
 -n [+ | -], --noscroll [+ | -]
 Medley ordinarily displays scroll bars to enable the user to pan the
 Medley virtual display within the Medley window.
 This is true even when the entire virtual display fits within the
 window.
+.RS
+.PP
 Specifying \[lq]-n +\[rq] (\[en]noscroll +) turns off scroll bars.
 Specifying \[lq]-n -\[rq] (\[en]scroll -) turns on scroll bars.
 Specifying -n (\[en]noscroll) with no value is equivalent to specifying
 \[lq]\[en]noscroll +\[rq].
+.PP
 Default is scroll bars off.
+.PP
 Note: If scroll bars are off and the virtual screen is larger than the
 window, there will be no way to pan to the non-visible parts of the
 virtual display.
+.RE
 .TP
 -g [\f[I]WxH\f[R] | -], --geometry [\f[I]WxH\f[R] | -]
 Sets the size of the X Window (or VNC window) that Medley runs in to be
 Width x Height.
 (Full X Windows geomtery specification with +X+Y is not currently
 supported).
+.RS
+.PP
 If a value of \[lq]-\[rq] is given, geometry is set to the default
 value.
+.PP
 If --geometry is not specified but --screensize is, then the window size
 will be determined based on the --screensize values and the --noscroll
 flag.
 If neither --geometry nor --screensize is provided, then the window size
 is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is
 not set.
+.PP
 (Also see note below under \f[I]CONFIG FILE\f[R] on the use of geometry
 and screensize in config files.)
+.RE
 .TP
 -s [\f[I]WxH\f[R] | -], --screensize [\f[I]WxH\f[R] | -]
 Sets the size of the virtual display as seen from Medley\[cq]s point of
 view.
+The Medley window is an unscaled viewport onto this virtual display.
+.RS
+.PP
 If a value of \[lq]-\[rq] is given, screensize is set to the default
 value.
-The Medley window is an unscaled viewport onto this virtual display.
+.PP
 If --screensize is not specified but --geometry is, then the virtual
 display size will be set so that the entire virtual display fits into
 the given window geometry.
 If neither --screensize nor --geometry is provided, then the screen size
 is set to 1440x900.
+.PP
 (Also see note below under \f[I]CONFIG FILE\f[R] on the use of geometry
 and screensize in config files.)
+.RE
 .TP
 -ps [\f[I]N\f[R] | -], \[en]pixelscale [\f[I]N\f[R] | -]\ \ \ \ ** \f[B]Applicable only when display is SDL-based (e.g., on Windows/Cygwin)\f[R] **
-Sets the pixel scaling factor to \f[I]N\f[R].
+Sets the pixel scaling factor to \f[I]N\f[R], an integer
+.RS
+.PP
 If value of \[lq]-\[rq] is given, the pixel scale factor is set to its
 default of 1.
+.RE
 .TP
 -t [\f[I]STRING\f[R] | -], --title [\f[I]STRING\f[R] | -]
-Use STRING as title of Medley window.
+Use \f[I]STRING\f[R] as title of Medley window.
+.RS
+.PP
+If \f[I]STRING\f[R] includes the character sequence \[lq]%i\[rq], then
+the value of the id string (see \[en]id flag below) prefixed by
+\[lq]::\[rq] will be substituited for the \[lq]%i\[rq].
+Example: if the id is \[lq]run_45\[rq] and \f[I]STRING\f[R] is
+\[lq]Medley Interlisp %i\[rq], then the actual window title will be
+\[lq]Medley Interlisp :: run_45\[rq].
+.PP
 If the value of \[lq]-\[rq] is given, sets the title to its default
-value (\[lq]Medley Interlisp\[rq]).
-Ignored when when the --vnc flag is set.
+value (\[lq]Medley Interlisp %i\[rq]).
+.PP
+This flag is ignored when when the --vnc flag is set.
+.RE
 .TP
 -d [\f[I]:N\f[R] | -], --display [\f[I]:N\f[R] | -]
-Use X display :N.
+Use X display \f[I]:N\f[R].
+.RS
+.PP
 If value is \[lq]-\[rq], reset display to its default value.
 Default value is the value of $DISPLAY.
-On platforms that support X Windows as well as SDL, the value of -d
-(\[en]display) should be set to \[lq]SDL\[rq] to select using SDL
-instead of X Windows.
+.PP
+On platforms that support both SDL and X Windows, set the value of -d
+(\[en]display) to \[lq]SDL\[rq] to select using SDL instead of X
+Windows.
+.PP
 This flag is ignored on the Windows/Cygwin platform and when the --vnc
 flag is set on Windows System for Linux.
+.RE
 .TP
 -v [+ | -] , --vnc [+ | -]\ \ \ \ ** \f[B]Applicable only to WSL installations\f[R] **
 If value is \[lq]+\[rq] or no value is given, then use a VNC window
 running on the Windows side instead of an X window.
 If value is \[lq]-\[rq], then do not use a VNC window, relying instead
 on a standard X Window.
+.RS
+.PP
 A VNC window will folllow the Windows desktop scaling setting allowing
 for much more usable Medley on high resolution displays.
 On WSL, X windows do not scale well.
+.PP
 This flag is always set for WSL1 installations.
+.RE
 .TP
 -i [\f[I]ID_STRING\f[R] | - | --], --id [\f[I]ID_STRING\f[R] | - | --]
-Use ID_STRING as the id for this run of Medley, unless ID_STRING is
-\[lq]-\[rq], \[lq]--\[rq], or \[lq]---\[rq].
-If ID_STRING is \[lq]-\[rq], then reset the id to \[lq]default\[rq]
-(e.g., if it was previously set in the config file).
-If ID_STRING is \[lq]--\[rq], then use the basename of $MEDLEYDIR as the
-id.
-If ID_STRING is \[lq]---\[rq], then use the basename of the parent
-directory of $MEDLEYDIR as the id.
-Only one instance of Medley with a given id can run at a time.
-The id is used to distinguish the virtual memory stores so that multiple
-instances of Medley can run simultaneously.
+Use \f[I]ID_STRING\f[R] as the id for this run of Medley, unless the
+given value is \[lq]-\[rq], \[lq]--\[rq], or \[lq]---\[rq].
+.RS
+.PP
+Only one instance of Medley can be run simultaneously for any given id.
+.PP
+\f[I]ID-STRING\f[R] can consist of any alphanumeric character plus the
+underscore (_) character, ending (optionally) in a \[lq]+\[rq]
+character.
+If \f[I]ID_STRING\f[R] ends with a \[lq]+\[rq] (including just a
+singleton \[lq]+\[rq]), then Medley will add a number to the id to make
+it unique among currently running Medley intsances.
+.PP
+If the given value is \[lq]-\[rq], then the id will be (re)set to
+\[lq]default\[rq] (e.g., if it was previously set in the config file).
+If it is \[lq]--\[rq], then id will be set to the basename of
+$MEDLEYDIR.
+If ID_STRING is \[lq]---\[rq], then id will be set to the basename of
+the parent directory of $MEDLEYDIR.
+.PP
 Default id is \[lq]default\[rq].
+.RE
 .TP
 -m [\f[I]N\f[R] | -], --mem [\f[I]N\f[R] | -]
 Set Medley to run in \f[I]N\f[R] MB of virtual memory.
 Defaults to 256MB.
+.PP
 If a value of \[lq]-\[rq] is given, resets to default value.
 .TP
 -p [\f[I]FILE\f[R] | -], --vmem [\f[I]FILE\f[R] | -]
-Use FILE as the Medley virtual memory (vmem) store.
-FILE must be writeable by the current user.
+Use \f[I]FILE\f[R] as the Medley virtual memory (vmem) store.
+\f[I]FILE\f[R] must be writeable by the current user.
+.RS
+.PP
 Care must be taken not to use the same vmem FILE for two instances of
 Medley running simultaneously.
 The --id flag will not protect against vmem collisions when the --vmem
 flag is used.
+.PP
 If the value \[lq]-\[rq] is given, then resets the vmem file to the
 default.
+.PP
 Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where
 III is the id of this Medley run (see --id flag above).
 See --logindir below for setting of LOGINDIR.
+.RE
 .TP
 -r [\f[I]FILE\f[R] | -], --greet [\f[I]FILE\f[R] | -]
-Use FILE as the Medley greetfile, unless FILE is \[lq]-\[rq] in which
-case Medley will start up without using a greetfile.
+Use \f[I]FILE\f[R] as the Medley greetfile.
+.RS
+.PP
+If the given value is \[lq]-\[rq], Medley will start up without using a
+greetfile.
+.PP
 The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT,
 except when the --apps flag is used in which case it is
 $MEDLEYDIR/greetfiles/APPS-INIT.
+.PP
 On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
 Medley file system, not the host Windows file system.
+.RE
 .TP
 -x [\f[I]DIR\f[R] | - | \[en]], --logindir [\f[I]DIR\f[R] | - | \[en]]
-Use DIR as LOGINDIR in Medley.
-If the value is \[lq]\[en]\[rq], use $MEDLEYDIR/logindir as LOGINDIR.
-If a value of \[lq]-\[rq] is given, then reset LOGINDIR to its default
-value.
-DIR (or $MEDLEYDIR/logindir) must be writeable by the current user.
-LOGINDIR defaults to $HOME/il.
+Use \f[I]DIR\f[R] as LOGINDIR in Medley.
+\f[I]DIR\f[R] must be writeable by the current user.
+.RS
+.PP
 LOGINDIR is used by Medley as the working directory on start-up and
 where it loads any \[lq]personal\[rq] initialization file from.
+.PP
+If the given value is \[lq]-\[rq], then reset LOGINDIR to its default
+value.
+If the given value is \[lq]\[en]\[rq], uses $MEDLEYDIR/logindir as
+LOGINDIR.
+.PP
+LOGINDIR defaults to $HOME/il.
+.PP
 On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
 Medley file system, not the host Windows file system.
+.RE
 .TP
 -nh \f[I]Host:Port:Mac:Debug\f[R], --nethub \f[I]Host:Port:Mac:Debug\f[R]
 Set the parameters for using Nethub XNS networking.
@@ -232,10 +322,13 @@ A \f[I]Host\f[R] value is required and serves to turn nethub
 functionality on.
 \f[I]Port\f[R], \f[I]Mac\f[R] and \f[I]Debug\f[R] parameters are
 optional and will default if left off.
-Finally, if any of the parameters have a value of \[lq]-\[rq], any
-previous setting (e.g., in a config file) for the parameter will be
-reset to the default value - which in the case of \f[I]Host\f[R] is the
-null string, turning nethub functionality off.
+.RS
+.PP
+If any of the parameters have a value of \[lq]-\[rq], any previous
+setting (e.g., in a config file) for the parameter will be reset to the
+default value - which in the case of \f[I]Host\f[R] is the null string,
+turning nethub functionality off.
+.RE
 .TP
 -nf, -NF, \[en]nofork
 No fork.

docs/man-page/medley.1.md

@@ -42,131 +42,195 @@ Flags
 : Show the man page for medley
 
 -c [*FILE* | -], \-\-config [*FILE* | -]
-: Use *FILE* as the config file for this run of Medley. See information on *CONFIG FILE* below.  If *FILE* is "-",
+: Use *FILE* as the config file for this run of Medley. See information on *CONFIG FILE* below.
+
+    If the given value is "-",
 then suppress the use of a config file for this run of Medley. 
 
 -f, \-\-full
 : Start Medley from the standard "full" sysout. full.sysout includes a complete Interlisp and CommonLisp environment
 with a standard set of development tools.  It does not include any of the applications built using Medley.
-(See *SYSOUT_FILE* below for more information on starting sysouts.)
+
+    (See *SYSOUT_FILE* below for more information on starting sysouts.)
 
 -l, \-\-lisp
 : Start Medley from the standard "lisp" sysout.  lisp.sysout only includes the basic Interlisp and
 CommonLisp environment.
-(See *SYSOUT_FILE* below for more information on starting sysouts.)
+
+    (See *SYSOUT_FILE* below for more information on starting sysouts.)
 
 -a, \-\-apps
 : Start Medley from the standard "apps" sysout.  apps.sysout includes everything in full.sysout plus Medley
 applications including Notecards, Rooms and CLOS.  It also includes pre-installed links to key Medley
 documentation.
-(See *SYSOUT_FILE* below for more information on starting sysouts.)
+
+    (See *SYSOUT_FILE* below for more information on starting sysouts.)
 
 -u, \-\-continue
 :  Nullify any prior setting of the sysout file (e.g., from the config file) - causing Medley to start from
 the virtual memory file resulting from the previous invocation (with the same values for --id and --logindir),
 if any.  If there is no matching virtual memory file, Medley will start from the full.sysout (see -f/--full above).
-Equivalent to "-y -".  (See *SYSOUT FILE* section below.) 
+
+    Equivalent to "-y -".
+
+    (See *SYSOUT FILE* section below.) 
 
 -y [*SYSOUT_FILE* | -], \-\-sysout [*SYSOUT-FILE* | -]
 : Start Medley from the specified *SYSOUT-FILE*.  This is an alternative to specifying the *SYSOUT-FILE*
 as the last argument on the command line (but before any *PASS_ON_ARGS*).  It can be used to specify the
-*SYSOUT-FILE* in the config file (see information on *CONFIG FILE* below). If *SYSOUT-FILE* is "-", then
+*SYSOUT-FILE* in the config file (see information on *CONFIG FILE* below). 
+
+    If the given value is "-", then
 any prior setting of the sysout file (e.g., from the config file) is nullified (see -u/--continue above).
-(See *SYSOUT FILE* section below.) 
+
+    (See *SYSOUT FILE* section below.) 
 
 -e [+ | -], \-\-interlisp [+ | -]
 : If value is "+" or no value, make the initial Exec window within Medley be an Interlisp Exec.
 If value is "-", make the initial Exec window be the default XCL Exec.
-This flag applies only when the --apps flag is used.
+
+    This flag applies only when the --apps flag is used.
 
 -n [+ | -], \-\-noscroll [+ | -]
 : Medley ordinarily displays scroll bars to enable the user to pan the Medley virtual display within the
-Medley window.  This is true even when the entire virtual display fits within the window.  Specifying
+Medley window.  This is true even when the entire virtual display fits within the window.
+
+    Specifying
 "-n +" (--noscroll +) turns off scroll bars.  Specifying "-n -" (--scroll -) turns on scroll bars.
-Specifying -n (--noscroll) with no value is equivalent to specifying "--noscroll +".  Default
-is scroll bars off. Note: If scroll bars are off and the virtual screen is larger
+Specifying -n (--noscroll) with no value is equivalent to specifying "--noscroll +".
+
+    Default is scroll bars off. 
+
+    Note: If scroll bars are off and the virtual screen is larger
 than the window, there will be no way to pan to the non-visible parts of the virtual display.
 
 -g [*WxH* | -], \-\-geometry [*WxH* | -]
 : Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows
 geomtery specification with +X+Y is not currently supported).
-If a value of "-" is given, geometry is set to the default value.
-If \-\-geometry is not specified but \-\-screensize is,
+
+    If a value of "-" is given, geometry is set to the default value.
+
+    If \-\-geometry is not specified but \-\-screensize is,
 then the window size will be determined based on the \-\-screensize values and the \-\-noscroll flag.  If neither
 \-\-geometry nor \-\-screensize is provided, then the window size is set to 1440x900 if \-\-noscroll is set and 1462x922
-if \-\-noscroll is not set.  (Also see note below under *CONFIG FILE* on the use of geometry and screensize
+if \-\-noscroll is not set.
+
+    (Also see note below under *CONFIG FILE* on the use of geometry and screensize
 in config files.)
 
 -s [*WxH* | -], \-\-screensize [*WxH* | -]
-: Sets the size of the virtual display as seen from Medley's point of view.
-If a value of "-" is given, screensize is set to the default value.
-The Medley window is an unscaled viewport onto this virtual display. If \-\-screensize is not specified but
+: Sets the size of the virtual display as seen from Medley's point of view. The Medley window is an unscaled viewport onto this virtual display. 
+
+    If a value of "-" is given, screensize is set to the default value.
+
+    If \-\-screensize is not specified but
 \-\-geometry is, then the virtual display size will be set so that the entire virtual display fits into the given
 window geometry.  If neither \-\-screensize nor \-\-geometry is provided, then the screen size is set to 1440x900.
-(Also see note below under *CONFIG FILE* on the use of geometry and screensize in config files.)
+
+    (Also see note below under *CONFIG FILE* on the use of geometry and screensize in config files.)
 
 -ps [*N* | -], --pixelscale [*N* | -]    \*\* **Applicable only when display is SDL-based (e.g., on Windows/Cygwin)** \*\*
-: Sets the pixel scaling factor to *N*. If value of "-" is given, the pixel scale factor is set to its default of 1.
+: Sets the pixel scaling factor to *N*, an integer
+
+    If value of "-" is given, the pixel scale factor is set to its default of 1.
 
 -t [*STRING* | -], \-\-title [*STRING* | -]
-: Use STRING as title of Medley window.  If the value of "-" is given, sets the title to its default value ("Medley Interlisp").
-Ignored when when the \-\-vnc flag is set.
+: Use *STRING* as title of Medley window.
+
+    If *STRING* includes the character sequence "%i", then the value of the id string (see --id flag below)
+prefixed by ":: " will be substituited for the "%i".  Example: if the id is "run_45" and *STRING* is "Medley Interlisp %i", then the actual window
+title will be "Medley Interlisp :: run_45". 
+
+    If the value of "-" is given, sets the title to its default value ("Medley Interlisp %i").
+
+    This flag is ignored when when the \-\-vnc flag is set.
 
 -d [*:N* | -], \-\-display [*:N* | -]
-: Use X display :N.  If value is "-", reset display to its default value. Default value is the value of $DISPLAY. 
-On platforms that support X Windows as well as SDL, the value of -d (--display) should
-be set to "SDL" to select using SDL instead of X Windows.  This flag is ignored on the Windows/Cygwin platform and when the \-\-vnc flag is
+: Use X display *:N*.
+
+    If value is "-", reset display to its default value. Default value is the value of $DISPLAY.
+ 
+    On platforms that support both SDL and X Windows, set the value of -d (--display) to "SDL" to select using SDL instead of X Windows.  
+
+    This flag is ignored on the Windows/Cygwin platform and when the \-\-vnc flag is
 set on Windows System for Linux.
 
 -v [+ | -] , \-\-vnc [+ | -]    \*\* **Applicable only to WSL installations** \*\*
 : If value is "+" or no value is given, then use a VNC window running on the Windows side instead of an X window.  If value is "-", then do not
 use a VNC window, relying instead on a standard X Window.
-A VNC window will folllow the Windows desktop scaling setting allowing
+
+    A VNC window will folllow the Windows desktop scaling setting allowing
 for much more usable Medley on high resolution displays.  On WSL, X windows
-do not scale well.  This flag is always set for WSL1 installations.
+do not scale well.
+
+    This flag is always set for WSL1 installations.
 
 -i [*ID_STRING* | - | \-\-], \-\-id [*ID_STRING* | - | \-\-]
-: Use ID_STRING as the id for this run of Medley, unless ID_STRING is "-", "\-\-", or "\-\-\-". 
-If ID_STRING is "-", then reset the id to "default" (e.g., if it was previously set in the
-config file).  If ID_STRING is "\-\-", then use the basename of $MEDLEYDIR as the id.
-If ID_STRING is "\-\-\-", then use the basename of the parent directory of $MEDLEYDIR as the id.
-Only one instance of Medley with a given id can run at a time.
-The id is used to distinguish the virtual memory stores so that multiple
-instances of Medley can run simultaneously.  Default id is "default".
+: Use *ID_STRING* as the id for this run of Medley, unless the given value is "-", "\-\-", or "\-\-\-".
+
+    Only one instance of Medley can be run simultaneously for any given id.
+
+    *ID-STRING* can consist of any alphanumeric
+character plus the underscore (_) character, ending (optionally) in a "+" character.  If *ID_STRING* ends with a "+"
+(including just a singleton "+"),
+then Medley will add a number to the id to make it unique among currently running Medley intsances.
+
+    If the given value is "-", then the id will be (re)set to "default" (e.g., if it was previously set in the
+config file).  If it is "\-\-", then id will be set to the basename of $MEDLEYDIR.
+If ID_STRING is "\-\-\-", then id will be set to the basename of the parent directory of $MEDLEYDIR.
+
+    Default id is "default".
 
 -m [*N* | -], \-\-mem [*N* | -]
-: Set Medley to run in *N* MB of virtual memory.  Defaults to 256MB. If a value of "-" is given, resets
+: Set Medley to run in *N* MB of virtual memory.  Defaults to 256MB.
+
+   If a value of "-" is given, resets
 to default value.
 
 -p [*FILE* | -], \-\-vmem [*FILE* | -]
-: Use FILE as the Medley virtual memory (vmem) store.  FILE must be writeable by the current user.
-Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously.
+: Use *FILE* as the Medley virtual memory (vmem) store.  *FILE* must be writeable by the current user.
+
+    Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously.
 The \-\-id flag will not protect against vmem collisions when the \-\-vmem flag is used.
-If the value "-" is given, then resets the vmem file to the default.
-Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where III is the id of this
+
+    If the value "-" is given, then resets the vmem file to the default.
+
+    Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where III is the id of this
 Medley run (see \-\-id flag above).  See \-\-logindir below for setting of LOGINDIR. 
 
 -r \[*FILE* | -], \-\-greet \[*FILE* | -]
-: Use FILE as the Medley greetfile, unless FILE is "-" in which case
-Medley will start up without using a greetfile. The default Medley greetfile
+: Use *FILE* as the Medley greetfile.
+
+    If the given value is "-",  Medley will start up without using a greetfile.
+
+    The default Medley greetfile
 is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the \-\-apps flag is used
-in which case it is $MEDLEYDIR/greetfiles/APPS-INIT. On Windows/Cygwin installations, *FILE* is
+in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.
+
+    On Windows/Cygwin installations, *FILE* is
 specified in the Medley file system, not the host Windows file system.
 
 -x \[*DIR* | - | --], \-\-logindir \[*DIR* | - | --]
-: Use DIR as LOGINDIR in Medley.  If the value is "--", use
-\$MEDLEYDIR/logindir as LOGINDIR.
-If a value of "-" is given, then reset LOGINDIR to its default value.
-DIR (or \$MEDLEYDIR/logindir) must be writeable by the current user.
-LOGINDIR defaults to \$HOME/il.  LOGINDIR is used by Medley as the working directory on start-up
-and where it loads any "personal" initialization file from. On Windows/Cygwin installations, *FILE* is
+: Use *DIR* as LOGINDIR in Medley.  *DIR* must be writeable by the current user.
+
+    LOGINDIR is used by Medley as the working directory on start-up
+and where it loads any "personal" initialization file from. 
+
+    If the given value is "-", then reset LOGINDIR to its default value.
+If the given value is "--", uses \$MEDLEYDIR/logindir as LOGINDIR.
+
+    LOGINDIR defaults to \$HOME/il.
+
+    On Windows/Cygwin installations, *FILE* is
 specified in the Medley file system, not the host Windows file system.
 
 -nh *Host:Port:Mac:Debug*, \-\-nethub *Host:Port:Mac:Debug*
 : Set the parameters for using Nethub XNS networking.  *Host* is the full domain name of the nethub host.  *Port* is the port on *Host* that nethub is using.
 *Mac* is the Mac address that this instance of Medley should use when contacting the nethub host.  *Debug* is the level of nethub debug information 
 that should be printed on stdout (value is 0, 1, or 2).  A *Host* value is required and serves to turn nethub functionality on.  *Port*, *Mac* and *Debug*
-parameters are optional and will default if left off.  Finally, if any of the parameters have a value of "-", any previous setting (e.g., in a config file)
+parameters are optional and will default if left off.
+
+    If any of the parameters have a value of "-", any previous setting (e.g., in a config file)
 for the parameter will be reset to the default value - which in the case of *Host* is the null string, turning nethub functionality off.
 
 -nf, -NF, --nofork

doctools/IMTEDIT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4
 116622 
+
(FILECREATED "12-Apr-2024 19:58:59" {WMEDLEY}<doctools>IMTEDIT.;5
 117369 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TRANSLATE.DUMPOUT MAKE.IM.DOCUMENT)
+      :CHANGES-TO (FNS MAKE.IM.DOCUMENT)
 
-      :PREVIOUS-DATE "20-Jul-2022 15:10:53" {WMEDLEY}<doctools>IMTEDIT.;2)
+      :PREVIOUS-DATE " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4)
 
 
 (PRETTYCOMPRINT IMTEDITCOMS)
@@ -15,16 +15,17 @@
        ((FNS IM.TEDIT DUMP DUMP.HEADERS.FOOTERS DUMP.HRULE CHANGE.FONT IM.BOUT.IMAGEOBJ 
              IM.TEDIT.DUMP.COMMANDS IM.TEDIT.DUMP.FOOTNOTES IM.TEDIT.DUMP.PARA INDEXX.PARSE.TYPE 
              FORMAT.DEF FORMAT.LISPWORD MAKE.IM.DOCUMENT PRINT.NOTE SEND.INFO)
-        (COMS (* fns for drawing vrules to the left of definition text -- an unused, never-fully 
-                 debuged feature)
+        (COMS                                                (* ; 
+
    "fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature")

               (FNS IM.VRULE.DISPLAYFN CREATE.VRULE.OBJECT PRINT.VRULES.ON.PAGE)
               (VARS (IM.VRULE.STATE.LIST))
               (INITVARS (IM.VRULE.OBJECT.IMAGEFNS NIL)
                      (IM.PRINT.VRULE.FLG NIL)))
-        (COMS (* fns for printing page numbers)
+        (COMS                                                (* ; "fns for printing page numbers")

               (FNS IM.FOLIO.DISPLAYFN IM.FOLIO.SIZEFN CREATE.FOLIO.OBJECT GET.FOLIO.STRING)
               (INITVARS (IM.FOLIO.OBJECT.IMAGEFNS NIL)))
-        (COMS (* TOPROG functions, used to define the translating actions of IM text objects.)
+        (COMS                                                (* ; 
+
                       "TOPROG functions, used to define the translating actions of IM text objects.")

               (FNS ARG#TOPROG BIGLISPCODE#TOPROG BRACKET#TOPROG CHAPTER#TOPROG COMMENT#TOPROG 
                    DEF#TOPROG FIGURE#TOPROG FN#TOPROG FNDEF#TOPROG FOOT#TOPROG INCLUDE#TOPROG 
                    INDEX#TOPROG INDEXX#TOPROG IT#TOPROG LBRACKET#TOPROG LISP#TOPROG LISPCODE#TOPROG 
@@ -54,104 +55,112 @@
                (IM.TEXT.FONT '(FAMILY MODERN FACE MRR SIZE 10))
                (IM.HEADER.FOOTER.FONT '(FAMILY MODERN FACE MRR SIZE 8))
                (IM.XEROX.LOGO.FONT '(FAMILY MODERN FACE BRR SIZE 30]
-        (COMS (* the following variables specify all of the lengths used for possitioning IM text, 
-                 headers, etc. on the page. All of these are measured with respect to the page 
-                 *margins* <the region on the page defined by the Tedit margin parameters> or with 
-                 respect to the page *edges* <the edges of the physical page>.)
-              (* Note%: The formatting and printing does not always position the image on the page 
-                 exactly as specified. It will probably be necessary to adjust any variables based on
-                 the page edges until they come out correctly on your printer.)
-              (* indentation of 1st line of definitian header, measured in points from left page 
-                 margin. Also used for indentation of hrule under defn header.)
+        (COMS 
+              (* ;; "the following variables specify all of the lengths used for possitioning IM text, headers, etc.  on the page.  All of these are measured with respect to the page *margins* <the region on the page defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>.")

+
+              
+              (* ;; "Note: The formatting and printing does not always position the image on the page exactly as specified.  It will probably be necessary to adjust any variables based on the page edges until they come out correctly on your printer.")

+
+              
+              (* ;; "indentation of 1st line of definitian header, measured in points from left page margin.  Also used for indentation of hrule under defn header.")

+
               (INITVARS (IM.DEF.TITLE.1STLEFTMARGIN 75))
-              (* indentation of 2nd and other overflow lines of definition header, measured in points
-                 from left page margin.)
+              
+              (* ;; "indentation of 2nd and other overflow lines of definition header, measured in points from left page margin.")

+
               (INITVARS (IM.DEF.TITLE.LEFTMARGIN 204))
-              (* indentation of vertical rule to the left of definition text, measured in points from
-                 left page margin. This is a never-used, never-debugged feature.)
+              
+              (* ;; "indentation of vertical rule to the left of definition text, measured in points from left page margin.  This is a never-used, never-debugged feature.")

+
               (INITVARS (IM.VRULE.X 194))
-              (* y-pos of top-left corner of top text line, measured in points from bottom page edge.
-                 )
+                                                             (* ; 
+
               "y-pos of top-left corner of top text line, measured in points from bottom page edge.")

               (INITVARS (IM.TEXT.TOPMARGIN 738))
-              (* y-pos of bottom-left corner of bottom text line, measured in points from bottom page
-                 edge.)
+                                                             (* ; 
+
         "y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.")

               (INITVARS (IM.TEXT.BOTTOMMARGIN 54))
-              (* x-pos of left edge of text, measured in points from the left page margin.)
+                                                             (* ; 
+
                          "x-pos of left edge of text, measured in points from the left page margin.")

               (INITVARS (IM.TEXT.LEFTMARGIN 204))
-              (* x-pos of right edge of text, measured in points from the left page margin.)
+                                                             (* ; 
+
                         "x-pos of right edge of text, measured in points from the left page margin.")

               (INITVARS (IM.TEXT.RIGHTMARGIN 504))
-              (* X-pos and Y-pos of the lower-left corner of the 
-                 "[This page intentionally left blank]" message printed on blank pages, measured in 
-                 points from the left and bottom page edges.)
+              
+              (* ;; "X-pos and Y-pos of the lower-left corner of the '[This page intentionally left blank]' message printed on blank pages, measured in points from the left and bottom page edges.")

+
               (INITVARS (IM.BLANKPAGE.SPECIALX 258)
                      (IM.BLANKPAGE.SPECIALY 400))
-              (* In the table of contents, indentation of first and second-level subsection headers,
-                 measured in points from the left page margin.)
+              
+              (* ;; "In the table of contents, indentation of first and second-level subsection headers, measured in points from the left page margin.")

+
               (INITVARS (IM.TOC.SUBSEC.ONE.LEFTMARGIN 120)
                      (IM.TOC.SUBSEC.TWO.LEFTMARGIN 216))
-              (* in the index, the indentation of the first line and remaining lines of a top-level 
-                 entry, of a subentry, and of a subsubentry, measured in points from the left page 
-                 margin <for the left column>.)
+              
+              (* ;; "in the index, the indentation of the first line and remaining lines of a top-level entry, of a subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.")

+
               (INITVARS (IM.INDEX.1STLEFTMARGIN 0)
                      (IM.INDEX.LEFTMARGIN 75)
                      (IM.INDEX.SUB.1STLEFTMARGIN 25)
                      (IM.INDEX.SUB.LEFTMARGIN 75)
                      (IM.INDEX.SUBSUB.1STLEFTMARGIN 50)
                      (IM.INDEX.SUBSUB.LEFTMARGIN 75))
-              (* on the title page, the y-pos of the lower-left corner of the first line in the title
-                 <and of the XEROX logo>, measured in points from the bottom page margin. The X-pos 
-                 is always 0 for the XEROX logo, and the normal text indentation for the title.)
+              
+              (* ;; "on the title page, the y-pos of the lower-left corner of the first line in the title <and of the XEROX logo>, measured in points from the bottom page margin.  The X-pos is always 0 for the XEROX logo, and the normal text indentation for the title.")

+
               (INITVARS (IM.TITLEPAGE.TITLE.Y 258))
-              (* on the title page, the y-pos of the lower-left corner of the first line in the 
-                 document number, measured in points from the bottom page margin. The Y-pos is always
-                 the normal text indentation.)
+              
+              (* ;; "on the title page, the y-pos of the lower-left corner of the first line in the document number, measured in points from the bottom page margin.  The Y-pos is always the normal text indentation.")

+
               (INITVARS (IM.TITLEPAGE.DOCNUMBER.Y 45))
-              (* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the 
-                 indentation of the title after the subsec number, measured in points from the left 
-                 page margin. "18" is the tab used if the subsec number is wider than 40 pts.)
+              
+              (* ;; "Tedit tab setting used for subsection heading text.  '(40 . LEFT)' determines the indentation of the title after the subsec number, measured in points from the left page margin.  '18' is the tab used if the subsec number is wider than 40 pts.")

+
               [INITVARS (IM.SUBSEC.TITLE.TABS '(18 (40 . LEFT]
-              (* Tedit tab setting used for chapter titles, headers, and footers to right-justify 
-                 text. "(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, 
-                 measured in points from the left page margin.)
+              
+              (* ;; "Tedit tab setting used for chapter titles, headers, and footers to right-justify text.  '(504 . RIGHT)' specifies a right tab at the right-hand edge of the text, measured in points from the left page margin.")

+
               [INITVARS (IM.RIGHT.MARGIN.TABS '(0 (504 . RIGHT]
-              (* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. 
-                 "(186 . RIGHT)" right-justifies the label on the left of the center space. 
-                 "(204 . LEFT)" starts the first line of the list item with the same indentation as 
-                 normal text. Both measurements are measured in points from the left page margin.)
+              
+              (* ;; "Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists.  '(186 . RIGHT)' right-justifies the label on the left of the center space.  '(204 . LEFT)' starts the first line of the list item with the same indentation as normal text.  Both measurements are measured in points from the left page margin.")

+
               [INITVARS (IM.LABELED.LIST.TABS '(18 (186 . RIGHT)
                                                    (204 . LEFT]
-              (* left, right, top, and bottom margins of the "page region" %, measured in points from
-                 the four edges of the page.)
+              
+              (* ;; "left, right, top, and bottom margins of the 'page region' , measured in points from the four edges of the page.")

+
               (INITVARS (IM.PAGE.LEFTMARGIN 58)
                      (IM.PAGE.RIGHTMARGIN 54)
                      (IM.PAGE.TOPMARGIN 54)
                      (IM.PAGE.BOTTOMMARGIN 54))
-              (* top margin of the page region for the first page of a chapter <where the first 
-                 paragraph is the chapter title>, measured in points from the top page edge.)
+              
+              (* ;; "top margin of the page region for the first page of a chapter <where the first paragraph is the chapter title>, measured in points from the top page edge.")

+
               (INITVARS (IM.PAGE.FIRST.TOPMARGIN 12))
-              (* top margin of the page region for the first page of the index, measured in points 
-                 from the top page edge. Note that in the case of the index, because it uses two 
-                 columns, the index title is implemented as a Tedit header, instead of as the first 
-                 paragraph of the document.)
+              
+              (* ;; "top margin of the page region for the first page of the index, measured in points from the top page edge.  Note that in the case of the index, because it uses two columns, the index title is implemented as a Tedit header, instead of as the first paragraph of the document.")

+
               (INITVARS (IM.INDEX.PAGE.FIRST.TOPMARGIN 144))
-              (* y-pos of lower-left corner of footer text, measured in points from the bottom page 
-                 edge.)
+                                                             (* ; 
+
           "y-pos of lower-left corner of footer text, measured in points from the bottom page edge.")

               (INITVARS (IM.FOOTER.Y 22))
-              (* y-pos of the footer hrule, measured in points from the bottom page edge.)
+                                                             (* ; 
+
                           "y-pos of the footer hrule, measured in points from the bottom page edge.")

               (INITVARS (IM.FOOTER.RULE.Y 30))
-              (* y-pos of lower-left corner of header text, measured in points from the bottom page 
-                 edge.)
+                                                             (* ; 
+
           "y-pos of lower-left corner of header text, measured in points from the bottom page edge.")

               (INITVARS (IM.HEADER.Y 761))
-              (* y-pos of the header hrule, measured in points from the bottom page edge.)
+                                                             (* ; 
+
                           "y-pos of the header hrule, measured in points from the bottom page edge.")

               (INITVARS (IM.HEADER.RULE.Y 757))
-              (* y-pos of lower-left corner of bottom draft message, measured in points from the 
-                 bottom page edge.)
+                                                             (* ; 
+
  "y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.")

               (INITVARS (IM.DRAFT.MESSAGE.BOTTOM.Y 5))
-              (* y-pos of lower-left corner of top draft message, measured in points from the bottom
-                 page edge.)
+                                                             (* ; 
+
     "y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.")

               (INITVARS (IM.DRAFT.MESSAGE.TOP.Y 775))
-              (* x-pos of lower-left corner of both top and bottom draft messages, measured in points
-                 from the left page edge.)
+              
+              (* ;; "x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left page edge.")

+
               (INITVARS (IM.DRAFT.MESSAGE.X 200)))
         (FILES TEDIT IMTRAN HRULE IMINDEX)
         (FNS TRANSLATE.DUMPOUT TRANSLATE.SAVE.DUMPOUT)
@@ -491,6 +500,8 @@
 (MAKE.IM.DOCUMENT

   [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
 
+    (* ;; "Edited 12-Apr-2024 19:58 by rmk")

+
     (* ;; "Edited  6-Mar-2024 21:17 by rmk: Fixed backquote commas. Also put IM.INDEX.CLOSEF calls in TEXTPROPs so advice in IMINDEX can be eliminated.")

 
     (* ;; "Edited 20-Jul-2022 15:10 by rmk")

@@ -506,9 +517,7 @@
 
 (* ;;; "PTRFILENAME is the name to be used if an index pointer file is generated during hardcopy <by printing index objects>")

 
-    (PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME 
-                                                               AFTERHARDCOPYFN (FUNCTION 
-                                                                                IM.INDEX.INIT]
+    (PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME]
            (FONT.STACK (CONS))
            (IM.TEDIT.LAST.PARA.BEGIN 1)
            (IM.TEDIT.LAST.FONT.BEGIN 1)
@@ -650,7 +659,8 @@
 
 
 
-(* fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature)

+(* ; "fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature"
+)

 
 (DEFINEQ
 
@@ -735,7 +745,7 @@
 
 
 
-(* fns for printing page numbers)

+(* ; "fns for printing page numbers")

 
 (DEFINEQ
 
@@ -831,7 +841,7 @@
 
 
 
-(* TOPROG functions, used to define the translating actions of IM text objects.)

+(* ; "TOPROG functions, used to define the translating actions of IM text objects.")

 
 (DEFINEQ
 
@@ -2062,75 +2072,78 @@
 
 
 
-(* the following variables specify all of the lengths used for possitioning IM text, headers, etc. on 
-the page. All of these are measured with respect to the page *margins* <the region on the page defined
- by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>.
+(* ;; 
+"the following variables specify all of the lengths used for possitioning IM text, headers, etc.  on the page.  All of these are measured with respect to the page *margins* <the region on the page defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>."
 )

 
 
 
 
-(* Note%: The formatting and printing does not always position the image on the page exactly as 
-specified. It will probably be necessary to adjust any variables based on the page edges until they 
-come out correctly on your printer.)

+(* ;; 
+"Note: The formatting and printing does not always position the image on the page exactly as specified.  It will probably be necessary to adjust any variables based on the page edges until they come out correctly on your printer."
+)

 
 
 
 
-(* indentation of 1st line of definitian header, measured in points from left page margin. Also used 
-for indentation of hrule under defn header.)

+(* ;; 
+"indentation of 1st line of definitian header, measured in points from left page margin.  Also used for indentation of hrule under defn header."
+)

 
 
 (RPAQ? IM.DEF.TITLE.1STLEFTMARGIN
 75)
 
 
 
-(* indentation of 2nd and other overflow lines of definition header, measured in points from left page
- margin.)

+(* ;; 
+"indentation of 2nd and other overflow lines of definition header, measured in points from left page margin."
+)

 
 
 (RPAQ? IM.DEF.TITLE.LEFTMARGIN
 204)
 
 
 
-(* indentation of vertical rule to the left of definition text, measured in points from left page 
-margin. This is a never-used, never-debugged feature.)

+(* ;; 
+"indentation of vertical rule to the left of definition text, measured in points from left page margin.  This is a never-used, never-debugged feature."
+)

 
 
 (RPAQ? IM.VRULE.X
 194)
 
 
 
-(* y-pos of top-left corner of top text line, measured in points from bottom page edge.)

+(* ; "y-pos of top-left corner of top text line, measured in points from bottom page edge.")

 
 
 (RPAQ? IM.TEXT.TOPMARGIN
 738)
 
 
 
-(* y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.)

+(* ; "y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.")

 
 
 (RPAQ? IM.TEXT.BOTTOMMARGIN
 54)
 
 
 
-(* x-pos of left edge of text, measured in points from the left page margin.)

+(* ; "x-pos of left edge of text, measured in points from the left page margin.")

 
 
 (RPAQ? IM.TEXT.LEFTMARGIN
 204)
 
 
 
-(* x-pos of right edge of text, measured in points from the left page margin.)

+(* ; "x-pos of right edge of text, measured in points from the left page margin.")

 
 
 (RPAQ? IM.TEXT.RIGHTMARGIN
 504)
 
 
 
-(* X-pos and Y-pos of the lower-left corner of the "[This page intentionally left blank]" message 
-printed on blank pages, measured in points from the left and bottom page edges.)

+(* ;; 
+"X-pos and Y-pos of the lower-left corner of the '[This page intentionally left blank]' message printed on blank pages, measured in points from the left and bottom page edges."
+)

 
 
 (RPAQ? IM.BLANKPAGE.SPECIALX
 258)
@@ -2139,8 +2152,9 @@ printed on blank pages, measured in points from the left and bottom page edges.)
 
 
 
-(* In the table of contents, indentation of first and second-level subsection headers, measured in 
-points from the left page margin.)

+(* ;; 
+"In the table of contents, indentation of first and second-level subsection headers, measured in points from the left page margin."
+)

 
 
 (RPAQ? IM.TOC.SUBSEC.ONE.LEFTMARGIN
 120)
@@ -2149,8 +2163,9 @@ points from the left page margin.)

 
 
 
-(* in the index, the indentation of the first line and remaining lines of a top-level entry, of a 
-subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.)

+(* ;; 
+"in the index, the indentation of the first line and remaining lines of a top-level entry, of a subentry, and of a subsubentry, measured in points from the left page margin <for the left column>."
+)

 
 
 (RPAQ? IM.INDEX.1STLEFTMARGIN
 0)
@@ -2167,45 +2182,45 @@ subentry, and of a subsubentry, measured in points from the left page margin <fo
 
 
 
-(* on the title page, the y-pos of the lower-left corner of the first line in the title <and of the 
-XEROX logo>, measured in points from the bottom page margin. The X-pos is always 0 for the XEROX logo,
- and the normal text indentation for the title.)

+(* ;; 
+"on the title page, the y-pos of the lower-left corner of the first line in the title <and of the XEROX logo>, measured in points from the bottom page margin.  The X-pos is always 0 for the XEROX logo, and the normal text indentation for the title."
+)

 
 
 (RPAQ? IM.TITLEPAGE.TITLE.Y
 258)
 
 
 
-(* on the title page, the y-pos of the lower-left corner of the first line in the document number, 
-measured in points from the bottom page margin. The Y-pos is always the normal text indentation.)

+(* ;; 
+"on the title page, the y-pos of the lower-left corner of the first line in the document number, measured in points from the bottom page margin.  The Y-pos is always the normal text indentation."
+)

 
 
 (RPAQ? IM.TITLEPAGE.DOCNUMBER.Y
 45)
 
 
 
-(* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the indentation of the
- title after the subsec number, measured in points from the left page margin. "18" is the tab used if 
-the subsec number is wider than 40 pts.)

+(* ;; 
+"Tedit tab setting used for subsection heading text.  '(40 . LEFT)' determines the indentation of the title after the subsec number, measured in points from the left page margin.  '18' is the tab used if the subsec number is wider than 40 pts."
+)

 
 
 (RPAQ? IM.SUBSEC.TITLE.TABS
 '(18 (40 . LEFT)))
 
 
 
-(* Tedit tab setting used for chapter titles, headers, and footers to right-justify text. 
-"(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, measured in points from the 
-left page margin.)

+(* ;; 
+"Tedit tab setting used for chapter titles, headers, and footers to right-justify text.  '(504 . RIGHT)' specifies a right tab at the right-hand edge of the text, measured in points from the left page margin."
+)

 
 
 (RPAQ? IM.RIGHT.MARGIN.TABS
 '(0 (504 . RIGHT)))
 
 
 
-(* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. "(186 . RIGHT)" 
-right-justifies the label on the left of the center space. "(204 . LEFT)" starts the first line of the
- list item with the same indentation as normal text. Both measurements are measured in points from the
- left page margin.)

+(* ;; 
+"Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists.  '(186 . RIGHT)' right-justifies the label on the left of the center space.  '(204 . LEFT)' starts the first line of the list item with the same indentation as normal text.  Both measurements are measured in points from the left page margin."
+)

 
 
 (RPAQ? IM.LABELED.LIST.TABS
 '(18 (186 . RIGHT)
@@ -2213,8 +2228,9 @@ right-justifies the label on the left of the center space. "(204 . LEFT)" starts
 
 
 
-(* left, right, top, and bottom margins of the "page region" %, measured in points from the four edges
- of the page.)

+(* ;; 
+"left, right, top, and bottom margins of the 'page region' , measured in points from the four edges of the page."
+)

 
 
 (RPAQ? IM.PAGE.LEFTMARGIN
 58)
@@ -2227,67 +2243,70 @@ right-justifies the label on the left of the center space. "(204 . LEFT)" starts
 
 
 
-(* top margin of the page region for the first page of a chapter <where the first paragraph is the 
-chapter title>, measured in points from the top page edge.)

+(* ;; 
+"top margin of the page region for the first page of a chapter <where the first paragraph is the chapter title>, measured in points from the top page edge."
+)

 
 
 (RPAQ? IM.PAGE.FIRST.TOPMARGIN
 12)
 
 
 
-(* top margin of the page region for the first page of the index, measured in points from the top page
- edge. Note that in the case of the index, because it uses two columns, the index title is implemented
- as a Tedit header, instead of as the first paragraph of the document.)

+(* ;; 
+"top margin of the page region for the first page of the index, measured in points from the top page edge.  Note that in the case of the index, because it uses two columns, the index title is implemented as a Tedit header, instead of as the first paragraph of the document."
+)

 
 
 (RPAQ? IM.INDEX.PAGE.FIRST.TOPMARGIN
 144)
 
 
 
-(* y-pos of lower-left corner of footer text, measured in points from the bottom page edge.)

+(* ; "y-pos of lower-left corner of footer text, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.FOOTER.Y
 22)
 
 
 
-(* y-pos of the footer hrule, measured in points from the bottom page edge.)

+(* ; "y-pos of the footer hrule, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.FOOTER.RULE.Y
 30)
 
 
 
-(* y-pos of lower-left corner of header text, measured in points from the bottom page edge.)

+(* ; "y-pos of lower-left corner of header text, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.HEADER.Y
 761)
 
 
 
-(* y-pos of the header hrule, measured in points from the bottom page edge.)

+(* ; "y-pos of the header hrule, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.HEADER.RULE.Y
 757)
 
 
 
-(* y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.)

+(* ; 
+"y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.DRAFT.MESSAGE.BOTTOM.Y
 5)
 
 
 
-(* y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.)

+(* ; "y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.DRAFT.MESSAGE.TOP.Y
 775)
 
 
 
-(* x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left 
-page edge.)

+(* ;; 
+"x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left page edge."
+)

 
 
 (RPAQ? IM.DRAFT.MESSAGE.X
 200)
@@ -2388,23 +2407,23 @@ page edge.)

 (PUTPROPS SAVE.DUMPOUT
 MACRO
 (X (TRANSLATE.SAVE.DUMPOUT
 X)))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10668 38115 (IM.TEDIT 10678 . 12359) (DUMP 12361 . 14656) (DUMP.HEADERS.FOOTERS 14658
- . 17024) (DUMP.HRULE 17026 . 18177) (CHANGE.FONT 18179 . 19373) (IM.BOUT.IMAGEOBJ 19375 . 19698) (
-IM.TEDIT.DUMP.COMMANDS 19700 . 23253) (IM.TEDIT.DUMP.FOOTNOTES 23255 . 23696) (IM.TEDIT.DUMP.PARA 
-23698 . 24472) (INDEXX.PARSE.TYPE 24474 . 25769) (FORMAT.DEF 25771 . 27902) (FORMAT.LISPWORD 27904 . 
-28055) (MAKE.IM.DOCUMENT 28057 . 36970) (PRINT.NOTE 36972 . 37186) (SEND.INFO 37188 . 38113)) (38224 
-42242 (IM.VRULE.DISPLAYFN 38234 . 38558) (CREATE.VRULE.OBJECT 38560 . 40340) (PRINT.VRULES.ON.PAGE 
-40342 . 42240)) (42400 47155 (IM.FOLIO.DISPLAYFN 42410 . 43088) (IM.FOLIO.SIZEFN 43090 . 43939) (
-CREATE.FOLIO.OBJECT 43941 . 45487) (GET.FOLIO.STRING 45489 . 47153)) (47287 93527 (ARG#TOPROG 47297 . 
-47436) (BIGLISPCODE#TOPROG 47438 . 48674) (BRACKET#TOPROG 48676 . 48840) (CHAPTER#TOPROG 48842 . 51523
-) (COMMENT#TOPROG 51525 . 52077) (DEF#TOPROG 52079 . 55414) (FIGURE#TOPROG 55416 . 56760) (FN#TOPROG 
-56762 . 57159) (FNDEF#TOPROG 57161 . 61053) (FOOT#TOPROG 61055 . 61596) (INCLUDE#TOPROG 61598 . 61913)
- (INDEX#TOPROG 61915 . 63005) (INDEXX#TOPROG 63007 . 65088) (IT#TOPROG 65090 . 65231) (LBRACKET#TOPROG
- 65233 . 65387) (LISP#TOPROG 65389 . 65530) (LISPCODE#TOPROG 65532 . 66651) (LISPWORD#TOPROG 66653 . 
-67393) (LIST#TOPROG 67395 . 71817) (MACDEF#TOPROG 71819 . 72997) (NOTE#TOPROG 72999 . 73679) (
-PRINT.SPECIAL.CHARS#TOPROG 73681 . 74658) (PROPDEF#TOPROG 74660 . 74937) (RBRACKET#TOPROG 74939 . 
-75093) (REF#TOPROG 75095 . 82934) (RM#TOPROG 82936 . 83074) (SUB#TOPROG 83076 . 83224) (SUBSEC#TOPROG 
-83226 . 87729) (SUPER#TOPROG 87731 . 87885) (TABLE#TOPROG 87887 . 91839) (TAG#TOPROG 91841 . 92108) (
-TERM#TOPROG 92110 . 92423) (VAR#TOPROG 92425 . 92828) (VARDEF#TOPROG 92830 . 93525)) (111173 116115 (
-TRANSLATE.DUMPOUT 111183 . 115714) (TRANSLATE.SAVE.DUMPOUT 115716 . 116113)))))
+  (FILEMAP (NIL (11391 38703 (IM.TEDIT 11401 . 13082) (DUMP 13084 . 15379) (DUMP.HEADERS.FOOTERS 15381
+ . 17747) (DUMP.HRULE 17749 . 18900) (CHANGE.FONT 18902 . 20096) (IM.BOUT.IMAGEOBJ 20098 . 20421) (
+IM.TEDIT.DUMP.COMMANDS 20423 . 23976) (IM.TEDIT.DUMP.FOOTNOTES 23978 . 24419) (IM.TEDIT.DUMP.PARA 
+24421 . 25195) (INDEXX.PARSE.TYPE 25197 . 26492) (FORMAT.DEF 26494 . 28625) (FORMAT.LISPWORD 28627 . 
+28778) (MAKE.IM.DOCUMENT 28780 . 37558) (PRINT.NOTE 37560 . 37774) (SEND.INFO 37776 . 38701)) (38817 
+42835 (IM.VRULE.DISPLAYFN 38827 . 39151) (CREATE.VRULE.OBJECT 39153 . 40933) (PRINT.VRULES.ON.PAGE 
+40935 . 42833)) (42997 47752 (IM.FOLIO.DISPLAYFN 43007 . 43685) (IM.FOLIO.SIZEFN 43687 . 44536) (
+CREATE.FOLIO.OBJECT 44538 . 46084) (GET.FOLIO.STRING 46086 . 47750)) (47888 94128 (ARG#TOPROG 47898 . 
+48037) (BIGLISPCODE#TOPROG 48039 . 49275) (BRACKET#TOPROG 49277 . 49441) (CHAPTER#TOPROG 49443 . 52124
+) (COMMENT#TOPROG 52126 . 52678) (DEF#TOPROG 52680 . 56015) (FIGURE#TOPROG 56017 . 57361) (FN#TOPROG 
+57363 . 57760) (FNDEF#TOPROG 57762 . 61654) (FOOT#TOPROG 61656 . 62197) (INCLUDE#TOPROG 62199 . 62514)
+ (INDEX#TOPROG 62516 . 63606) (INDEXX#TOPROG 63608 . 65689) (IT#TOPROG 65691 . 65832) (LBRACKET#TOPROG
+ 65834 . 65988) (LISP#TOPROG 65990 . 66131) (LISPCODE#TOPROG 66133 . 67252) (LISPWORD#TOPROG 67254 . 
+67994) (LIST#TOPROG 67996 . 72418) (MACDEF#TOPROG 72420 . 73598) (NOTE#TOPROG 73600 . 74280) (
+PRINT.SPECIAL.CHARS#TOPROG 74282 . 75259) (PROPDEF#TOPROG 75261 . 75538) (RBRACKET#TOPROG 75540 . 
+75694) (REF#TOPROG 75696 . 83535) (RM#TOPROG 83537 . 83675) (SUB#TOPROG 83677 . 83825) (SUBSEC#TOPROG 
+83827 . 88330) (SUPER#TOPROG 88332 . 88486) (TABLE#TOPROG 88488 . 92440) (TAG#TOPROG 92442 . 92709) (
+TERM#TOPROG 92711 . 93024) (VAR#TOPROG 93026 . 93429) (VARDEF#TOPROG 93431 . 94126)) (111920 116862 (
+TRANSLATE.DUMPOUT 111930 . 116461) (TRANSLATE.SAVE.DUMPOUT 116463 . 116860)))))
 STOP

installers/cygwin/makeflix.iss

@@ -1,128 +0,0 @@
-; -- makeflix.iss --
-; fgh 2016-08-19
-
-#define x86_or_x64 "x86"
-#define version "1.0.1"
-
-#if x86_or_x64 == "x86" 
-#define exe_dir "Win32"
-#else
-#define exe_dir "x64"
-#endif
-
-[Setup]
-ArchitecturesAllowed={#x86_or_x64}
-AppName=Makeflix
-AppVersion={#version}
-AppPublisher=Lellan, Inc.
-AppPublisherURL=http://www.lellan.com/
-AppCopyright=Copyright (C) 2012-2017 Lellan, Inc.
-DefaultDirName={pf}\Lellan\Makeflix
-DefaultGroupName=Lellan
-UninstallDisplayIcon={app}\makeflix.exe
-Compression=lzma2
-SolidCompression=yes
-; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
-; done in "64-bit mode" on x64, meaning it should use the native
-; 64-bit Program Files directory and the 64-bit view of the registry.
-ArchitecturesInstallIn64BitMode=x64
-; Source Dir is lellan/toolchain/makeflix/windows
-SourceDir="..\"
-OutputDir="deploy"
-OutputBaseFilename="makeflix_v{#version}_{#x86_or_x64}"
-SetupIconFile="..\images\Lellan_Logo_20130221.ico"
-LicenseFile="..\deploy\EULA.rtf"
-DisableWelcomePage=no
-
-[Files]
-Source: "makeflix\{#exe_dir}\Release\makeflix.exe"; DestDir: "{app}"; DestName: "makeflix.exe"; Flags: ignoreversion
-Source: "deploy\DLLs\{#x86_or_x64}\Qt5Core.dll"; DestDir: "{app}"; Flags: ignoreversion
-Source: "deploy\DLLs\{#x86_or_x64}\Qt5Gui.dll"; DestDir: "{app}"; Flags: ignoreversion
-Source: "deploy\DLLs\{#x86_or_x64}\Qt5Widgets.dll"; DestDir: "{app}"; Flags: ignoreversion
-Source: "deploy\DLLs\{#x86_or_x64}\Qt5Network.dll"; DestDir: "{app}"; Flags: ignoreversion
-Source: "deploy\DLLs\{#x86_or_x64}\platforms\qwindows.dll"; DestDir: "{app}\platforms"; Flags: ignoreversion
-Source: "deploy\gstreamer\{#x86_or_x64}\*"; DestDir: "{app}\gstreamer"; Flags: recursesubdirs ignoreversion
-Source: "deploy\vc_redist\vc_redist.{#x86_or_x64}.exe"; DestDir: "{tmp}"; Flags: deleteafterinstall 
-Source: "deploy\bonjour\Bonjour.{#x86_or_x64}.msi"; DestDir: "{tmp}" ; Flags: deleteafterinstall
-
-Source: "..\deploy\Makeflix_Open_Source_Libraries.pdf"; DestDir: "{app}"
-
-[Icons]
-Name: "{group}\Makeflix"; Filename: "{app}\makeflix.exe"
-Name: "{group}\Uninstall Makeflix"; Filename: "{uninstallexe}"
-
-
-[Run]
-#define VCmsg "Installing Microsoft Visual C++ Redistributable ..."
-Filename: "{tmp}\vc_redist{#x86_or_x64}.exe"; StatusMsg: "{#VCmsg}"; Check: not VCinstalled
-#define BonjourMsg "Installing Apple Bonjour support ..."
-Filename: "msiexec"; Parameters: "/i {tmp}\Bonjour.{#x86_or_x64}.msi"; StatusMsg: "{#BonjourMsg}"; Check: not BonjourInstalled
-
-[Registry]
-Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "(Default)"; ValueData: "{app}\makeflix.exe"; Flags: uninsdeletekey
-Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "Path"; ValueData: "{app}\gstreamer\bin"; Flags: uninsdeletekey
-
-[Code]
-function VCinstalled: Boolean;
- // By Michael Weiner <mailto:spam@cogit.net>
- // Function for Inno Setup Compiler
- // 13 November 2015
- // Modified by Frank G Halasz to handle WOW case
- // 23 August 2016
- // Returns True if Microsoft Visual C++ Redistributable is installed, otherwise False.
- // The programmer may set the year of redistributable to find; see below.
- var
-  names: TArrayOfString;
-  i: Integer;
-  dName, key, year, platfm: String;
- begin
-  // Year of redistributable to find; leave null to find installation for any year.
-  year := '2015';
-  Result := False;
-  if Is64BitInstallMode then
-    begin
-      platfm := 'x64'; 
-      key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
-    end
-  else if not IsWin64 then
-    begin
-      platfm := 'x86';
-      key := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
-    end
-  else
-    begin
-      platfm := 'x86';
-      key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
-    end;
-  // Get an array of all of the uninstall subkey names.
-  if RegGetSubkeyNames(HKEY_LOCAL_MACHINE, key, names) then
-   // Uninstall subkey names were found.
-   begin
-    i := 0
-    while ((i < GetArrayLength(names)) and (Result = False)) do
-     // The loop will end as soon as one instance of a Visual C++ redistributable is found.
-     begin
-      // For each uninstall subkey, look for a DisplayName value.
-      // If not found, then the subkey name will be used instead.
-      if not RegQueryStringValue(HKEY_LOCAL_MACHINE, key + '\' + names[i], 'DisplayName', dName) then
-       dName := names[i];
-      // See if the value contains both of the strings below.
-      Result := (Pos(Trim('Visual C++ ' + year),dName) * Pos('Redistributable',dName) * Pos(platfm, dName) <> 0)
-      i := i + 1;
-     end;
-   end;
- end;
-
- function BonjourInstalled: Boolean;
- // Returns True if Apple Bonjour is installed, otherwise False.
- // Ignores date/version of Bonjour.
- begin
-  Result := False;
-  // If this key exists, then
-  // bonjour services must already be installed
-  if RegKeyExists(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Services\Bonjour Service') then
-   // Uninstall subkey names were found.
-   begin
-     Result := True;
-   end;
- end;

installers/cygwin/medley.iss

@@ -68,7 +68,7 @@ Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
 ; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
 
 [Run]
-Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site http://www.gtlib.gatech.edu/pub/cygwin/ --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
+Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
 Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden
 Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\medley.tgz"; Flags: runhidden; StatusMsg: "Installing Medley ..."
 Filename: "powershell"; Parameters: "remove-item -force -recurse {app}\maiko"; Flags: runhidden; StatusMsg: "Installing Maiko ..."

library/BROWSER

@@ -1,16 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "26-Apr-2023 12:41:36" {DSK}<home>larry>il>medley>library>BROWSER.;6
 29801  
+
(FILECREATED "21-May-2024 18:46:31" {LIB}BROWSER.;2
 29502  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER 
-                       BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW 
-                       GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
-                       BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH)
-                  (VARS BROWSERCOMS BROWSER.BORDERS)
+      :CHANGES-TO (FNS BROWSER.LEFTFN)
 
-      :PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}<home>larry>il>medley>library>BROWSER.;1)
+      :PREVIOUS-DATE "26-Apr-2023 12:41:36" {LIB}BROWSER.;1)
 
 
 (PRETTYCOMPRINT BROWSERCOMS)
@@ -202,28 +198,29 @@
                 (RETURN ENTRY])
 
 (BROWSER.LEFTFN

-  [LAMBDA (NODE NWINDOW)
                                     (* ; "Edited 26-Apr-2023 12:41 by lmm")


+  [LAMBDA (NODE NWINDOW)
                                     (* ; "Edited 21-May-2024 18:40 by mth")


+                                                             (* ; "Edited 26-Apr-2023 12:41 by lmm")


                                                              (* ; "Edited 31-Mar-87 11:16 by jop")

                                                              (* ; 
 
                                                 "function that is applied upon selection of a node.")

     (PROG (FN SELECTION)
-          (IF
 (NULL NODE)
-              THEN
 (RETURN)
+          (if
 (NULL NODE)
+              then
 (RETURN)
                    (MOVEW NWINDOW)                           (* ; 
 
                                                       " really want to just drag the content around")

                    (RETURN))
-          (IF
 (NULL (SETQ FN (FETCH
 NODELABEL OF
 NODE)))
-              THEN
 (RETURN))
-          [SETQ SELECTION (MENU (CREATE
 MENU
+          (if
 (NULL (SETQ FN (fetch
 NODELABEL of
 NODE)))
+              then
 (RETURN))
+          [SETQ SELECTION (MENU (create
 MENU
                                        ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
 
      (* ;; "Mot implemented: Ignore Avoid")

 
           (DESTRUCTURING-BIND (FROM
 TO
 INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
-                 (FOR
 BW IN
 BROWSERWINDOWS WHEN
 (EQ (FETCH
 (BROWSEWIN WINDOW) OF
 BW)
-                                                    NWINDOW) DO
 (RETURN (FETCH
 (BROWSEWIN ARGS)
-                                                                           OF
 BW))
-                    FINALLY
 (PROMPTPRINT "No browser window found for" FN)
+                 (for
 BW in
 BROWSERWINDOWS when
 (EQ (fetch
 (BROWSEWIN WINDOW) of
 BW)
+                                                    NWINDOW) do
 (RETURN (fetch
 (BROWSEWIN ARGS)
+                                                                           of
 BW))
+                    finally
 (PROMPTPRINT "No browser window found for" FN)
                           (RETURN))
 
                  (* ;; "Now we have the arguments to MSPATHS .. insert this node?")

@@ -245,11 +242,11 @@
                      NIL
                      (Ignore                                 (* ; "local ignore")
)
                      (Avoid                                  (* ; " global ignore")
)
-                     (Edit (ED FN (IF
 (HASDEF FN 'FNS)
-                                      THEN
 'FNS
-                                    ELSEIF
 (HASDEF FN 'FUNCTIONS)
-                                      THEN
 'FUNCTIONS
-                                    ELSE
 (PROMPTPRINT FN "no definition")
+                     (Edit (ED FN (if
 (HASDEF FN 'FNS)
+                                      then
 '(FNS :DONTWAIT)
+                                    elseif
 (HASDEF FN 'FUNCTIONS)
+                                      then
 '(FUNCTIONS :DONTWAIT)
+                                    else
 (PROMPTPRINT FN "no definition")
                                          NIL)))
                      (Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW
)
                                                     'FNBROWSED))
@@ -544,10 +541,10 @@
 (BROWSER
 T)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
- (BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
-GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
-) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
-BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
-REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
+  (FILEMAP (NIL (1653 28138 (MSPATHS.DISPATCH 1663 . 2137) (NUMSPATHS 2139 . 5726) (BROWSER 5728 . 6299)
+ (BROWSER.WHENFNSCHANGED 6301 . 8086) (BRPATHS1 8088 . 10739) (BROWSER.LEFTFN 10741 . 14300) (
+GET.BROWSE.PP.WINDOW 14302 . 15127) (GET.BROWSE.DESCRIBE.WINDOW 15129 . 15877) (BROWSEPP 15879 . 16753
+) (PPREPAINTFN 16755 . 19881) (PPRESHAPEFN 19883 . 20059) (DESCRIBEREPAINTFN 20061 . 20765) (
+BROWSERDESCRIBE 20767 . 21509) (BROWSER.MIDDLEFN 21511 . 22826) (DEDITPROCESSRUNNINGP 22828 . 23083) (
+REDRAWBROWSEGRAPH 23085 . 23849) (STBROWSER 23851 . 28136)))))
 STOP

library/FILEBROWSER

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED " 4-Nov-2023 23:55:27" |{WMEDLEY}<library>FILEBROWSER.;27|
 266102 
+
(FILECREATED "29-May-2024 15:30:07" {LIB}FILEBROWSER.\;2
 266071 
 
-      :EDIT-BY |rmk|
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (VARS FILEBROWSERCOMS)
-                  (FNS FB.EDITCOMMAND.ONEFILE)
+      :CHANGES-TO (FNS FB.PROMPTW.FORMAT FB.FASTSEE.ONEFILE)
 
-      :PREVIOUS-DATE " 4-Nov-2023 23:50:29" |{WMEDLEY}<library>FILEBROWSER.;26|)
+      :PREVIOUS-DATE " 4-Nov-2023 23:55:27" {LIB}FILEBROWSER.\;1)
 
 
 (PRETTYCOMPRINT FILEBROWSERCOMS)
@@ -729,14 +728,17 @@ Your deletions are thus ignored.")))
                                                                     (PRIN1 THING WINDOW))))))))
 
 (FB.PROMPTW.FORMAT

-  (CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS)              (* \; "Edited  4-Feb-88 23:15 by bvm:")

+  (CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS)
             (* \; "Edited 29-May-2024 15:16 by mth")


+                                                             (* \; "Edited  4-Feb-88 23:15 by bvm:")

 
          (* |;;| "Outputs to FOLDER's prompt window using FORMAT.")

 
          (LET ((*PRINT-CASE* :UPCASE)
                (*PRINT-BASE* 10)
-               (WINDOW (|ffetch|
 (FILEBROWSER
 PROMPTWINDOW) |of|
 (\\DTEST BROWSER
-                                                                                    'FILEBROWSER))))
+               (WINDOW (OR (AND (|type?|
 FILEBROWSER BROWSER)
+                                (|ffetch|
 (FILEBROWSER
 PROMPTWINDOW) |of|
 (\\DTEST BROWSER
+                                                                                 'FILEBROWSER)))
+                           PROMPTWINDOW)))
 
               (* |;;| "*PRINT-CASE* is bound so symbols get printed in \"expected\" case.  *PRINT-BASE* is 10 for benefit of printing numbers in the non-format case.")

 
@@ -1896,10 +1898,9 @@ Your deletions are thus ignored.")))
                                                                 SEEWINDOW UNFORMATTED (CDR TAIL)))))))
 
 (FB.FASTSEE.ONEFILE

-  (LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE)             (* \; 
-
                                                           "Edited 21-Feb-2021 14:46 by rmk:")

-                                                             (* \; 
-
                                                           "Edited 20-Nov-2000 14:23 by rmk:")

+  (LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE)
            (* \; "Edited 29-May-2024 15:28 by mth")


+                                                           (* \; "Edited 21-Feb-2021 14:46 by rmk:")


+                                                           (* \; "Edited 20-Nov-2000 14:23 by rmk:")


                                                              (* \; "Edited 19-Aug-91 13:06 by jds")

     (COND
        ((DIRECTORYNAMEP FILE)
@@ -1921,32 +1922,30 @@ Your deletions are thus ignored.")))
 
                      (* |;;| "Failed on this file.  If this was the only file, the message can be a little more terse (which is desirable, because the typical message is \"File not found xxx\")")

 
-                     (FB.PROMPTW.FORMAT
 BROWSER "~:[Failed~;~:*Couldn't see ~A~] because ~A"
+                     (FB.PROMPTW.FORMAT
 BROWSER "~&~:[Failed~;~:*Couldn't see ~A~] because ~A"
                             (AND MORE FILE)
                             CONDITION)
              |else|
 (RESETLST
-                            (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW)
-                                                             (AND RESETSTATE (OPENWP WINDOW)
-                                                                  (WINDOWPROP
-                                                                   WINDOW
-                                                                   'TITLE
-                                                                   (CONCAT (WINDOWPROP WINDOW
-                                                                                  'TITLE)
-                                                                          " -- " "Aborted")))
-                                                             (CLOSEF STREAM)))
-                                                 STREAM WINDOW))
-                            (WINDOWPROP WINDOW 'MORETYPE (COND
-                                                            (MORE 'YETMOREBUTTONS)
-                                                            (T 'LASTMOREBUTTONS)))
-                            (COND
-                               (UNFORMATTED (COPYCHARS STREAM WINDOW))
-                               (T (PFCOPYBYTES STREAM WINDOW)))
-                            (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
-                                                             " -- " "Finished"))
-                            (COND
-                               (MORE                         (* \; "Wait for OK to proceed")

-                                     (FB.SEEFULLFN
 (WINDOWPROP WINDOW 'DSP)
-                                            'FINISHEDMOREBUTTONS))))))))))
+                        (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW)
+                                                         (AND RESETSTATE (OPENWP WINDOW)
+                                                              (WINDOWPROP WINDOW 'TITLE
+                                                                     (CONCAT (WINDOWPROP WINDOW
+                                                                                    'TITLE)
+                                                                            " -- " "Aborted")))
+                                                         (CLOSEF STREAM)))
+                                             STREAM WINDOW))
+                        (WINDOWPROP WINDOW 'MORETYPE (COND
+                                                        (MORE 'YETMOREBUTTONS)
+                                                        (T 'LASTMOREBUTTONS)))
+                        (COND
+                           (UNFORMATTED (COPYCHARS STREAM WINDOW))
+                           (T (PFCOPYBYTES STREAM WINDOW)))
+                        (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
+                                                         " -- " "Finished"))
+                        (COND
+                           (MORE                             (* \; "Wait for OK to proceed")

+                                 (FB.SEEFULLFN
 (WINDOWPROP WINDOW 'DSP)
+                                        'FINISHEDMOREBUTTONS))))))))))
 
 (FB.SEEFULLFN

   (LAMBDA (DSP PROP)                                         (* |bvm:| "18-Sep-85 23:29")

@@ -4250,51 +4249,51 @@ then click Recompute"))))
 (ADDTOVAR LAMA
 FB.PROMPTW.FORMAT FB.PROMPTWPRINT)
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (31928 54809 (FB 31938 . 33073) (FB.COPYBINARYCOMMAND 33075 . 33421) (FB.COPYTEXTCOMMAND
- 33423 . 33765) (FILEBROWSER 33767 . 46873) (FB.TABLEBROWSER 46875 . 47092) (FB.SELECTEDFILES 47094 . 
-47731) (FB.FETCHFILENAME 47733 . 48125) (FB.DIRECTORYP 48127 . 48521) (FB.PROMPTWPRINT 48523 . 49569) 
-(FB.PROMPTW.FORMAT 49571 . 50308) (FB.PROMPTFORINPUT 50310 . 52562) (FB.YES-OR-NO-P 52564 . 53598) (
-FB.ALLOW.ABORT 53600 . 54454) (\\FB.HARDCOPY.TOFILE.EXTENSION 54456 . 54807)) (54833 55786 (FB.STARTUP
- 54843 . 55358) (FB.MAKERIGIDWINDOW 55360 . 55784)) (55787 61270 (FB.PRINTFN 55797 . 60950) (FB.COPYFN
- 60952 . 61268)) (61320 67660 (FB.MENU.WHENSELECTEDFN 61330 . 61688) (FB.COMMANDSELECTEDFN 61690 . 
-63229) (FB.SUBITEMP 63231 . 63832) (FB.MAKE.BROWSER.BUSY 63834 . 64638) (FB.FINISH.COMMAND 64640 . 
-66671) (FB.HANDLE.ABORT.BUTTON 66673 . 67658)) (67661 73177 (FB.DELETECOMMAND 67671 . 67952) (
-FB.DELVERCOMMAND 67954 . 71147) (FB.IS.NOT.SUBDIRECTORY.ITEM 71149 . 71330) (FB.DELVER.FILES 71332 . 
-72421) (FB.DELETE.FILE 72423 . 73175)) (73178 74503 (FB.UNDELETECOMMAND 73188 . 73473) (
-FB.UNDELETEALLCOMMAND 73475 . 73754) (FB.UNDELETE.FILE 73756 . 74501)) (74504 98685 (FB.COPYCOMMAND 
-74514 . 74783) (FB.RENAMECOMMAND 74785 . 75060) (FB.COPY/RENAME.COMMAND 75062 . 75985) (
-FB.COPY/RENAME.ONE 75987 . 78309) (FB.COPY/RENAME.MANY 78311 . 84531) (FB.MERGE.DIRECTORIES 84533 . 
-84951) (FB.GREATEST.PREFIX 84953 . 86309) (FB.MAYBE.INSERT.FILE 86311 . 93751) (FB.GET.NEW.FILE.SPEC 
-93753 . 97584) (FB.CANONICAL.DIRECTORY 97586 . 98683)) (98686 106470 (FB.HARDCOPYCOMMAND 98696 . 99826
-) (FB.HARDCOPY.TOFILE 99828 . 106468)) (106471 116680 (FB.EDITCOMMAND 106481 . 107348) (
-FB.EDITCOMMAND.ONEFILE 107350 . 110764) (FB.EDITLISPFILE 110766 . 111871) (FB.BROWSECOMMAND 111873 . 
-116678)) (116681 128602 (FB.FASTSEECOMMAND 116691 . 120141) (FB.FASTSEE.ONEFILE 120143 . 123300) (
-FB.SEEFULLFN 123302 . 127433) (FB.SEEBUTTONFN 127435 . 128600)) (128603 130349 (FB.LOADCOMMAND 128613
- . 129120) (FB.COMPILECOMMAND 129122 . 129660) (FB.OPERATE.ON.FILES 129662 . 130347)) (130350 178535 (
-FB.UPDATECOMMAND 130360 . 130585) (FB.FIX-DIRECTORY-DATES 130587 . 131610) (FB.MAYBE.EXPUNGE 131612 . 
-132673) (FB.UPDATEBROWSERITEMS 132675 . 145890) (FB.DATE 145892 . 146533) (FB.ADJUST.DATE.WIDTH 146535
- . 149503) (FB.SET.BROWSER.TITLE 149505 . 150507) (FB.MAYBE.WIDEN.NAMES 150509 . 152628) (
-FB.SET.DEFAULT.NAME.WIDTH 152630 . 153994) (FB.CREATE.FILEBUCKET 153996 . 161216) (
-FB.CHECK.NAME.LENGTH 161218 . 163639) (FB.ADD.FILEGROUP 163641 . 165168) (FB.INSERT.DIRECTORY 165170
- . 165408) (FB.MAKE.SUBDIRECTORY.ITEM 165410 . 166819) (FB.ADD.FILE 166821 . 167434) (FB.INSERT.FILE 
-167436 . 170848) (FB.ANALYZE.PATTERN 170850 . 176114) (FB.CANONICALIZE.PATTERN 176116 . 177428) (
-FB.GETALLFILEINFO 177430 . 178533)) (178536 186695 (FB.SORT.VERSIONS 178546 . 181317) (
-FB.DECREASING.VERSION 181319 . 181988) (FB.INCREASING.VERSION 181990 . 182611) (
-FB.NAMES.DECREASING.VERSION 182613 . 183648) (FB.NAMES.INCREASING.VERSION 183650 . 184647) (
-FB.DECREASING.NUMERIC.ATTR 184649 . 185329) (FB.INCREASING.NUMERIC.ATTR 185331 . 186005) (
-FB.ALPHABETIC.ATTR 186007 . 186693)) (186696 196538 (FB.SORTCOMMAND 186706 . 193536) (
-FB.INSERT.SUBDIRECTORIES 193538 . 194335) (FB.GET.SORT.MENU 194337 . 196536)) (196539 212760 (
-FB.EXPUNGECOMMAND 196549 . 199134) (FB.NEWPATTERNCOMMAND 199136 . 199534) (FB.NEWINFOCOMMAND 199536 . 
-202368) (FB.DEPTHCOMMAND 202370 . 204145) (FB.SHAPECOMMAND 204147 . 207489) (FB.REMOVE.FILE 207491 . 
-209312) (FB.COUNT.FILE.CHANGE 209314 . 210759) (FB.SETNEWPATTERN 210761 . 211931) (FB.GET.NEWPATTERN 
-211933 . 212517) (FB.OPTIONSCOMMAND 212519 . 212758)) (212795 213848 (FB.GETWINDOW 212805 . 213846)) (
-213849 214861 (FB.INFOMENU.SHADEINITIALSELECTIONS 213859 . 214506) (FB.INFO.ITEM.NAMED 214508 . 214859
-)) (214862 224394 (FB.MAKECOUNTERWINDOW 214872 . 216400) (FB.COUNTERW.REDISPLAYFN 216402 . 216989) (
-FB.UPDATE.COUNTERS 216991 . 219063) (FB.DISPLAY.COUNTERS 219065 . 224125) (FB.COUNTER.STRING 224127 . 
-224392)) (224395 229104 (FB.MAKEHEADINGWINDOW 224405 . 226019) (FB.HEADINGW.REDISPLAYFN 226021 . 
-226287) (FB.HEADINGW.RESHAPEFN 226289 . 226665) (FB.HEADINGW.DISPLAY 226667 . 229102)) (229105 233288 
-(FB.ICONFN 229115 . 229462) (FB.INFOMENU.WHENSELECTEDFN 229464 . 230194) (FB.CLOSEFN 230196 . 231399) 
-(FB.EXPUNGE?.MENU 231401 . 231813) (FB.AFTERCLOSEFN 231815 . 232176) (FB.CLOSE&EXPUNGE 232178 . 233286
-)) (233289 245347 (FB.HARDCOPY.DIRECTORY 233299 . 243656) (FB.HARDCOPY.PRINT.TITLE 243658 . 243984) (
-FB.HARDCOPY.MAXWIDTH 243986 . 245345)))))
+  (FILEMAP (NIL (31871 54979 (FB 31881 . 33016) (FB.COPYBINARYCOMMAND 33018 . 33364) (FB.COPYTEXTCOMMAND
+ 33366 . 33708) (FILEBROWSER 33710 . 46816) (FB.TABLEBROWSER 46818 . 47035) (FB.SELECTEDFILES 47037 . 
+47674) (FB.FETCHFILENAME 47676 . 48068) (FB.DIRECTORYP 48070 . 48464) (FB.PROMPTWPRINT 48466 . 49512) 
+(FB.PROMPTW.FORMAT 49514 . 50478) (FB.PROMPTFORINPUT 50480 . 52732) (FB.YES-OR-NO-P 52734 . 53768) (
+FB.ALLOW.ABORT 53770 . 54624) (\\FB.HARDCOPY.TOFILE.EXTENSION 54626 . 54977)) (55003 55956 (FB.STARTUP
+ 55013 . 55528) (FB.MAKERIGIDWINDOW 55530 . 55954)) (55957 61440 (FB.PRINTFN 55967 . 61120) (FB.COPYFN
+ 61122 . 61438)) (61490 67830 (FB.MENU.WHENSELECTEDFN 61500 . 61858) (FB.COMMANDSELECTEDFN 61860 . 
+63399) (FB.SUBITEMP 63401 . 64002) (FB.MAKE.BROWSER.BUSY 64004 . 64808) (FB.FINISH.COMMAND 64810 . 
+66841) (FB.HANDLE.ABORT.BUTTON 66843 . 67828)) (67831 73347 (FB.DELETECOMMAND 67841 . 68122) (
+FB.DELVERCOMMAND 68124 . 71317) (FB.IS.NOT.SUBDIRECTORY.ITEM 71319 . 71500) (FB.DELVER.FILES 71502 . 
+72591) (FB.DELETE.FILE 72593 . 73345)) (73348 74673 (FB.UNDELETECOMMAND 73358 . 73643) (
+FB.UNDELETEALLCOMMAND 73645 . 73924) (FB.UNDELETE.FILE 73926 . 74671)) (74674 98855 (FB.COPYCOMMAND 
+74684 . 74953) (FB.RENAMECOMMAND 74955 . 75230) (FB.COPY/RENAME.COMMAND 75232 . 76155) (
+FB.COPY/RENAME.ONE 76157 . 78479) (FB.COPY/RENAME.MANY 78481 . 84701) (FB.MERGE.DIRECTORIES 84703 . 
+85121) (FB.GREATEST.PREFIX 85123 . 86479) (FB.MAYBE.INSERT.FILE 86481 . 93921) (FB.GET.NEW.FILE.SPEC 
+93923 . 97754) (FB.CANONICAL.DIRECTORY 97756 . 98853)) (98856 106640 (FB.HARDCOPYCOMMAND 98866 . 99996
+) (FB.HARDCOPY.TOFILE 99998 . 106638)) (106641 116850 (FB.EDITCOMMAND 106651 . 107518) (
+FB.EDITCOMMAND.ONEFILE 107520 . 110934) (FB.EDITLISPFILE 110936 . 112041) (FB.BROWSECOMMAND 112043 . 
+116848)) (116851 128571 (FB.FASTSEECOMMAND 116861 . 120311) (FB.FASTSEE.ONEFILE 120313 . 123269) (
+FB.SEEFULLFN 123271 . 127402) (FB.SEEBUTTONFN 127404 . 128569)) (128572 130318 (FB.LOADCOMMAND 128582
+ . 129089) (FB.COMPILECOMMAND 129091 . 129629) (FB.OPERATE.ON.FILES 129631 . 130316)) (130319 178504 (
+FB.UPDATECOMMAND 130329 . 130554) (FB.FIX-DIRECTORY-DATES 130556 . 131579) (FB.MAYBE.EXPUNGE 131581 . 
+132642) (FB.UPDATEBROWSERITEMS 132644 . 145859) (FB.DATE 145861 . 146502) (FB.ADJUST.DATE.WIDTH 146504
+ . 149472) (FB.SET.BROWSER.TITLE 149474 . 150476) (FB.MAYBE.WIDEN.NAMES 150478 . 152597) (
+FB.SET.DEFAULT.NAME.WIDTH 152599 . 153963) (FB.CREATE.FILEBUCKET 153965 . 161185) (
+FB.CHECK.NAME.LENGTH 161187 . 163608) (FB.ADD.FILEGROUP 163610 . 165137) (FB.INSERT.DIRECTORY 165139
+ . 165377) (FB.MAKE.SUBDIRECTORY.ITEM 165379 . 166788) (FB.ADD.FILE 166790 . 167403) (FB.INSERT.FILE 
+167405 . 170817) (FB.ANALYZE.PATTERN 170819 . 176083) (FB.CANONICALIZE.PATTERN 176085 . 177397) (
+FB.GETALLFILEINFO 177399 . 178502)) (178505 186664 (FB.SORT.VERSIONS 178515 . 181286) (
+FB.DECREASING.VERSION 181288 . 181957) (FB.INCREASING.VERSION 181959 . 182580) (
+FB.NAMES.DECREASING.VERSION 182582 . 183617) (FB.NAMES.INCREASING.VERSION 183619 . 184616) (
+FB.DECREASING.NUMERIC.ATTR 184618 . 185298) (FB.INCREASING.NUMERIC.ATTR 185300 . 185974) (
+FB.ALPHABETIC.ATTR 185976 . 186662)) (186665 196507 (FB.SORTCOMMAND 186675 . 193505) (
+FB.INSERT.SUBDIRECTORIES 193507 . 194304) (FB.GET.SORT.MENU 194306 . 196505)) (196508 212729 (
+FB.EXPUNGECOMMAND 196518 . 199103) (FB.NEWPATTERNCOMMAND 199105 . 199503) (FB.NEWINFOCOMMAND 199505 . 
+202337) (FB.DEPTHCOMMAND 202339 . 204114) (FB.SHAPECOMMAND 204116 . 207458) (FB.REMOVE.FILE 207460 . 
+209281) (FB.COUNT.FILE.CHANGE 209283 . 210728) (FB.SETNEWPATTERN 210730 . 211900) (FB.GET.NEWPATTERN 
+211902 . 212486) (FB.OPTIONSCOMMAND 212488 . 212727)) (212764 213817 (FB.GETWINDOW 212774 . 213815)) (
+213818 214830 (FB.INFOMENU.SHADEINITIALSELECTIONS 213828 . 214475) (FB.INFO.ITEM.NAMED 214477 . 214828
+)) (214831 224363 (FB.MAKECOUNTERWINDOW 214841 . 216369) (FB.COUNTERW.REDISPLAYFN 216371 . 216958) (
+FB.UPDATE.COUNTERS 216960 . 219032) (FB.DISPLAY.COUNTERS 219034 . 224094) (FB.COUNTER.STRING 224096 . 
+224361)) (224364 229073 (FB.MAKEHEADINGWINDOW 224374 . 225988) (FB.HEADINGW.REDISPLAYFN 225990 . 
+226256) (FB.HEADINGW.RESHAPEFN 226258 . 226634) (FB.HEADINGW.DISPLAY 226636 . 229071)) (229074 233257 
+(FB.ICONFN 229084 . 229431) (FB.INFOMENU.WHENSELECTEDFN 229433 . 230163) (FB.CLOSEFN 230165 . 231368) 
+(FB.EXPUNGE?.MENU 231370 . 231782) (FB.AFTERCLOSEFN 231784 . 232145) (FB.CLOSE&EXPUNGE 232147 . 233255
+)) (233258 245316 (FB.HARDCOPY.DIRECTORY 233268 . 243625) (FB.HARDCOPY.PRINT.TITLE 243627 . 243953) (
+FB.HARDCOPY.MAXWIDTH 243955 . 245314)))))
 STOP

lispusers/GITFNS

@@ -1,13 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 2-May-2024 23:35:36" {WMEDLEY}<lispusers>GITFNS.;511
 129269 
+
(FILECREATED "12-Jun-2024 23:02:26" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;6
 133403 
 
-      :EDIT-BY rmk
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS GIT-PUSH GIT-PULL GIT-GET-FILE GIT-FILE-DATE GIT-BRANCH-DIFF GIT-COMMIT-DIFFS
-                       GIT-CHECKOUT GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS? GIT-ADD-WORKTREE)
+      :CHANGES-TO (FNS PRC-COMMAND GIT-BRANCH-RELATIONS GIT-BRANCHES GIT-BRANCH-MENU 
+                       GIT-PULL-REQUESTS GIT-PRC-BRANCHES CDGITDIR GIT-COMMAND GITORIGIN 
+                       GIT-RESULT-TO-LINES STRIPLOCAL GIT-WHICH-BRANCH GIT-GET-DIFFERENT-FILES 
+                       GIT-REMOTE-UPDATE GIT-CHECKOUT GIT-MAKE-BRANCH GIT-MY-BRANCHP 
+                       GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES)
 
-      :PREVIOUS-DATE " 2-May-2024 22:57:39" {WMEDLEY}<lispusers>GITFNS.;510)
+      :PREVIOUS-DATE "10-Jun-2024 18:43:43" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;5)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -295,24 +298,24 @@
                                                              (* ; "Edited 13-May-2022 10:40 by rmk")


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


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

-    (CL:WHEN (SETQ PROJECT (IF
 (TYPE?
 GIT-PROJECT PROJECT)
-                               THEN
 PROJECT
-                             ELSEIF
 (CDR (ASSOC (OR (U-CASE PROJECT)
+    (CL:WHEN (SETQ PROJECT (if
 (type?
 GIT-PROJECT PROJECT)
+                               then
 PROJECT
+                             elseif
 (CDR (ASSOC (OR (U-CASE PROJECT)
                                                     GIT-DEFAULT-PROJECT)
                                                 GIT-PROJECTS))
-                             ELSEIF
 NOERROR
-                               THEN
 NIL
-                             ELSE
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
+                             elseif
 NOERROR
+                               then
 NIL
+                             else
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
         (SELECTQ FIELD
-            (PROJECTNAME (FETCH
 PROJECTNAME OF
 PROJECT))
-            (WHOST (FETCH
 WHOST OF
 PROJECT))
-            (GITHOST (FETCH
 GITHOST OF
 PROJECT))
-            (EXCLUSIONS (FETCH
 EXCLUSIONS OF
 PROJECT))
+            (PROJECTNAME (fetch
 PROJECTNAME of
 PROJECT))
+            (WHOST (fetch
 WHOST of
 PROJECT))
+            (GITHOST (fetch
 GITHOST of
 PROJECT))
+            (EXCLUSIONS (fetch
 EXCLUSIONS of
 PROJECT))
             (DEFAULTSUBDIRS 
-                 (FETCH
 DEFAULTSUBDIRS OF
 PROJECT))
-            (CLONEPATH (FETCH
 CLONEPATH OF
 PROJECT))
-            (MAINBRANCH [OR (FETCH
 MAINBRANCH OF
 PROJECT)
-                            (REPLACE
 MAINBRANCH OF
 PROJECT WITH
 (OR (GIT-BRANCH-EXISTS?
 'origin/main
+                 (fetch
 DEFAULTSUBDIRS of
 PROJECT))
+            (CLONEPATH (fetch
 CLONEPATH of
 PROJECT))
+            (MAINBRANCH [OR (fetch
 MAINBRANCH of
 PROJECT)
+                            (replace
 MAINBRANCH of
 PROJECT with
 (OR (GIT-BRANCH-EXISTS?
 'origin/main
                                                                            T PROJECT)
                                                                     (GIT-BRANCH-EXISTS?
 
                                                                            'origin/master NIL PROJECT
@@ -404,7 +407,7 @@
 
 (TYPERECORD GIT-PROJECT
 (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
 
-(RECORD PULLREQUEST
 (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT))
+(RECORD PULLREQUEST
 (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
 )
 )
 
@@ -536,20 +539,21 @@
 (DEFINEQ
 
 (PRC-COMMAND

-  [LAMBDA (REMOTEBRANCH DRAFTS PROJECT)
                      (* ; "Edited  2-May-2024 11:44 by rmk")


+  [LAMBDA (REMOTEBRANCH DRAFTS PROJECT)
                      (* ; "Edited 13-May-2024 18:49 by rmk")


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


                                                              (* ; "Edited  1-Apr-2024 20:24 by rmk")


                                                              (* ; "Edited 28-Jul-2023 09:03 by rmk")

 
     (* ;; "DRAFTS can be DRAFT(S), NODRAFTS, or NIL.  If DRAFTS, then only draft PR's are shown, of NODRAFTS then only nondrafts are shown.  Anything else, both drafts and nondrafts are shown in the menu.")

 
     (LET (PRS MENUWINDOW OLDMENUWINDOW)
-         (IF
 PROJECT
-             THEN
 (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-           ELSEIF
 (GIT-GET-PROJECT
 REMOTEBRANCH NIL T)
-             THEN
 (SETQ PROJECT REMOTEBRANCH)
+         (if
 PROJECT
+             then
 (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
+           elseif
 (GIT-GET-PROJECT
 REMOTEBRANCH NIL T)
+             then
 (SETQ PROJECT REMOTEBRANCH)
                   (SETQ REMOTEBRANCH NIL)
-           ELSEIF
 (GIT-GET-PROJECT
 DRAFTS NIL T)
-             THEN
 (SETQ PROJECT DRAFTS)
+           elseif
 (GIT-GET-PROJECT
 DRAFTS NIL T)
+             then
 (SETQ PROJECT DRAFTS)
                   (SETQ DRAFTS NIL))
          (CL:UNLESS PROJECT (SETQ PROJECT GIT-DEFAULT-PROJECT))
          (SELECTQ (U-CASE REMOTEBRANCH)
@@ -566,22 +570,30 @@
 
          (SETQ PRS (GIT-PULL-REQUESTS
 (NEQ 'NODRAFTS DRAFTS)
                           PROJECT))
-         (CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu))
 
-             (* ;; "Filter by the REMOTEBRANCH string")

+         (* ;; "Filter by REMOTEBRANCH properties")

 
-             (SETQ PRS (for
 PR in
 PRS when
 (OR (STRPOS REMOTEBRANCH (fetch
 PRDESCRIPTION of
 PR)
-                                                      NIL NIL NIL NIL FILEDIRCASEARRAY)
-                                               (STRPOS REMOTEBRANCH (fetch
 PRNAME of
 PR)
-                                                      NIL NIL NIL NIL FILEDIRCASEARRAY)) collect

-                                                                                         PR)))
-         (IF
 PRS
-             THEN
 (if
 (CDR PRS)
+         (SETQ PRS (for
 PR FOUND in
 PRS
+                      when
 (if
 (STRING-EQUAL "Interlisp" (fetch
 PRLOGIN of
 PR))
+                               then
 (OR (NULL REMOTEBRANCH)
+                                        (STRPOS REMOTEBRANCH (fetch
 PRDESCRIPTION of
 PR)
+                                               NIL NIL NIL NIL FILEDIRCASEARRAY)
+                                        (STRPOS REMOTEBRANCH (fetch
 PRNAME of
 PR)
+                                               NIL NIL NIL NIL FILEDIRCASEARRAY))
+                             else
 (CL:UNLESS FOUND
+                                      (SETQ FOUND T)
+                                      (PRINTOUT T "Ignored because not owned by Interlisp: " T))
+                                  (PRINTOUT T 3 (fetch
 PRDESCRIPTION of
 PR)
+                                         "  ("
+                                         (fetch
 PRLOGIN of
 PR)
+                                         ")" T)
+                                  NIL) collect
 PR))
+         (if
 PRS
+             then
 (if
 (CDR PRS)
                       then
 (SETQ MENUWINDOW (ADDMENU (GIT-BRANCH-MENU
 (GIT-PRC-BRANCHES
 DRAFTS 
                                                                              PROJECT PRS)
                                                             (CONCAT (LENGTH PRS)
-                                                                   " pull requests")
-                                                            NIL PROJECT)
+                                                                   " pull requests"))
                                                    NIL NIL T)) 
 
                            (* ;; "Position the new menu just under the current TTY window, to keep it out of the way of the comparison windows.  If we have menus open for other projects, those probably should be pushed down to make room for the new menu, and moved up when a higher menu is closed.  An edge case that is not worth the effort. ")

@@ -594,12 +606,12 @@
                            (CL:WHEN [OPENWP (CDR (SETQ OLDMENUWINDOW (ASSOC PROJECT GIT-PRC-MENUS]
                                (CLOSEW (CDR OLDMENUWINDOW)))
                            (OPENW MENUWINDOW)
-                           (RPLACD [OR OLDMENUWINDOW (CAR (PUSH
 GIT-PRC-MENUS (CONS PROJECT]
+                           (RPLACD [OR OLDMENUWINDOW (CAR (push
 GIT-PRC-MENUS (CONS PROJECT]
                                   MENUWINDOW)
                            MENUWINDOW
                     else
 (GIT-PR-COMPARE
 (fetch
 PRNAME of
 (CAR PRS))
                                 PROJECT))
-           ELSE
 (CONCAT "No open " (OR REMOTEBRANCH "")
+           else
 (CONCAT "No open " (OR REMOTEBRANCH "")
                        " pull requests"])
 )
 
@@ -962,7 +974,8 @@
 
 (GIT-REMOTE-UPDATE

   [LAMBDA (DOIT PROJECT)
-    (DECLARE
 (USEDFREE LAST-REMOTE-UPDATE-IDATE))
            (* ; "Edited  7-May-2022 22:41 by rmk")

+    (DECLARE
 (USEDFREE LAST-REMOTE-UPDATE-IDATE))
            (* ; "Edited 12-Jun-2024 12:57 by mth")


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

 
     (* ;; "Because git hangs on this (and other things), do this no more than once a day")

 
@@ -970,7 +983,7 @@
                  (IGREATERP (IDIFFERENCE (IDATE)
                                    LAST-REMOTE-UPDATE-IDATE)
                         (CONSTANT (TIMES 24 60 60 1000]
-        (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH
 PROJECT)
+        (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH
 PROJECT T)
                T)
         (PROG1 (GIT-COMMAND
 "git remote update origin" NIL PROJECT)
             (SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))])
@@ -1070,6 +1083,8 @@
 (GIT-BRANCH-DIFF

   [LAMBDA (BRANCH1 BRANCH2 PROJECT)
 
+    (* ;; "Edited 10-Jun-2024 16:43 by mth")

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

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

@@ -1109,10 +1124,10 @@
           (SETQ RLINES NIL)
           (CL:WHEN (LISTP RESULTFILE)
               (SETQ ERRORFILE (CADR RESULTFILE))
-              (SETQ ELINES (GIT-RESULT-TO-LINES
 ERRORFILE))
+              (SETQ ELINES (GIT-RESULT-TO-LINES
 ERRORFILE T))
               (DELFILE ERRORFILE)
               (SETQ RESULTFILE (CAR RESULTFILE)))
-          (SETQ RLINES (GIT-RESULT-TO-LINES
 RESULTFILE))
+          (SETQ RLINES (GIT-RESULT-TO-LINES
 RESULTFILE T))
           (DELFILE RESULTFILE)
           (CL:WHEN ELINES
               (if
 [AND (STRPOS "warning: inexact rename detection was skipped due to too many files."
@@ -1133,30 +1148,32 @@
                               (GO RETRY))
                            (ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2)))
                 else
 (for
 L in
 ELINES do
 (PRINTOUT T L T))))
-          (RETURN (SORT (for
 L in
 RLINES
+          (RETURN (SORT (for
 (L FN) in
 RLINES
                            collect
 (SELCHARQ (CHCON1 L)
                                         (A (CL:IF (EQ (CHARCODE TAB)
                                                       (NTHCHARCODE L 2))
-                                               (LIST 'ADDED (SUBSTRING L 3))
+                                               (LIST 'ADDED (SETQ FN (SUBSTRING L 3)))
                                                (ERROR "ADDED NOT RECOGNIZED" L)))
                                         (D (CL:IF (EQ (CHARCODE TAB)
                                                       (NTHCHARCODE L 2))
-                                               (LIST 'DELETED (SUBSTRING L 3))
+                                               (LIST 'DELETED (SETQ FN (SUBSTRING L 3)))
                                                (ERROR "DELETED NOT RECOGNIZED" L)))
                                         (M (CL:IF (SETQ POS (STRPOS "	" L))
-                                               (LIST 'CHANGED (SUBSTRING L (ADD1 POS)))
+                                               [LIST 'CHANGED (SETQ FN (SUBSTRING L (ADD1 POS]
                                                (ERROR "CHANGED NOT RECOGNIZED" L)))
                                         (C (if
 (AND (EQ (CHARCODE TAB)
                                                         (NTHCHARCODE L 5))
                                                     (SETQ POS (STRPOS "	" L 7)))
-                                               then
 (LIST 'COPIED (SUBSTRING L 6 (SUB1 POS))
+                                               then
 (LIST 'COPIED (SETQ FN (SUBSTRING L 6
+                                                                                  (SUB1 POS)))
                                                           (OR (FIXP (SUBATOM L 2 4))
                                                               (HELP "C without a number" L)))
                                              else
 (HELP "COPY NOT RECOGNIZED" L)))
                                         (R (if
 (AND (EQ (CHARCODE TAB)
                                                         (NTHCHARCODE L 5))
                                                     (SETQ POS (STRPOS "	" L 7)))
-                                               then
 (LIST 'RENAMED (SUBSTRING L 6 (SUB1 POS))
+                                               then
 (LIST 'RENAMED (SETQ FN (SUBSTRING L 6
+                                                                                   (SUB1 POS)))
                                                           (SUBSTRING L (ADD1 POS))
                                                           (OR (FIXP (SUBATOM L 2 4))
                                                               (HELP "R without a number" L)))
@@ -1167,7 +1184,8 @@
                                                                           " Ignore remaining files? "
                                                                                      )))
                                                   (ERROR!)))
-                                        (HELP "Unrecognized git-diff code " L)))
+                                        (HELP "Unrecognized git-diff code " L))
+                           unless
 (STREQUAL ".git/" (SUBSTRING FN 1 5)))
                         T])
 
 (GIT-COMMIT-DIFFS

@@ -1193,20 +1211,20 @@
      ((MAIN (GIT-MAINBRANCH
 PROJECT)))
      (CL:WHEN STRIPWHERE
          (SETQ MAIN (STRIPWHERE
 MAIN)))
-     (FOR
 DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS

-        ON
 (FOR
 B IN
 BRANCHES COLLECT
 (CL:WHEN STRIPWHERE
+     (for
 DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS

+        on
 (for
 B in
 BRANCHES collect
 (CL:WHEN STRIPWHERE
                                           (SETQ B (STRIPWHERE
 B)))
                                     (CONS B (GIT-COMMIT-DIFFS
 B MAIN PROJECT)))
-        DO
 
+        do
 
            (* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.")

 
            (SETQ D1 (CAR DTAIL))
-           [FOR
 D2 IN
 (CDR DTAIL)
-              DO
 (CL:WHEN (EQUAL (CDR D1)
+           [for
 D2 in
 (CDR DTAIL)
+              do
 (CL:WHEN (EQUAL (CDR D1)
                                  (CDR D2))                   (* ; "Unlikely")

-                     (PUSH
 [CDR (OR (ASSOC (CAR D1)
+                     (push
 [CDR (OR (ASSOC (CAR D1)
                                            EQUALS
)
-                                    (CAR (PUSH
 EQUALS
 (CONS (CAR D1]
+                                    (CAR (push
 EQUALS
 (CONS (CAR D1]
                            (CAR D2))
                      (GO $$ITERATE))
                  (SETQ MORE2 (MEMBER (CADR D1)
@@ -1214,33 +1232,33 @@
 
                                                             "The most recent commit of D1 is in D2")

                  (SETQ MORE1 (MEMBER (CADR D2)
                                     (CDR D1)))
-                 (IF
 MORE2
-                     THEN
 (CL:UNLESS MORE1
-                              (PUSH
 [CDR (OR (ASSOC (CAR D2)
+                 (if
 MORE2
+                     then
 (CL:UNLESS MORE1
+                              (push
 [CDR (OR (ASSOC (CAR D2)
                                                     SUPERSETS)
-                                             (CAR (PUSH
 SUPERSETS (CONS (CAR D2]
+                                             (CAR (push
 SUPERSETS (CONS (CAR D2]
                                     (CAR D1)))
-                   ELSEIF
 MORE1
-                     THEN
 (PUSH
 [CDR (OR (ASSOC (CAR D1)
+                   elseif
 MORE1
+                     then
 (push
 [CDR (OR (ASSOC (CAR D1)
                                                 SUPERSETS)
-                                         (CAR (PUSH
 SUPERSETS (CONS (CAR D1]
+                                         (CAR (push
 SUPERSETS (CONS (CAR D1]
                                 (CAR D2]
-        FINALLY
 
+        finally
 
 
               (* ;; "Sort the supersets so that the larger ones come before the smaller ones")

 
               (CL:WHEN STRIPWHERE
-                  [SETQ SUPERSETS (FOR
 S IN
 SUPERSETS COLLECT
 (FOR
 SS IN
 S COLLECT
 (STRIPWHERE
 SS]
-                  [SETQ EQUALS
 (FOR
 S IN
 EQUALS
 COLLECT
 (FOR
 SS IN
 S COLLECT
 (STRIPWHERE
 SS])
-              [FOR
 S IN
 SUPERSETS
-                 DO
 (CHANGE
 (CDR S)
+                  [SETQ SUPERSETS (for
 S in
 SUPERSETS collect
 (for
 SS in
 S collect
 (STRIPWHERE
 SS]
+                  [SETQ EQUALS
 (for
 S in
 EQUALS
 collect
 (for
 SS in
 S collect
 (STRIPWHERE
 SS])
+              [for
 S in
 SUPERSETS
+                 do
 (change
 (CDR S)
                            (SORT DATUM (FUNCTION (LAMBDA (B1 B2)
                                                    (OR (MEMB B2 (CDR (ASSOC B1 SUPERSETS)))
                                                        (NOT (MEMB B1 (CDR (ASSOC B2 SUPERSETS]
-              [FOR
 E IN
 EQUALS
 DO
 (CHANGE
 (CDR E)
-                                         (IF
 (MEMB MAIN (CDR E))
-                                             THEN
 (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
-                                           ELSE
 (SORT DATUM]
+              [for
 E in
 EQUALS
 do
 (change
 (CDR E)
+                                         (if
 (MEMB MAIN (CDR E))
+                                             then
 (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
+                                           else
 (SORT DATUM]
               (RETURN (LIST SUPERSETS EQUALS
])
 )
 
@@ -1269,14 +1287,15 @@
                                                      0])])
 
 (GIT-CHECKOUT

-  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited  2-May-2024 11:17 by mth")


+  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited 12-Jun-2024 22:44 by mth")


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


                                                              (* ; "Edited  7-Jul-2022 20:21 by rmk")


                                                              (* ; "Edited  9-May-2022 15:12 by rmk")


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


                                                             (* ; "Edited  2-Nov-2021 22:40 by rmk:")

     (CL:UNLESS BRANCH
         (SETQ BRANCH (GIT-MAINBRANCH
 PROJECT)))
-    (LET ((CURRENTBRANCH (GIT-WHICH-BRANCH
 PROJECT)))
+    (LET ((CURRENTBRANCH (GIT-WHICH-BRANCH
 PROJECT T)))
          [SETQ CURRENTBRANCH (SUBSTRING CURRENTBRANCH (ADD1 (STRPOS "/" CURRENTBRANCH]
          (CL:UNLESS [STRING.EQUAL CURRENTBRANCH (SUBSTRING BRANCH (ADD1 (OR (STRPOS "/" BRANCH)
                                                                             0]
@@ -1287,14 +1306,16 @@
          BRANCH])
 
 (GIT-WHICH-BRANCH

-  [LAMBDA (PROJECT)
                                          (* ; "Edited  7-May-2022 22:41 by rmk")

+  [LAMBDA (PROJECT ALL)
                                      (* ; "Edited 12-Jun-2024 12:57 by mth")


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

 
     (* ;; "Returns the current (local) branch in PROJECT")

 
-    (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND
 "git rev-parse --abbrev-ref HEAD" NIL NIL PROJECT])
+    (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND
 "git rev-parse --abbrev-ref HEAD" ALL NIL PROJECT])
 
 (GIT-MAKE-BRANCH

-  [LAMBDA (NAME TITLESTRING PROJECT)
                         (* ; "Edited  2-May-2024 11:24 by mth")


+  [LAMBDA (NAME TITLESTRING PROJECT)
                         (* ; "Edited 12-Jun-2024 22:47 by mth")


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


                                                              (* ; "Edited 18-Jul-2022 21:45 by rmk")


                                                              (* ; "Edited 19-May-2022 17:57 by rmk")


                                                              (* ; "Edited  9-May-2022 15:13 by rmk")

@@ -1312,12 +1333,14 @@
 
         (* ;; "Git branch names can't contain spaces or colons")

 
+        (* ;; "mth: Notice that this is only dealing with spaces. There are other %"troublesome%" characters beyond colon, as well.")

+
         [SETQ TITLESTRING (CONCATCODES (for
 I C from
 1 while
 (SETQ C (NTHCHARCODE TITLESTRING I))
                                           collect
 (if
 (EQ C (CHARCODE SPACE))
                                                       then
 (CHARCODE -
)
                                                     else
 C]
         (SETQ NAME (CONCAT NAME "--" TITLESTRING)))
-    (LET ((UNDER (GIT-WHICH-BRANCH
 PROJECT))
+    (LET ((UNDER (GIT-WHICH-BRANCH
 PROJECT T))
           RESULT)
          (if
 (EQ 'Y (ASKUSER NIL 'N (CONCAT "Branch " NAME " will be created under " UNDER 
                                            ". Is that OK? ")))
@@ -1335,7 +1358,8 @@
                 NIL])
 
 (GIT-BRANCHES

-  [LAMBDA (WHERE
 PROJECT EXCLUDEMERGED)
                      (* ; "Edited  2-May-2024 11:26 by mth")


+  [LAMBDA (WHERE
 PROJECT EXCLUDEMERGED)
                      (* ; "Edited 12-Jun-2024 12:46 by mth")


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


                                                              (* ; "Edited  9-Aug-2022 10:45 by rmk")


                                                              (* ; "Edited 18-Jul-2022 08:11 by rmk")


                                                              (* ; "Edited  8-Jul-2022 10:33 by rmk")


@@ -1349,12 +1373,12 @@
 
     (LET ([LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
                                 '(NIL ALL LOCAL))
-                     [for
 B in
 (GIT-COMMAND
 "git branch" NIL NIL PROJECT)
+                     [for
 B in
 (GIT-COMMAND
 "git branch" T NIL PROJECT)
                         collect
 (SUBATOM B 3 (SUB1 (OR (STRPOS " -> " B)
                                                        0])]
           [REMOTE (CL:WHEN (MEMB (U-CASE WHERE)
                                  '(NIL ALL REMOTE T))
-                      [for
 B in
 (GIT-COMMAND
 "git branch -r" NIL NIL PROJECT)
+                      [for
 B in
 (GIT-COMMAND
 "git branch -r" T NIL PROJECT)
                          collect
 (SUBATOM B 3 (SUB1 (OR (STRPOS " -> " B)
                                                         0])]
           BRANCHES)
@@ -1400,7 +1424,7 @@
     (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
         (CL:WHEN PIN?
             [SETQ BRANCHES (APPEND BRANCHES '(("      Pin menu" 'PinMenu])
-        (CREATE
 MENU
+        (create
 MENU
                TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
                                         " branches"))
                ITEMS _ BRANCHES
@@ -1408,48 +1432,60 @@
                WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
 
 (GIT-BRANCH-WHENSELECTEDFN

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

+  [LAMBDA (ITEM)
                                             (* ; "Edited 11-May-2024 11:05 by rmk")


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

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

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

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

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

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

 
-             (BKSYSBUF '%()
-             [COPYINSERT `(GIT-PR-COMPARE
 ,(CADR ITEM)
-                                 ',(CADR (CDDDR ITEM]
-             (BKSYSBUF '%))
-      else
 
-           (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")

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

 
-           (PROCESS.EVAL (TTY.PROCESS)
-                  `(RESETLST
-                       [RESETSAVE (DSPFONT DEFAULTFONT T)
-                              '(PROGN (DSPFONT OLDVALUE T])])
+                  (BKSYSBUF '%()
+                  [COPYINSERT `(GIT-PR-COMPARE
 ,(CADR ITEM)
+                                      ',(fetch
 PRPROJECT of
 PR]
+                  (BKSYSBUF '%))
+           else
 
+                (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")

+
+                (PROCESS.EVAL (TTY.PROCESS)
+                       `(RESETLST
+                            [RESETSAVE (DSPFONT DEFAULTFONT T)
+                                   '(PROGN (DSPFONT OLDVALUE T])])
 
 (GIT-PULL-REQUESTS

-  [LAMBDA (INCLUDEDRAFTS PROJECT)
                            (* ; "Edited  1-May-2024 09:23 by rmk")


+  [LAMBDA (INCLUDEDRAFTS PROJECT)
                            (* ; "Edited 20-May-2024 22:12 by rmk")


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


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


+                                                             (* ; "Edited  1-May-2024 09:23 by rmk")


                                                              (* ; "Edited  8-Aug-2022 13:12 by rmk")


                                                              (* ; "Edited  4-Aug-2022 19:01 by rmk")


                                                              (* ; "Edited 17-Jul-2022 11:12 by rmk")


-                                                             (* ; "Edited  9-May-2022 16:54 by rmk")


-                                                             (* ; "Edited 25-Feb-2022 09:26 by rmk")

+                                                             (* ; "Edited  9-May-2022 16:54 by rmk")

+
+    (* ;; "Returns a list of PULLREQUEST records, one for each pull request")

+
                                                             (* ; "Edited 25-Feb-2022 09:26 by rmk")

     (CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh"))
            (ERROR "gh must be installed in order to enumerate pull requests:"))
-    (LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND
 
-                                  "gh pr list --json number,headRefName,title,isDraft,reviewDecision"
+    (LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND
 "gh pr list --json number,headRefName,title,isDraft,reviewDecision,url,headRepository,headRepositoryOwner"
                                           T NIL PROJECT]
-         (FOR
 JSOBJ DRAFT PR IN
 (SELECTQ (CAR JPARSE)
+         (for
 JSOBJ DRAFT PR in
 (SELECTQ (CAR JPARSE)
                                     (ARRAY (CDR JPARSE))
                                     (OBJECT JPARSE)
                                     (ERROR "UNRECOGNIZED PRC LIST FROM GIT" JPARSE))
-            EACHTIME
 [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] WHEN
 (OR INCLUDEDRAFTS
+            eachtime
 [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] when
 (OR INCLUDEDRAFTS
                                                                               (NOT DRAFT))
-            COLLECT
 (SETQ PR (CREATE
 PULLREQUEST
+            collect
 [SETQ PR (create
 PULLREQUEST
                                     PRNUMBER _ (JSON-GET JSOBJ 'number)
                                     PRNAME _ (JSON-GET JSOBJ 'headRefName)
                                     PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
@@ -1459,8 +1495,19 @@
                                                                  (JSON-GET JSOBJ 'reviewDecision))
                                                        " "
                                                        'A))
-                                    PRPROJECT _ PROJECT))
+                                    PRPROJECT _ PROJECT
+                                    PRURL _ (JSON-GET JSOBJ 'url)
+                                    PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login]
                   (CL:WHEN (STRPOS ":" (fetch
 (PULLREQUEST PRNAME) of
 PR))
+
+                      (* ;; "From Nick:  Git commands to bring install and deal with the remotes:")

+
+                      (* ;; "git remote add [PRLOGIN] https://github.com/[PRLOGIN]/[PROJECT]")

+
+                      (* ;; "          (project in lower-case)")

+
+                      (* ;; "git remote update [PRLOGIN]")

+
                       (PRINTOUT T "Ignoring PR for forked repo %%%" #" (JSON-GET JSOBJ 'number)
                              " "
                              (fetch
 (PULLREQUEST PRNAME) of
 PR)
@@ -1484,7 +1531,9 @@
     (FIND
 B IN
 (GIT-BRANCHES
 WHERE PROJECT EXCLUDEMERGED) SUCHTHAT
 (STRPOS BRANCH B])
 
 (GIT-PRC-BRANCHES

-  [LAMBDA (DRAFT PROJECT PRS)
                                (* ; "Edited  1-May-2024 21:06 by rmk")


+  [LAMBDA (DRAFT PROJECT PRS)
                                (* ; "Edited 13-May-2024 19:30 by rmk")


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


+                                                             (* ; "Edited  1-May-2024 21:06 by rmk")


                                                              (* ; "Edited  1-Apr-2024 17:09 by rmk")


                                                              (* ; "Edited  8-Aug-2022 18:15 by rmk")


                                                              (* ; "Edited  4-Aug-2022 18:55 by rmk")


@@ -1496,28 +1545,29 @@
     (CL:UNLESS PRS
         (SETQ PRS (GIT-PULL-REQUESTS
 T PROJECT)))
     (CL:WHEN PRS
-        (LET ((RELATIONS (GIT-BRANCH-RELATIONS
 (FOR
 PR IN
 PRS COLLECT
 (GITORIGIN
 (CADDR PR)))
+        (LET ((RELATIONS (GIT-BRANCH-RELATIONS
 (for
 PR in
 PRS
+                                                  collect
 (GITORIGIN
 (fetch
 PRNAME of
 PR)))
                                 NIL T PROJECT)))
-             (SORT (FOR
 PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
-                        (EQUALS _ (CADR RELATIONS)) IN
 PRS
-                      EACHTIME
 (SETQ PRNAME (fetch
 PRNAME of
 PR))
+             (SORT (for
 PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
+                        (EQUALS _ (CADR RELATIONS)) in
 PRS
+                      eachtime
 (SETQ PRNAME (fetch
 PRNAME of
 PR))
                             (SETQ LABEL (CONCAT "#" (fetch
 (PULLREQUEST PRNUMBER) of
 PR)
                                                " "
-                                               (IF
 [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
-                                                   THEN
 (CONCAT PRNAME " > " REL)
-                                                 ELSEIF
 [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS
]
-                                                   THEN
 (CONCAT PRNAME " = " REL)
-                                                 ELSE
 PRNAME)))
-                            (SETQ STATUS (FETCH
 PRSTATUS OF
 PR))
-                      WHEN
 (SELECTQ DRAFT
+                                               (if
 [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
+                                                   then
 (CONCAT PRNAME " > " REL)
+                                                 elseif
 [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS
]
+                                                   then
 (CONCAT PRNAME " = " REL)
+                                                 else
 PRNAME)))
+                            (SETQ STATUS (fetch
 PRSTATUS of
 PR))
+                      when
 (SELECTQ DRAFT
                                (DRAFTS (EQ STATUS 'D))
                                (NODRAFTS (NEQ STATUS 'D))
-                               T) COLLECT
 (LIST (CONCAT " " STATUS " " LABEL)
+                               T) collect
 (LIST (CONCAT " " STATUS " " LABEL)
                                                 (GITORIGIN
 PRNAME)
-                                                (CONCAT " " STATUS " #" (FETCH
 PRNUMBER OF
 PR)
+                                                (CONCAT " " STATUS " #" (fetch
 PRNUMBER of
 PR)
                                                        " "
-                                                       (FETCH
 PRDESCRIPTION OF
 PR))
-                                                NIL PROJECT))
+                                                       (fetch
 PRDESCRIPTION of
 PR))
+                                                NIL PR))
                    T)))])
 )
 
@@ -1535,14 +1585,15 @@
                                                               0])
 
 (GIT-MY-BRANCHP

-  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited 19-May-2022 17:44 by rmk")


+  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited 12-Jun-2024 22:48 by mth")


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


                                                              (* ; "Edited 19-Jan-2022 13:22 by rmk")

 
     (* ;; "Returns n if BRANCH is INITIALSn (local or origin), possibly followed by a trailing comment after hyphen.")

 
     (CL:UNLESS BRANCH
-        (SETQ BRANCH (GIT-WHICH-BRANCH
 PROJECT)))
-    (GIT-BRANCH-NUM
 (OR BRANCH (GIT-WHICH-BRANCH
 PROJECT])
+        (SETQ BRANCH (GIT-WHICH-BRANCH
 PROJECT T)))
+    (GIT-BRANCH-NUM
 (OR BRANCH (GIT-WHICH-BRANCH
 PROJECT T])
 
 (GIT-MY-NEXT-BRANCH

   [LAMBDA (PROJECT)
                                          (* ; "Edited 19-May-2022 14:08 by rmk")


@@ -1692,9 +1743,9 @@
     (LET
      (MAPPINGS FROMGIT (DIFFS (GIT-BRANCH-DIFF
 BRANCH1 BRANCH2 PROJECT)))
      (CL:WHEN DIFFS
-         (SETQ FROMGIT (PACK* '{FROMGIT (ADD
 FROMGITN 1)
+         (SETQ FROMGIT (PACK* '{FROMGIT (add
 FROMGITN 1)
                               '}))
-         (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (FETCH
 PROJECTNAME OF
 PROJECT)
+         (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (fetch
 PROJECTNAME of
 PROJECT)
                                     ">"
                                     (DATE)
                                     ">"))
@@ -1707,8 +1758,8 @@
          (CL:UNLESS DIR2
              (SETQ DIR2 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH2)
                                ">")))
-         (FOR
 D IN
 DIFFS
-            DO
 (SELECTQ (CAR D)
+         (for
 D in
 DIFFS
+            do
 (SELECTQ (CAR D)
                    (ADDED                                    (* ; 
 
     "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?")

                           (SETQ D (CADR D))
@@ -1755,14 +1806,14 @@
 
                              (* ;; "Let the directories figure it out")

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

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

 
@@ -1782,7 +1833,9 @@
          (LIST DIR1 DIR2 MAPPINGS))])
 
 (GIT-BRANCHES-COMPARE-DIRECTORIES

-  [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT)
                    (* ; "Edited  1-May-2024 14:58 by rmk")


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


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


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


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


                                                              (* ; "Edited 10-Jun-2023 17:28 by rmk")


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


@@ -1791,23 +1844,26 @@
                                                              (* ; "Edited  9-May-2022 15:14 by rmk")


                                                              (* ; "Edited  3-May-2022 23:04 by rmk")

     (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-    (SETQ BRANCH1 (IF
 BRANCH1
-                      THEN
 (GITORIGIN
 BRANCH1 LOCAL)
-                    ELSE
 (GIT-WHICH-BRANCH
 PROJECT)))
+    (SETQ BRANCH1 (if
 BRANCH1
+                      then
 (GITORIGIN
 BRANCH1 LOCAL)
+                    else
 (GIT-WHICH-BRANCH
 PROJECT T)))
     (LET (CDVALUE DIRS NENTRIES MAPPINGS (SHORT1 (GIT-SHORT-BRANCH-NAME
 BRANCH1))
                 (SHORT2 (GIT-SHORT-BRANCH-NAME
 BRANCH2)))
-         (PRINTOUT T "Comparing all " (L-CASE (FETCH
 PROJECTNAME OF
 PROJECT)
+         (PRINTOUT T "Comparing all " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                              T)
                 " subdirectories of " SHORT1 " and " SHORT2 T)
          (PRINTOUT T "Fetching differences" T)
          (SETQ DIRS (GIT-GET-DIFFERENT-FILES
 BRANCH1 BRANCH2 NIL NIL PROJECT))
          (SETQ MAPPINGS (CADDR DIRS))
-         (IF
 DIRS
-             THEN
 (TERPRI T)
+         (if
 DIRS
+             then
 (TERPRI T) 
+
+                  (* ;; "INCLUDEDFILES parameter to COMPAREDIRECTORIES needs to allow both top-level files, and leading dot filenames.")

+
                   [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
                                        (CADR DIRS)
                                        '(> < ~= -* *-)
-                                       '*>*.*
+                                       '(*.* *>*.* .* *>.*)
                                        (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS)
                                        NIL NIL NIL NIL (LIST (PACKFILENAME 'HOST NIL 'BODY
                                                                     (CAR DIRS))
@@ -1823,30 +1879,30 @@
                          (FUNCTION (LAMBDA (CDE)
                                      (DECLARE
 (USEDFREE INFO1 INFO2))
                                      (LET [(MAP (CL:UNLESS INFO2
-                                                    (FIND
 M IN
 MAPPINGS
-                                                       SUCHTHAT
 (STRING.EQUAL (CAR M)
-                                                                       (FETCH
 (CDINFO FULLNAME)
-                                                                          OF
 INFO1)
+                                                    (find
 M in
 MAPPINGS
+                                                       suchthat
 (STRING.EQUAL (CAR M)
+                                                                       (fetch
 (CDINFO FULLNAME)
+                                                                          of
 INFO1)
                                                                        FILEDIRCASEARRAY)))]
                                           (CL:WHEN MAP
                                               (HELP 'MAP MAP))
                                           (CL:WHEN INFO1
-                                              (CHANGE
 (FETCH
 (CDINFO FULLNAME) OF
 INFO1)
+                                              (change
 (fetch
 (CDINFO FULLNAME) of
 INFO1)
                                                      (SLASHIT (PACKFILENAME.STRING 'VERSION NIL
                                                                      'BODY DATUM)
                                                             T)))
                                           (CL:WHEN INFO2
-                                              (CHANGE
 (FETCH
 (CDINFO FULLNAME) OF
 INFO2)
+                                              (change
 (fetch
 (CDINFO FULLNAME) of
 INFO2)
                                                      (SLASHIT (PACKFILENAME.STRING 'VERSION NIL
                                                                      'BODY DATUM)
                                                             T)))
-                                          (IF
 MAP
-                                              THEN
 
+                                          (if
 MAP
+                                              then
 
 
                                  (* ;; "This handles renames and copies.  We want the nominal source of a rename to be in the first column, even though the target location is the one that was fetched.")

 
-                                                   (REPLACE
 (CDENTRY INFO2) OF
 CDE
-                                                      WITH
 (CREATE
 CDINFO
+                                                   (replace
 (CDENTRY INFO2) of
 CDE
+                                                      with
 (create
 CDINFO
                                                                   FULLNAME _ (CADR MAP)
                                                                   DATE _ (CL:IF (EQ 'R (CADDR MAP))
                                                                              " <-"
@@ -1855,31 +1911,33 @@
                                                                   AUTHOR _ ""
                                                                   TYPE _ ""
                                                                   EOL _ ""))
-                                                   (REPLACE
 (CDENTRY DATEREL) OF
 CDE
-                                                      WITH
 (CADDR MAP]
+                                                   (replace
 (CDENTRY DATEREL) of
 CDE
+                                                      with
 (CADDR MAP]
                   (TERPRI T)
-                  (IF
 (FETCH
 (CDVALUE CDENTRIES) OF
 CDVALUE)
-                      THEN
 (SETQ LAST-BRANCH-CDVALUE CDVALUE)
-                           (CDBROWSER CDVALUE (CONCAT (L-CASE (FETCH
 PROJECTNAME OF
 PROJECT)
+                  (if
 (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE)
+                      then
 (SETQ LAST-BRANCH-CDVALUE CDVALUE)
+                           (CDBROWSER CDVALUE (CONCAT (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                                              T)
                                                      " " SHORT1 "  vs  " SHORT2 "      "
-                                                     (LENGTH (FETCH
 (CDVALUE CDENTRIES) OF
 CDVALUE))
+                                                     (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE))
                                                      " files")
                                   (LIST SHORT1 SHORT2)
                                   `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
                                           ,PROJECT)
                                   GIT-CDBROWSER-SEPARATE-DIRECTIONS
                                   `(Compare See))
-                           (SETQ NENTRIES (LENGTH (FETCH
 (CDVALUE CDENTRIES) OF
 CDVALUE)))
+                           (SETQ NENTRIES (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE)))
                            (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
                                               'difference
                                               'differences))
-                    ELSE
 '(0 differences))
-           ELSE
 '(0 differences])
+                    else
 '(0 differences))
+           else
 '(0 differences])
 
 (GIT-WORKING-COMPARE-DIRECTORIES

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

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

 
     (* ;; "Edited 17-Jun-2023 22:54 by rmk")

@@ -1899,28 +1957,28 @@
 
     (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)
+    (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: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))
+    (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))
-            FIRST
 (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
-                  (BKSYSBUF " ") INSIDE
 SUBDIRS
-            COLLECT
 (TERPRI T)
+              (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 '(> < ~= -* *-))
@@ -1933,24 +1991,24 @@
                                                   (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))
+                  [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))
+                        (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.")

 
                   (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 "         "
+                      [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)
@@ -1961,9 +2019,9 @@
                                        ,@(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]
+                              (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)
@@ -2230,7 +2288,7 @@
                                                              (* ; "Edited  7-Jul-2022 09:36 by rmk")


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


                                                             (* ; "Edited  2-Nov-2021 21:12 by rmk:")

-    (CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH
 GITHOST OF
 PROJECT))
+    (CONCAT "cd " (SLASHIT (TRUEFILENAME (fetch
 GITHOST of
 PROJECT))
                          NIL T)
            " && "])
 
@@ -2246,8 +2304,8 @@
     (CL:UNLESS (OR (EQ 1 (STRPOS "git" CMD))
                    (EQ 1 (STRPOS "gh" CMD)))
         (SETQ CMD (CONCAT "git " CMD)))
-    [BIND
 LPOS WHILE
 (SETQ LPOS (STRPOS "local/" CMD))
-       DO
 (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS))
+    [bind
 LPOS while
 (SETQ LPOS (STRPOS "local/" CMD))
+       do
 (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS))
                            (SUBSTRING CMD (IPLUS LPOS (NCHARS "local/"]
     (LET (LINES (RESULTFILE (GIT-COMMAND-TO-FILE
 CMD PROJECT NOERROR)))
          (CL:WHEN (LISTP RESULTFILE)                         (* ; "CADR is Unix error stream")

@@ -2269,10 +2327,10 @@
     (* ;; "Insures origin/ unless LOCAL or local/ already")

 
     (CL:UNLESS BRANCH (HELP "BRANCH MUST BE SPECIFIED"))
-    (IF
 (OR (STRPOS "origin/" BRANCH)
+    (if
 (OR (STRPOS "origin/" BRANCH)
             (STRPOS "local/" BRANCH))
-        THEN
 BRANCH
-      ELSE
 (CONCAT (CL:IF LOCAL
+        then
 BRANCH
+      else
 (CONCAT (CL:IF LOCAL
                        "local/"
                        "origin/")
                   BRANCH])
@@ -2304,7 +2362,7 @@
            (RESULTFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-result"))
            (ERRORFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-error"))
            COMPLETIONCODE)
-          [SETQ COMPLETIONCODE (PROCESS-COMMAND
 (CONCAT (CDGITDIR
 PROJECT)
+          [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCAT (CDGITDIR
 PROJECT)
                                                        CMD " > " (STRIPHOST
 RESULTFILE)
                                                        " 2> "
                                                        (STRIPHOST
 ERRORFILE]
@@ -2331,12 +2389,12 @@
                                             (FILEPOS "unknown command %"" ESTREAM 0 1)))
                                   (FILEPOS "' is not a git command." ESTREAM (NCHARS CMD)))
                             (SETQ COMPLETIONCODE 1))))
-          (IF
 (EQ 0 COMPLETIONCODE)
-              THEN
 (IF
 (AND RESULTFILE ERRORFILE)
-                       THEN
 (LIST RESULTFILE ERRORFILE)
-                     ELSEIF
 RESULTFILE
-                     ELSE
 ERRORFILE)
-            ELSE
 (DELFILE RESULTFILE)
+          (if
 (EQ 0 COMPLETIONCODE)
+              then
 (if
 (AND RESULTFILE ERRORFILE)
+                       then
 (LIST RESULTFILE ERRORFILE)
+                     elseif
 RESULTFILE
+                     else
 ERRORFILE)
+            else
 (DELFILE RESULTFILE)
                  (DELFILE ERRORFILE)
                  (CL:UNLESS NOERROR
                      (ERROR (CONCAT "Command failed: " CMD)))
@@ -2348,18 +2406,18 @@
     (* ;; "Suppress .git lines unless ALL")

 
     (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT))
-           (BIND
 LINE UNTIL
 (EOFP STREAM) WHEN
 [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P 
+           (bind
 LINE until
 (EOFP STREAM) when
 [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P 
                                                                         NIL :EOF-VALUE NIL))
                                                       (OR ALL (NOT (STRPOS ".git" LINE 1]
-              COLLECT
 LINE])
+              collect
 LINE])
 
 (STRIPLOCAL

   [LAMBDA (STRING)
                                           (* ; "Edited 18-Jul-2022 09:52 by rmk")

 
     (* ;; "Removes local/ substrings wherever they appear.  To be used in coerecing from a lisp internal convention that local branches carry a local tag to the git convention that an unqualified name is local.")

 
-    [BIND
 POS WHILE
 (SETQ POS (STRPOS "local/" STRING))
-       DO
 (SETQ STRING (CONCAT (SUBSTRING STRING 1 (SUB1 POS))
+    [bind
 POS while
 (SETQ POS (STRPOS "local/" STRING))
+       do
 (SETQ STRING (CONCAT (SUBSTRING STRING 1 (SUB1 POS))
                               (OR (SUBSTRING STRING (IPLUS POS (CONSTANT (NCHARS "local/")))
                                          -1)
                                   ""]
@@ -2368,33 +2426,33 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4348 20927 (GIT-CLONEP 4358 . 5686) (GIT-INIT 5688 . 6318) (GIT-MAKE-PROJECT 6320 . 
-13985) (GIT-GET-PROJECT 13987 . 15912) (GIT-PUT-PROJECT-FIELD 15914 . 17555) (GIT-PROJECT-PATH 17557
- . 18601) (FIND-ANCESTOR-DIRECTORY 18603 . 18952) (GIT-FIND-CLONE 18954 . 20035) (GIT-MAINBRANCH 20037
- . 20432) (GIT-MAINBRANCH? 20434 . 20925)) (26376 30458 (PRC-COMMAND 26386 . 30456)) (30514 33302 (
-ALLSUBDIRS 30524 . 31810) (MEDLEYSUBDIRS 31812 . 32505) (GITSUBDIRS 32507 . 33300)) (33303 38093 (
-TOGIT 33313 . 34719) (FROMGIT 34721 . 35702) (GIT-DELETE-FILE 35704 . 36550) (MYMEDLEY-DELETE-FILES 
-36552 . 38091)) (38094 41097 (MYMEDLEYSUBDIR 38104 . 38560) (GITSUBDIR 38562 . 39005) (STRIPDIR 39007
- . 39378) (STRIPHOST 39380 . 39620) (STRIPNAME 39622 . 40375) (STRIPWHERE 40377 . 41095)) (41098 43000
- (GFILE4MFILE 41108 . 41471) (MFILE4GFILE 41473 . 42042) (GIT-REPO-FILENAME 42044 . 42998)) (43049 
-53300 (GIT-COMMIT 43059 . 43885) (GIT-PUSH 43887 . 44647) (GIT-PULL 44649 . 45401) (GIT-APPROVAL 45403
- . 45752) (GIT-GET-FILE 45754 . 47776) (GIT-FILE-EXISTS? 47778 . 48052) (GIT-REMOTE-UPDATE 48054 . 
-48778) (GIT-REMOTE-ADD 48780 . 49087) (GIT-FILE-DATE 49089 . 50136) (GIT-FILE-HISTORY 50138 . 52072) (
-GIT-PRINT-FILE-HISTORY 52074 . 53124) (GIT-FETCH 53126 . 53298)) (53330 64103 (GIT-BRANCH-DIFF 53340
- . 59740) (GIT-COMMIT-DIFFS 59742 . 60415) (GIT-BRANCH-RELATIONS 60417 . 64101)) (64148 80865 (
-GIT-BRANCH-NUM 64158 . 64731) (GIT-CHECKOUT 64733 . 65908) (GIT-WHICH-BRANCH 65910 . 66208) (
-GIT-MAKE-BRANCH 66210 . 68539) (GIT-BRANCHES 68541 . 71031) (GIT-BRANCH-EXISTS? 71033 . 71904) (
-GIT-PICK-BRANCH 71906 . 72396) (GIT-BRANCH-MENU 72398 . 73279) (GIT-BRANCH-WHENSELECTEDFN 73281 . 
-74916) (GIT-PULL-REQUESTS 74918 . 77527) (GIT-SHORT-BRANCH-NAME 77529 . 77820) (GIT-LONG-NAME 77822 . 
-78139) (GIT-PRC-BRANCHES 78141 . 80863)) (80895 84230 (GIT-MY-CURRENT-BRANCH 80905 . 81275) (
-GIT-MY-BRANCHP 81277 . 81782) (GIT-MY-NEXT-BRANCH 81784 . 82278) (GIT-MY-BRANCHES 82280 . 84228)) (
-84276 88351 (GIT-ADD-WORKTREE 84286 . 85893) (GIT-REMOVE-WORKTREE 85895 . 86825) (GIT-LIST-WORKTREES 
-86827 . 87631) (WORKTREEDIR 87633 . 88349)) (88399 121103 (GIT-GET-DIFFERENT-FILES 88409 . 94833) (
-GIT-BRANCHES-COMPARE-DIRECTORIES 94835 . 101688) (GIT-WORKING-COMPARE-DIRECTORIES 101690 . 107086) (
-GIT-COMPARE-WORKTREE 107088 . 111066) (GITCDOBJBUTTONFN 111068 . 115558) (GIT-CD-LABELFN 115560 . 
-116642) (GIT-CD-MENUFN 116644 . 119084) (GIT-WORKING-COMPARE-FILES 119086 . 119706) (
-GIT-BRANCHES-COMPARE-FILES 119708 . 120872) (GIT-PR-COMPARE 120874 . 121101)) (121173 129202 (CDGITDIR
- 121183 . 121870) (GIT-COMMAND 121872 . 123430) (GITORIGIN 123432 . 124129) (GIT-INITIALS 124131 . 
-124435) (GIT-COMMAND-TO-FILE 124437 . 127926) (GIT-RESULT-TO-LINES 127928 . 128535) (STRIPLOCAL 128537
- . 129200)))))
+  (FILEMAP (NIL (4636 21215 (GIT-CLONEP 4646 . 5974) (GIT-INIT 5976 . 6606) (GIT-MAKE-PROJECT 6608 . 
+14273) (GIT-GET-PROJECT 14275 . 16200) (GIT-PUT-PROJECT-FIELD 16202 . 17843) (GIT-PROJECT-PATH 17845
+ . 18889) (FIND-ANCESTOR-DIRECTORY 18891 . 19240) (GIT-FIND-CLONE 19242 . 20323) (GIT-MAINBRANCH 20325
+ . 20720) (GIT-MAINBRANCH? 20722 . 21213)) (26678 31300 (PRC-COMMAND 26688 . 31298)) (31356 34144 (
+ALLSUBDIRS 31366 . 32652) (MEDLEYSUBDIRS 32654 . 33347) (GITSUBDIRS 33349 . 34142)) (34145 38935 (
+TOGIT 34155 . 35561) (FROMGIT 35563 . 36544) (GIT-DELETE-FILE 36546 . 37392) (MYMEDLEY-DELETE-FILES 
+37394 . 38933)) (38936 41939 (MYMEDLEYSUBDIR 38946 . 39402) (GITSUBDIR 39404 . 39847) (STRIPDIR 39849
+ . 40220) (STRIPHOST 40222 . 40462) (STRIPNAME 40464 . 41217) (STRIPWHERE 41219 . 41937)) (41940 43842
+ (GFILE4MFILE 41950 . 42313) (MFILE4GFILE 42315 . 42884) (GIT-REPO-FILENAME 42886 . 43840)) (43891 
+54253 (GIT-COMMIT 43901 . 44727) (GIT-PUSH 44729 . 45489) (GIT-PULL 45491 . 46243) (GIT-APPROVAL 46245
+ . 46594) (GIT-GET-FILE 46596 . 48618) (GIT-FILE-EXISTS? 48620 . 48894) (GIT-REMOTE-UPDATE 48896 . 
+49731) (GIT-REMOTE-ADD 49733 . 50040) (GIT-FILE-DATE 50042 . 51089) (GIT-FILE-HISTORY 51091 . 53025) (
+GIT-PRINT-FILE-HISTORY 53027 . 54077) (GIT-FETCH 54079 . 54251)) (54283 65403 (GIT-BRANCH-DIFF 54293
+ . 61040) (GIT-COMMIT-DIFFS 61042 . 61715) (GIT-BRANCH-RELATIONS 61717 . 65401)) (65448 84460 (
+GIT-BRANCH-NUM 65458 . 66031) (GIT-CHECKOUT 66033 . 67319) (GIT-WHICH-BRANCH 67321 . 67728) (
+GIT-MAKE-BRANCH 67730 . 70309) (GIT-BRANCHES 70311 . 72906) (GIT-BRANCH-EXISTS? 72908 . 73779) (
+GIT-PICK-BRANCH 73781 . 74271) (GIT-BRANCH-MENU 74273 . 75154) (GIT-BRANCH-WHENSELECTEDFN 75156 . 
+77321) (GIT-PULL-REQUESTS 77323 . 80841) (GIT-SHORT-BRANCH-NAME 80843 . 81134) (GIT-LONG-NAME 81136 . 
+81453) (GIT-PRC-BRANCHES 81455 . 84458)) (84490 87938 (GIT-MY-CURRENT-BRANCH 84500 . 84870) (
+GIT-MY-BRANCHP 84872 . 85490) (GIT-MY-NEXT-BRANCH 85492 . 85986) (GIT-MY-BRANCHES 85988 . 87936)) (
+87984 92059 (GIT-ADD-WORKTREE 87994 . 89601) (GIT-REMOVE-WORKTREE 89603 . 90533) (GIT-LIST-WORKTREES 
+90535 . 91339) (WORKTREEDIR 91341 . 92057)) (92107 125241 (GIT-GET-DIFFERENT-FILES 92117 . 98541) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 98543 . 105774) (GIT-WORKING-COMPARE-DIRECTORIES 105776 . 111224) (
+GIT-COMPARE-WORKTREE 111226 . 115204) (GITCDOBJBUTTONFN 115206 . 119696) (GIT-CD-LABELFN 119698 . 
+120780) (GIT-CD-MENUFN 120782 . 123222) (GIT-WORKING-COMPARE-FILES 123224 . 123844) (
+GIT-BRANCHES-COMPARE-FILES 123846 . 125010) (GIT-PR-COMPARE 125012 . 125239)) (125311 133336 (CDGITDIR
+ 125321 . 126008) (GIT-COMMAND 126010 . 127568) (GITORIGIN 127570 . 128267) (GIT-INITIALS 128269 . 
+128573) (GIT-COMMAND-TO-FILE 128575 . 132060) (GIT-RESULT-TO-LINES 132062 . 132669) (STRIPLOCAL 132671
+ . 133334)))))
 STOP

lispusers/JSON

@@ -1,15 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-Apr-2024 14:42:30" {WMEDLEY}<lispusers>JSON.;31
 9030   
+
(FILECREATED "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36
 9198   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS JSON-STRING JSON-GET JSON-VALUE JSON-ARRAY JSON-OBJECT JSON-AVPAIR JSON-NUMBER
-                       JSON-ATOM JSSKIP JSON-SKIP JSON-PARSE)
-                  (VARS JSONCOMS)
-                  (MACROS JSBIN JSPEEK JSBINC JSPEEKC)
+      :CHANGES-TO (FNS JSON-GET)
 
-      :PREVIOUS-DATE "30-Apr-2024 00:54:21" {WMEDLEY}<lispusers>JSON.;9)
+      :PREVIOUS-DATE "13-May-2024 19:23:02" {WMEDLEY}<lispusers>JSON.;33)
 
 
 (PRETTYCOMPRINT JSONCOMS)
@@ -180,11 +177,14 @@
          NIL])
 
 (JSON-GET

-  [LAMBDA (OBJECT ATTRIBUTE)
                                 (* ; "Edited 30-Apr-2024 14:26 by rmk")

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


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

 
-    (* ;; "Returns the value of ATTRIBUTE in OBJECT")

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

 
-    (CADR (ASSOC ATTRIBUTE 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])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -201,7 +201,7 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (778 8671 (JSON-PARSE 788 . 1134) (JSON-VALUE 1136 . 1505) (JSON-SKIP 1507 . 1781) (
-JSON-STRING 1783 . 2581) (JSON-ARRAY 2583 . 3721) (JSON-OBJECT 3723 . 5180) (JSON-AVPAIR 5182 . 5624) 
-(JSON-NUMBER 5626 . 7140) (JSON-ATOM 7142 . 8449) (JSON-GET 8451 . 8669)))))
+  (FILEMAP (NIL (559 8839 (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)))))
 STOP

lispusers/MANAGER

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Oct-2023 16:41:52" {LU}MANAGER.;3
 112648 
+
(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4
 102968 
 
       :EDIT-BY "mth"
 
       :CHANGES-TO (FNS Manager.DO.COMMAND)
-                  (VARS MANAGERCOMS MANAGER-FILE-OPERATIONS-COMMANDS)
 
-      :PREVIOUS-DATE "10-Oct-2023 11:27:25" {LU}MANAGER.;1)
+      :PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3)
 
 
 (PRETTYCOMPRINT MANAGERCOMS)
@@ -82,15 +81,15 @@
                COMMON-MAKE)
                                                              (* ; "FILEBROWSER for SEE command")

         (FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING 
-             Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT 
-             Manager.WINDOW Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE 
-             Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE 
-             Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED?
-             Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE? 
-             Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN 
-             Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM 
-             Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS 
-             Manager.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
+             Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.DO.COMMAND.PROCFN 
+             Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW Manager.insurefilehighlights 
+             Manager.CHANGED? Manager.CHECKFILE Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN
+             Manager.COMSUPDATE Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES 
+             Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE 
+             Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS 
+             Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS 
+             Manager.MENUHASITEM Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE 
+             Manager.RESETSUBITEMS Manager.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
         (ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS 
                DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN 
                                                                          DEFAULT.EDITDEFA0001))
@@ -563,7 +562,9 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
                 YCOORD _ YPOS])
 
 (Manager.DO.COMMAND

-  [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU)
                  (* ; "Edited 13-Oct-2023 16:28 by mth")

+  [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU)
                  (* ; "Edited 21-May-2024 17:56 by mth")


+                                                             (* ; "Edited 17-May-2024 09:41 by mth")


+                                                             (* ; "Edited 13-Oct-2023 16:28 by mth")

     (if
 (EQ COMSTYPE 'FILEVARS)
         then
 (SETQ COMSTYPE 'VARS)                           (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.")

         )
@@ -573,386 +574,321 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
                                            then
 (Manager.GET.ENVIRONMENT
 FILE)
                                          else
 (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE* 
                                                      *READ-BASE*))
-                                                             (* ; "SEdit does not use *package*. ")

+
+                  (* ;; "SEdit does not use *package*. ")

+
                   [COND
                      ((EQ COMSTYPE 'FILES)
                       (ED ITEM 'PROPERTY-LIST))
                      ((NULL COMSTYPE)
                       (EDITDEF 'FILELST 'VARS))
                      (T (EDITDEF ITEM COMSTYPE NIL NIL '(:DONTWAIT]))
-        (ADD.PROCESS
-         `[CL:APPLY
-           ',[FUNCTION (LAMBDA (COMMAND ITEM COMSTYPE FILE MENU)
-                         (WITH-READER-ENVIRONMENT (if
 FILE
-                                                      then
 (Manager.GET.ENVIRONMENT
 FILE)
-                                                    else
 (MAKE-READER-ENVIRONMENT *PACKAGE* 
-                                                                *READTABLE* *READ-BASE*))
-                             [LET
-                              ((ACTIVITY-WINDOW NIL)
-                               (ACTIVITY-WINDOW-WAS-SHRUNK NIL))
-                              (RESETLST
-                                  (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
-                                  [if
 [NOT (FMEMB COMMAND
-                                                  '(BREAK TRACE UNBREAK CHANGED DELETED DEFINED 
-                                                          UNMARK SEE LIST HARDCOPY REMOVE NIL]
-                                      then
                   (* ; "steal the TTY, if we really need it (there are also further complementary lists at the bottom of the following BLOCK).")

-                                           (TTYDISPLAYSTREAM (SETQ ACTIVITY-WINDOW (Manager.WINDOW
)))
-                                           (SETQ ACTIVITY-WINDOW-WAS-SHRUNK (NOT (OPENWP 
-                                                                                      ACTIVITY-WINDOW
-                                                                                        ]
-                                  (CL:BLOCK NIL
-                                      (CL:ECASE COMMAND
-                                          (READVISE (APPLY* (FUNCTION READVISE)
-                                                           ITEM))
-                                          (UNADVISE (APPLY* (FUNCTION UNADVISE)
-                                                           ITEM))
-                                          (SHOWADVICE 
-                                             (printout T .FONT LAMBDAFONT 
-                                                    "Advised and traced fns and functions:" .FONT 
-                                                    DEFAULTFONT T)
-                                             (for
 ITEM in
 ADVISEDFNS
-                                                do
 (printout T 10 ITEM T)))
-                                          (RESET (COND
-                                                    ((MOUSECONFIRM 
-                                                       "Reset the Manager destroying all the menus? "
-                                                            NIL T)
-                                                     (CL:FORMAT T 
-                                "Expunging and reconstructing the Manager's menus~%%Please Stand By."
-                                                            )
-                                                     (MANAGER.RESET
 T)
-                                                     (CL:FORMAT T "~&Done.~%%-----")
-                                                     (CLOSEW T))))
-                                          (QUIT (COND
-                                                   ((MOUSECONFIRM "Quit the Manager? " NIL T)
-                                                    (Manager.MAINCLOSE
 T)
-                                                    (CLOSEW T))))
-                                          (RELOAD 
-                                             (CL:FORMAT T "~&Loading ~A definition of ~S from ~A." 
-                                                    ITEM COMSTYPE FILE)
-                                             (LOADDEF ITEM COMSTYPE FILE))
-                                          (SHOWDEF 
-                                             (printout T .FONT LAMBDAFONT COMSTYPE " definition of "
-                                                    ITEM .FONT DEFAULTFONT " (source file format):" T
-                                                    )
-                                             (SHOWDEF ITEM COMSTYPE))
-                                          (BREAK (APPLY* 'BREAK ITEM))
-                                          (TRACE (EVAL (LIST 'TRACE ITEM)))
-                                          (UNBREAK (EVAL (LIST 'UNBREAK ITEM)))
-                                          (DISASSEMBLE 
-                                             (printout T .FONT LAMBDAFONT "Compiled code for " ITEM 
-                                                    ":" .FONT DEFAULTFONT T)
-                                             (INSPECTCODE ITEM))
-                                          (PV (printout T .FONT LAMBDAFONT "Value of " ITEM ":" .FONT
-                                                     DEFAULTFONT T (if
 (BOUNDP ITEM)
-                                                                       then
 (EVAL ITEM)
-                                                                     else
 "Not bound!")))
-                                          (PF 
-                                             (printout T .FONT LAMBDAFONT "Function definition of " 
-                                                    ITEM ":" .FONT DEFAULTFONT T)
-                                             (PF ITEM))
-                                          (PL 
-                                             (printout T .FONT LAMBDAFONT "Property list for " ITEM 
-                                                    ":" .FONT DEFAULTFONT T)
-                                             (PRINTPROPS (if
 (EQ COMSTYPE 'PROPS)
-                                                             then
 (CAR ITEM)
-                                                           else
 ITEM)))
-                                          (CLDESCRIBE 
-                                             (printout T .FONT LAMBDAFONT "Description of " ITEM ":"
-                                                    .FONT DEFAULTFONT T)
-                                             (CL:DESCRIBE ITEM))
-                                          (CLDOC 
-                                             (printout T .FONT LAMBDAFONT "Documentation for " ITEM 
-                                                    ":" .FONT DEFAULTFONT T)
-                                             (CL:DOCUMENTATION ITEM))
-                                          (FIELDS (printout T .FONT LAMBDAFONT "Fields of " ITEM ":"
-                                                         .FONT DEFAULTFONT T (REVERSE (
-                                                                                     RECORDFIELDNAMES
-                                                                                       ITEM))))
-                                          (ARGS (printout T .FONT LAMBDAFONT "Arguments of " ITEM 
-                                                       ": " .FONT DEFAULTFONT T 10 (SMARTARGLIST
-                                                                                    ITEM)
-                                                       T))
-                                          (EDITCALLERS (EDITCALLERS ITEM FILE))
-                                          (COPYDEF (LET [(FILENAME (Manager.PROMPT
 (CONCAT "Rename "
-                                                                                          ITEM 
-                                                                                          " to: "]
-                                                        (if
 FILENAME
-                                                            then
 (COPYDEF ITEM FILENAME COMSTYPE))))
-                                          (RENAME (LET [(FILENAME (Manager.PROMPT
 (CONCAT "Rename " 
-                                                                                         ITEM " to: "
-                                                                                         ]
-                                                       (if
 FILENAME
-                                                           then
 (RENAME ITEM FILENAME COMSTYPE FILE))
-                                                       ))
-                                          (RENAME-ALL (LET [(FILENAME (Manager.PROMPT
 (CONCAT 
-                                                                                            "Rename "
-                                                                                             ITEM 
-                                                                                             " to: "]
-                                                           (if
 FILENAME
-                                                               then
 (RENAME ITEM FILENAME COMSTYPE 
-                                                                           FILELST))))
-                                          (DELETE (if
 (MOUSECONFIRM (CONCAT "DELETE the " COMSTYPE 
-                                                                           " " ITEM " from " FILE "?"
-                                                                           ))
-                                                      then
 (DELFROMFILES ITEM COMSTYPE FILE)))
-                                          (LOAD (LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
-                                                     (if
 FILENAME
-                                                         then
 (LOAD FILENAME))))
-                                          (LOADFNSLATER [LET ((FILENAME (Manager.PROMPT
 "Filename: ")
-                                                                     ))
-                                                             (if
 FILENAME
-                                                                 then
 (LOADFNS NIL FILENAME
-                                                                             'ALLPROP
-                                                                             'VARS])
-                                          (LOADFNSNOW [LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
-                                                           (if
 FILENAME
-                                                               then
 (LOADFNS T FILENAME 'ALLPROP
-                                                                           'VARS])
-                                          (LOADFROMLATER (LET ((FILENAME (Manager.PROMPT
 "Filename: "
-                                                                                )))
-                                                              (if
 FILENAME
-                                                                  then
 (LOADFROM FILENAME))))
-                                          (LOADFROMNOW (LET ((FILENAME (Manager.PROMPT
 "Filename: "))
-                                                             )
-                                                            (if
 FILENAME
-                                                                then
 (LOADFROM FILENAME T))))
-                                          (ADDFILE (LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
-                                                        (if
 FILENAME
-                                                            then
 (ADDFILE FILENAME))))
-                                          (SYSLOAD [COND
-                                                      ((MOUSECONFIRM (CONCAT 
-                                                                     "Do you really want to SYSLOAD "
-                                                                            FILE "?" NIL T))
-                                                       NIL
-                                                       (LOAD FILE 'SYSLOAD])
-                                          (MOVE (LET [(ANSWER (Manager.GETFILE
 (CONCAT 
-                                                                                      "File to move "
-                                                                                      COMSTYPE " " 
-                                                                                      ITEM " to"]
-                                                     (AND ANSWER (MOVETOFILE ANSWER ITEM COMSTYPE 
-                                                                        FILE))))
-                                          (COPY (LET [(ANSWER (Manager.GETFILE
 (CONCAT 
-                                                                                      "File to copy "
-                                                                                      COMSTYPE " " 
-                                                                                      ITEM " to"]
-                                                     (AND ANSWER (ADDTOFILE ITEM COMSTYPE ANSWER))))
-                                          ((CHANGED DELETED DEFINED) 
-                                             (if
 COMSTYPE
-                                                 then
 (MARKASCHANGED ITEM COMSTYPE COMMAND)
-                                               else
 (MARKASCHANGED (FILECOMS ITEM)
-                                                           'VARS COMMAND)
-                                                    (UPDATEFILES) 
-                                                             (* ; "This is needed because the main menu is a special case.  Its not in the open windows list, nor does it carry %"type%" information (like that it contains filevars).")

-                                                 ))
-                                          (UNMARK (if
 (EQ COMSTYPE 'FILES)
-                                                      then
   (* ; "whole file")

-                                                           (COND
-                                                              ((MOUSECONFIRM (CONCAT 
-                                                                         "Unmark entire contents of "
-                                                                                    FILE "?" NIL T))
-                                                               (/RPLACD (GETPROP FILE 'FILE)
-                                                                      NIL)
-                                                               (Manager.insurefilehighlights
 FILE)
-                                                               (Manager.HIGHLIGHT
 FILE MENU)))
-                                                    else
     (* ; "single item")

-                                                         (UNMARKASCHANGED ITEM COMSTYPE)))
-                                          (SEE (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
-                                                                   FILE)))
+        (ADD.PROCESS `[CL:APPLY #'Manager.DO.COMMAND.PROCFN '(,COMMAND ,ITEM ,COMSTYPE ,FILE
+                                                                    ,MENU]
+               'NAME
+               'MANAGER-COMMAND))
+    NIL])
 
-                                                    (* ;; 
+(Manager.DO.COMMAND.PROCFN

+  [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU)
                  (* ; "Edited 20-May-2024 11:15 by mth")

+    (WITH-READER-ENVIRONMENT (if
 FILE
+                                 then
 (Manager.GET.ENVIRONMENT
 FILE)
+                               else
 (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE* *READ-BASE*))
+        [LET
+         ((ACTIVITY-WINDOW NIL)
+          (ACTIVITY-WINDOW-WAS-SHRUNK NIL))
+         (RESETLST
+             (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
+             [if
 [NOT (FMEMB COMMAND
+                             '(BREAK TRACE UNBREAK CHANGED DELETED DEFINED UNMARK SEE LIST HARDCOPY 
+                                     REMOVE NIL]
+                 then
                                        (* ; "steal the TTY, if we really need it (there are also further complementary lists at the bottom of the following BLOCK).")

+                      (TTYDISPLAYSTREAM (SETQ ACTIVITY-WINDOW (Manager.WINDOW
)))
+                      (SETQ ACTIVITY-WINDOW-WAS-SHRUNK (NOT (OPENWP ACTIVITY-WINDOW]
+             (CL:BLOCK NIL
+                 (CL:ECASE COMMAND
+                     (READVISE (APPLY* (FUNCTION READVISE)
+                                      ITEM))
+                     (UNADVISE (APPLY* (FUNCTION UNADVISE)
+                                      ITEM))
+                     (SHOWADVICE 
+                        (printout T .FONT LAMBDAFONT "Advised and traced fns and functions:" .FONT 
+                               DEFAULTFONT T)
+                        (for
 ITEM in
 ADVISEDFNS do
 (printout T 10 ITEM T)))
+                     (RESET (COND
+                               ((MOUSECONFIRM "Reset the Manager destroying all the menus? " NIL T)
+                                (CL:FORMAT T 
+                                "Expunging and reconstructing the Manager's menus~%%Please Stand By."
+                                       )
+                                (MANAGER.RESET
 T)
+                                (CL:FORMAT T "~&Done.~%%-----")
+                                (CLOSEW T))))
+                     (QUIT (COND
+                              ((MOUSECONFIRM "Quit the Manager? " NIL T)
+                               (Manager.MAINCLOSE
 T)
+                               (CLOSEW T))))
+                     (RELOAD 
+                        (CL:FORMAT T "~&Loading ~A definition of ~S from ~A." ITEM COMSTYPE FILE)
+                        (LOADDEF ITEM COMSTYPE FILE))
+                     (SHOWDEF 
+                        (printout T .FONT LAMBDAFONT COMSTYPE " definition of " ITEM .FONT 
+                               DEFAULTFONT " (source file format):" T)
+                        (SHOWDEF ITEM COMSTYPE))
+                     (BREAK (APPLY* 'BREAK ITEM))
+                     (TRACE (EVAL (LIST 'TRACE ITEM)))
+                     (UNBREAK (EVAL (LIST 'UNBREAK ITEM)))
+                     (DISASSEMBLE 
+                        (printout T .FONT LAMBDAFONT "Compiled code for " ITEM ":" .FONT DEFAULTFONT
+                               T)
+                        (INSPECTCODE ITEM))
+                     (PV (printout T .FONT LAMBDAFONT "Value of " ITEM ":" .FONT DEFAULTFONT T
+                                (if
 (BOUNDP ITEM)
+                                    then
 (EVAL ITEM)
+                                  else
 "Not bound!")))
+                     (PF 
+                        (printout T .FONT LAMBDAFONT "Function definition of " ITEM ":" .FONT 
+                               DEFAULTFONT T)
+                        (APPLY* #'PF ITEM))
+                     (PL 
+                        (printout T .FONT LAMBDAFONT "Property list for " ITEM ":" .FONT DEFAULTFONT
+                               T)
+                        (PRINTPROPS (if
 (EQ COMSTYPE 'PROPS)
+                                        then
 (CAR ITEM)
+                                      else
 ITEM)))
+                     (CLDESCRIBE 
+                        (printout T .FONT LAMBDAFONT "Description of " ITEM ":" .FONT DEFAULTFONT T)
+                        (CL:DESCRIBE ITEM))
+                     (CLDOC (printout T .FONT LAMBDAFONT "Documentation for " ITEM ":" .FONT 
+                                   DEFAULTFONT T (CL:DOCUMENTATION ITEM)))
+                     (FIELDS (printout T .FONT LAMBDAFONT "Fields of " ITEM ":" .FONT DEFAULTFONT T
+                                    (REVERSE (RECORDFIELDNAMES ITEM))))
+                     (ARGS (printout T .FONT LAMBDAFONT "Arguments of " ITEM ": " .FONT DEFAULTFONT T
+                                  10 (SMARTARGLIST ITEM)
+                                  T))
+                     (EDITCALLERS (EDITCALLERS ITEM FILE))
+                     (COPYDEF (LET [(FILENAME (Manager.PROMPT
 (CONCAT "Copy " ITEM " as name: "]
+                                   (if
 FILENAME
+                                       then
 (COPYDEF ITEM FILENAME COMSTYPE))))
+                     (RENAME (LET [(FILENAME (Manager.PROMPT
 (CONCAT "Rename " ITEM " to: "]
+                                  (if
 FILENAME
+                                      then
 (RENAME ITEM FILENAME COMSTYPE FILE))))
+                     (RENAME-ALL (LET [(FILENAME (Manager.PROMPT
 (CONCAT 
+                                                                      "Rename (in ALL loaded files) "
+                                                                        ITEM " to: "]
+                                      (if
 FILENAME
+                                          then
 (RENAME ITEM FILENAME COMSTYPE FILELST))))
+                     (DELETE (if
 (MOUSECONFIRM (CONCAT "DELETE the " COMSTYPE " " ITEM " from " FILE
+                                                      "?"))
+                                 then
 (DELFROMFILES ITEM COMSTYPE FILE)))
+                     (LOAD (LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
+                                (if
 FILENAME
+                                    then
 (LOAD FILENAME))))
+                     (LOADFNSLATER [LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
+                                        (if
 FILENAME
+                                            then
 (LOADFNS NIL FILENAME 'ALLPROP 'VARS])
+                     (LOADFNSNOW [LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
+                                      (if
 FILENAME
+                                          then
 (LOADFNS T FILENAME 'ALLPROP 'VARS])
+                     (LOADFROMLATER (LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
+                                         (if
 FILENAME
+                                             then
 (LOADFROM FILENAME))))
+                     (LOADFROMNOW (LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
+                                       (if
 FILENAME
+                                           then
 (LOADFROM FILENAME T))))
+                     (ADDFILE (LET ((FILENAME (Manager.PROMPT
 "Filename: ")))
+                                   (if
 FILENAME
+                                       then
 (ADDFILE FILENAME))))
+                     (SYSLOAD [COND
+                                 ((MOUSECONFIRM (CONCAT "Do you really want to SYSLOAD " FILE "?" NIL
+                                                       T))
+                                  NIL
+                                  (LOAD FILE 'SYSLOAD])
+                     (MOVE (LET [(ANSWER (Manager.GETFILE
 (CONCAT "File to move " COMSTYPE " " ITEM 
+                                                                 " to"]
+                                (AND ANSWER (MOVETOFILE ANSWER ITEM COMSTYPE FILE))))
+                     (COPY (LET [(ANSWER (Manager.GETFILE
 (CONCAT "File to copy " COMSTYPE " " ITEM 
+                                                                 " to"]
+                                (AND ANSWER (ADDTOFILE ITEM COMSTYPE ANSWER))))
+                     ((CHANGED DELETED DEFINED) (if
 COMSTYPE
+                                                    then
 (MARKASCHANGED ITEM COMSTYPE COMMAND)
+                                                  else
 (MARKASCHANGED (FILECOMS ITEM)
+                                                              'VARS COMMAND)
+                                                       (UPDATEFILES) 
+                                                             (* ; "This is needed because the main menu is a special case.  Its not in the open windows list, nor does it carry %"type%" information (like that it contains filevars).")

+                                                    ))
+                     (UNMARK (if
 (EQ COMSTYPE 'FILES)
+                                 then
                        (* ; "whole file")

+                                      (COND
+                                         ((MOUSECONFIRM (CONCAT "Unmark entire contents of " FILE "?"
+                                                               NIL T))
+                                          (/RPLACD (GETPROP FILE 'FILE)
+                                                 NIL)
+                                          (Manager.insurefilehighlights
 FILE)
+                                          (Manager.HIGHLIGHT
 FILE MENU)))
+                               else
                          (* ; "single item")

+                                    (UNMARKASCHANGED ITEM COMSTYPE)))
+                     (SEE (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
+                                              FILE)))
+
+                               (* ;; 
 
                              "I'm assuming that the CAR of the FILEDATES list is the most recent...")

 
-                                                    (FB.FASTSEE.ONEFILE
-                                                     NIL FULLNAME
-                                                     (LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME
-                                                                                  "..."]
-                                                          (DSPSCROLL 'ON W)
-                                                          (WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
-                                                          (TTYDISPLAYSTREAM W)
-                                                          W))))
-                                          (TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES))
-                                                                    FILE)))
-                                          (LOAD 
-                                             (printout T .FONT LAMBDAFONT "Loading file " FILE "." 
-                                                    .FONT DEFAULTFONT T)
-                                             (LOAD FILE))
-                                          ((MAKEFILE NEW FAST) 
-                                             (if
 FILE
-                                                 then
 (printout T .FONT LAMBDAFONT "Writing file " 
-                                                             FILE "." .FONT DEFAULTFONT T)
-                                                      (PRINT (MAKEFILE
-                                                              FILE
-                                                              (if
 (EQ COMMAND 'MAKEFILE)
-                                                                  then
 NIL
-                                                                else
 COMMAND))
-                                                             T)
-                                               else
 (printout T .FONT LAMBDAFONT "Writing files ")
-                                                    [PRINT (MAKEFILES
-                                                            (if
 (EQ COMMAND 'MAKEFILE)
-                                                                then
 NIL
-                                                              else
 (LIST COMMAND]
-                                                    (printout T .FONT DEFAULTFONT T)))
-                                          (COMMON-MAKEFILE (if
 FILE
-                                                               then
 (printout T .FONT LAMBDAFONT 
-                                                                    "Writing CommonLisp source into "
-                                                                           FILE ".LSP" .FONT 
-                                                                           DEFAULTFONT T)
-                                                                    (PRINT (COMMON-MAKEFILE FILE)
-                                                                           T)
-                                                             else
 (CL:FORMAT T 
+                               (FB.FASTSEE.ONEFILE NIL FULLNAME
+                                      (LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME "..."]
+                                           (DSPSCROLL 'ON W)
+                                           (WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
+                                           (TTYDISPLAYSTREAM W)
+                                           W))))
+                     (TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES))
+                                               FILE)))
+                     (LOAD 
+                        (printout T .FONT LAMBDAFONT "Loading file " FILE "." .FONT DEFAULTFONT T)
+                        (LOAD FILE))
+                     ((MAKEFILE NEW FAST) 
+                        (if
 FILE
+                            then
 (printout T .FONT LAMBDAFONT "Writing file " FILE "." .FONT 
+                                        DEFAULTFONT T)
+                                 (PRINT (MAKEFILE FILE (if
 (EQ COMMAND 'MAKEFILE)
+                                                           then
 NIL
+                                                         else
 COMMAND))
+                                        T)
+                          else
 (printout T .FONT LAMBDAFONT "Writing files ")
+                               [PRINT (MAKEFILES (if
 (EQ COMMAND 'MAKEFILE)
+                                                     then
 NIL
+                                                   else
 (LIST COMMAND]
+                               (printout T .FONT DEFAULTFONT T)))
+                     (COMMON-MAKEFILE (if
 FILE
+                                          then
 (printout T .FONT LAMBDAFONT 
+                                                      "Writing CommonLisp source into " FILE ".LSP" 
+                                                      .FONT DEFAULTFONT T)
+                                               (PRINT (COMMON-MAKEFILE FILE)
+                                                      T)
+                                        else
 (CL:FORMAT T 
                                           "~&CommonLispify must be selected separately for each file"
-                                                                         )))
-                                          ((LIST HARDCOPY) (LISTFILES1 FILE))
-                                          ((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (
-
                                                                                   Manager.SET-ANCHOR

-                                                                                      COMMAND))
-                                          (CLEANUP 
-                                             (printout T .FONT LAMBDAFONT "Cleanup..." .FONT 
-                                                    DEFAULTFONT T)
+                                                    )))
+                     ((LIST HARDCOPY) (LISTFILES1 FILE))
+                     ((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (Manager.SET-ANCHOR
 COMMAND))
+                     (CLEANUP 
+                        (printout T .FONT LAMBDAFONT "Cleanup..." .FONT DEFAULTFONT T)
                                                              (* ; 
 
                                     "These are different, presumably because CLEANUP is an NLAMBDA.")

-                                             (if
 FILE
-                                                 then
 (APPLY* (FUNCTION CLEANUP)
-                                                             FILE)
-                                               else
 (CLEANUP)))
-                                          (CLEANUPT (printout T .FONT LAMBDAFONT 
-                                                           "Changing default cleanup compiler:" .FONT
-                                                           DEFAULTFONT T "Old value " 
-                                                           *DEFAULT-CLEANUP-COMPILER* T "New value: "
-                                                           (SETQ *DEFAULT-CLEANUP-COMPILER*
-                                                            'TCOMPL)
-                                                           T))
-                                          (CLEANUPC (printout T .FONT LAMBDAFONT 
-                                                           "Changing default cleanup compiler:" .FONT
-                                                           DEFAULTFONT T "Old value " 
-                                                           *DEFAULT-CLEANUP-COMPILER* T "New value: "
-                                                           (SETQ *DEFAULT-CLEANUP-COMPILER*
-                                                            'COMPILE-FILE)
-                                                           T))
+                        (if
 FILE
+                            then
 (APPLY* (FUNCTION CLEANUP)
+                                        FILE)
+                          else
 (CLEANUP)))
+                     (CLEANUPT (printout T .FONT LAMBDAFONT "Changing default cleanup compiler:" 
+                                      .FONT DEFAULTFONT T "Old value " *DEFAULT-CLEANUP-COMPILER* T 
+                                      "New value: " (SETQ *DEFAULT-CLEANUP-COMPILER* 'TCOMPL)
+                                      T))
+                     (CLEANUPC (printout T .FONT LAMBDAFONT "Changing default cleanup compiler:" 
+                                      .FONT DEFAULTFONT T "Old value " *DEFAULT-CLEANUP-COMPILER* T 
+                                      "New value: " (SETQ *DEFAULT-CLEANUP-COMPILER* 'COMPILE-FILE)
+                                      T))
 
-                                          (* ;; " Masterscope stuff")

+                     (* ;; " Masterscope stuff")

 
-                                          (ANALYZE 
-                                             (printout T .FONT LAMBDAFONT "Analyzing the file " FILE
-                                                    " with MasterScope..." .FONT DEFAULTFONT T)
-                                             (MASTERSCOPE `(ANALYZE FNS ON %, FILE)))
-                                          (CHECK 
-                                             (printout T .FONT LAMBDAFONT "Checking the file " FILE 
-                                                    " with MasterScope..." .FONT DEFAULTFONT T)
-                                             (MASTERSCOPE `(CHECK %, FILE)))
-                                          (DESCRIBE 
-                                             (SELECTQ COMSTYPE
-                                                 (VARS [CL:FORMAT
-                                                        T "~&~a is used by:~%% ~a" ITEM
-                                                        (MASTERSCOPE
-                                                         `(WHO USES ',ITEM])
-                                                 (PROGN NIL
-                                                        (printout T .FONT LAMBDAFONT 
-                                                               "MasterScope analysis of " ITEM ":" 
-                                                               .FONT DEFAULTFONT T)
-                                                        (MSDESCRIBE ITEM))))
-                                          (SHOWPATHTO 
-                                             (printout T .FONT LAMBDAFONT "Showing who calls " ITEM 
-                                                    " with MasterScope..." .FONT DEFAULTFONT T)
-                                             (MASTERSCOPE `(SHOW PATHS TO %, ITEM)))
-                                          (SHOWPATHFROM 
-                                             (printout T .FONT LAMBDAFONT "Showing who is called by "
-                                                    ITEM " with MasterScope..." .FONT DEFAULTFONT T)
-                                             (MASTERSCOPE `(SHOW PATHS FROM %, ITEM)))
-                                          (SHOWPATHFILE 
-                                             (printout T .FONT LAMBDAFONT 
-                                                    "Showing who is called by functions in the file "
-                                                    ITEM " with MasterScope..." .FONT DEFAULTFONT T)
-                                             (MASTERSCOPE `(SHOW PATHS FROM ON %, FILE)))
+                     (ANALYZE 
+                        (printout T .FONT LAMBDAFONT "Analyzing the file " FILE 
+                               " with MasterScope..." .FONT DEFAULTFONT T)
+                        (MASTERSCOPE `(ANALYZE FNS ON %, FILE)))
+                     (CHECK 
+                        (printout T .FONT LAMBDAFONT "Checking the file " FILE " with MasterScope..."
+                               .FONT DEFAULTFONT T)
+                        (MASTERSCOPE `(CHECK %, FILE)))
+                     (DESCRIBE (SELECTQ COMSTYPE
+                                   (VARS [CL:FORMAT T "~&~a is used by:~%% ~a" ITEM
+                                                (MASTERSCOPE `(WHO USES ',ITEM])
+                                   (PROGN NIL (printout T .FONT LAMBDAFONT "MasterScope analysis of "
+                                                     ITEM ":" .FONT DEFAULTFONT T)
+                                          (MSDESCRIBE ITEM))))
+                     (SHOWPATHTO 
+                        (printout T .FONT LAMBDAFONT "Showing who calls " ITEM " with MasterScope..."
+                               .FONT DEFAULTFONT T)
+                        (MASTERSCOPE `(SHOW PATHS TO %, ITEM)))
+                     (SHOWPATHFROM 
+                        (printout T .FONT LAMBDAFONT "Showing who is called by " ITEM 
+                               " with MasterScope..." .FONT DEFAULTFONT T)
+                        (MASTERSCOPE `(SHOW PATHS FROM %, ITEM)))
+                     (SHOWPATHFILE 
+                        (printout T .FONT LAMBDAFONT 
+                               "Showing who is called by functions in the file " ITEM 
+                               " with MasterScope..." .FONT DEFAULTFONT T)
+                        (MASTERSCOPE `(SHOW PATHS FROM ON %, FILE)))
 
-                                          (* ;; "DATABASEFNS stuff")

+                     (* ;; "DATABASEFNS stuff")

 
-                                          (DB (CL:FORMAT T 
-                                       "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
-                                                     SAVEDBFLG LOADDBFLG))
-                                          (DBFILE 
-                                             (CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE
-                                                    (GETPROP FILE 'DATABASE))
-                                             (CL:FORMAT T 
-                                       "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
-                                                    SAVEDBFLG LOADDBFLG))
-                                          (DBON 
-                                             (SETQ LOADDBFLG 'ON)
-                                             (SETQ SAVEDBFLG 'ON))
-                                          (DBOFF 
-                                             (SETQ LOADDBFLG 'NO)
-                                             (SETQ SAVEDBFLG 'NO))
-                                          (DBASK 
-                                             (SETQ LOADDBFLG 'ASK)
-                                             (SETQ SAVEDBFLG 'ASK))
-                                          (DBLOADON (SETQ LOADDBFLG 'YES))
-                                          (DBSAVEON (SETQ SAVEDBFLG 'YES))
-                                          (DBLOADOFF (SETQ LOADDBFLG 'NO))
-                                          (DBSAVEOFF (SETQ SAVEDBFLG 'NO))
-                                          (DBLOADASK (SETQ LOADDBFLG 'ASK))
-                                          (DBSAVEASK (SETQ SAVEDBFLG 'ASK))
-                                          (DBFILEON (PUTPROP FILE 'DATABASE 'YES))
-                                          (DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
-                                          (DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
-                                          (DUMPDB 
-                                             (printout T .FONT LAMBDAFONT 
-                                                    "Dumping the Masterscope Database for file " FILE
-                                                    .FONT DEFAULTFONT T)
-                                             (DUMPDB FILE))
-                                          (LOADDB 
-                                             (printout T .FONT LAMBDAFONT 
-                                                    "Loading the Masterscope Database for file " FILE
-                                                    .FONT DEFAULTFONT T)
-                                             (LOADDB FILE))
-                                          (COMPILE 
-                                             (printout T .FONT LAMBDAFONT "Compiling..." .FONT 
-                                                    DEFAULTFONT T)
-                                             (if
 (EQ COMSTYPE 'FILES)
-                                                 then
 (APPLY* (FUNCTION COMPILEFILES)
-                                                             FILE)
-                                                      (Manager.REMOVE.DUPLICATE.ADVICE
 FILE)
-                                               else
 (PRINT (CL:COMPILE ITEM)
-                                                           T)))
-                                          (CL:COMPILE-FILE 
-                                             (printout T .FONT LAMBDAFONT 
-                                                    "Compiling using compile-file..." .FONT 
-                                                    DEFAULTFONT T)
-                                             (CL:COMPILE-FILE FILE)
-                                             (Manager.REMOVE.DUPLICATE.ADVICE
 FILE))
-                                          (REMOVE (DELDEF FILE 'FILE))
-                                          (CHANGES           (* ; "FILE is NIL from main menu")

-                                             (Manager.CHANGED?
 FILE))
-                                          (FILES? 
-                                             (printout T .FONT LAMBDAFONT "Files and their changes:"
-                                                    .FONT DEFAULTFONT T)
-                                             (FILES?)))
+                     (DB (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
+                                SAVEDBFLG LOADDBFLG))
+                     (DBFILE 
+                        (CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE (GETPROP FILE
+                                                                                     'DATABASE))
+                        (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" 
+                               SAVEDBFLG LOADDBFLG))
+                     (DBON 
+                        (SETQ LOADDBFLG 'ON)
+                        (SETQ SAVEDBFLG 'ON))
+                     (DBOFF 
+                        (SETQ LOADDBFLG 'NO)
+                        (SETQ SAVEDBFLG 'NO))
+                     (DBASK 
+                        (SETQ LOADDBFLG 'ASK)
+                        (SETQ SAVEDBFLG 'ASK))
+                     (DBLOADON (SETQ LOADDBFLG 'YES))
+                     (DBSAVEON (SETQ SAVEDBFLG 'YES))
+                     (DBLOADOFF (SETQ LOADDBFLG 'NO))
+                     (DBSAVEOFF (SETQ SAVEDBFLG 'NO))
+                     (DBLOADASK (SETQ LOADDBFLG 'ASK))
+                     (DBSAVEASK (SETQ SAVEDBFLG 'ASK))
+                     (DBFILEON (PUTPROP FILE 'DATABASE 'YES))
+                     (DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
+                     (DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
+                     (DUMPDB 
+                        (printout T .FONT LAMBDAFONT "Dumping the Masterscope Database for file " 
+                               FILE .FONT DEFAULTFONT T)
+                        (DUMPDB FILE))
+                     (LOADDB 
+                        (printout T .FONT LAMBDAFONT "Loading the Masterscope Database for file " 
+                               FILE .FONT DEFAULTFONT T)
+                        (LOADDB FILE))
+                     (COMPILE 
+                        (printout T .FONT LAMBDAFONT "Compiling..." .FONT DEFAULTFONT T)
+                        (if
 (EQ COMSTYPE 'FILES)
+                            then
 (APPLY* (FUNCTION COMPILEFILES)
+                                        FILE)
+                                 (Manager.REMOVE.DUPLICATE.ADVICE
 FILE)
+                          else
 (PRINT (CL:COMPILE ITEM)
+                                      T)))
+                     (CL:COMPILE-FILE 
+                        (printout T .FONT LAMBDAFONT "Compiling using compile-file..." .FONT 
+                               DEFAULTFONT T)
+                        (CL:COMPILE-FILE FILE)
+                        (Manager.REMOVE.DUPLICATE.ADVICE
 FILE))
+                     (REMOVE (DELDEF FILE 'FILE))
+                     (CHANGES                                (* ; "FILE is NIL from main menu")

+                        (Manager.CHANGED?
 FILE))
+                     (FILES? 
+                        (printout T .FONT LAMBDAFONT "Files and their changes:" .FONT DEFAULTFONT T)
+                        (FILES?)))
 
-                                     (* ;; "Relase the window now, but get ready to shrink it back down unless another manager command comes along and need the window.")

+                 (* ;; "Relase the window now, but get ready to shrink it back down unless another manager command comes along and need the window.")

 
-                                      (if
 [NOT (FMEMB COMMAND
-                                                      '(BREAK TRACE UNBREAK CHANGED DELETED DEFINED 
-                                                              UNMARK SEE LIST HARDCOPY REMOVE QUIT 
-                                                              RESET RENAME COPY NIL]
-                                          then
 (CL:FORMAT T "~&------"))))
+                 (if
 [NOT (FMEMB COMMAND
+                                 '(BREAK TRACE UNBREAK CHANGED DELETED DEFINED UNMARK SEE LIST 
+                                         HARDCOPY REMOVE QUIT RESET RENAME COPY NIL]
+                     then
 (CL:FORMAT T "~&------"))))
 
-                              (* ;; 
+         (* ;; 
 
    "Shink the dialog window after ten seconds so long as its not in use by another manager command.")

 
-                              (if
 ACTIVITY-WINDOW-WAS-SHRUNK
-                                  then
 (if
 (FMEMB COMMAND
-                                                  '(SHOWDEF SHOWADVICE PV PF PL CLDESCRIBE CLDOC 
-                                                          FIELDS ARGS DB DBFILE MAKEFILE NEW FAST 
-                                                          COMMON-MAKEFILE CLEANUPT CLEANUPC CLEANUP 
-                                                          ANALYZE CHECK DESCRIBE CHANGES FILES? 
-                                                          COMPILE CL:COMPILE NIL))
-                                           then
 (DISMISS 10000)
-                                         else
 (DISMISS NIL))
-                                       (if
 (EQ ACTIVITY-WINDOW (CAR MANAGER-WINDOWS))
-                                           then
 (SHRINKW T])]
-           '(,COMMAND ,ITEM ,COMSTYPE ,FILE ,MENU]
-         'NAME
-         'MANAGER-COMMAND))
-    NIL])
+         (if
 ACTIVITY-WINDOW-WAS-SHRUNK
+             then
 (if
 (FMEMB COMMAND
+                             '(SHOWDEF SHOWADVICE PV PF PL CLDESCRIBE CLDOC FIELDS ARGS DB DBFILE 
+                                     MAKEFILE NEW FAST COMMON-MAKEFILE CLEANUPT CLEANUPC CLEANUP 
+                                     ANALYZE CHECK DESCRIBE CHANGES FILES? COMPILE CL:COMPILE NIL))
+                      then
 (DISMISS 10000)
+                    else
 (DISMISS NIL))
+                  (if
 (EQ ACTIVITY-WINDOW (CAR MANAGER-WINDOWS))
+                      then
 (SHRINKW T])])
 
 (Manager.HIGHLIGHT

   [LAMBDA (ITEM MENU ON)
                                     (* ; "Edited 31-Jul-87 17:33 by raf")

@@ -1772,21 +1708,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
 
 (ADDTOVAR LAMA
 )
 )
+(PUTPROPS MANAGER COPYRIGHT (NONE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (25676 102848 (MANAGER 25686 . 26485) (MANAGER.RESET 26487 . 28001) (Manager.ADDADV 
-28003 . 29356) (Manager.ADDTOFILES? 29358 . 29636) (Manager.ALTERMARKING 29638 . 31248) (
-Manager.ANCHORED-SET-POSITION 31250 . 32353) (Manager.DO.COMMAND 32355 . 62991) (Manager.HIGHLIGHT 
-62993 . 63290) (Manager.PROMPT 63292 . 63605) (Manager.WINDOW 63607 . 64240) (
-Manager.insurefilehighlights 64242 . 65313) (Manager.CHANGED? 65315 . 65864) (Manager.CHECKFILE 65866
- . 66965) (Manager.COLLECTCOMS 66967 . 68405) (Manager.COMS.WSF 68407 . 71077) (Manager.COMSOPEN 71079
- . 75817) (Manager.COMSUPDATE 75819 . 76911) (Manager.HIGHLIGHTED 76913 . 77219) (
-Manager.INSUREHIGHLIGHTS 77221 . 77779) (Manager.FILECHANGES 77781 . 78080) (Manager.FILELSTCHANGED? 
-78082 . 78410) (Manager.FILESUBTYPES 78412 . 79050) (Manager.GET.ENVIRONMENT 79052 . 81590) (
-Manager.GETFILE 81592 . 83906) (Manager.INTITLE? 83908 . 84586) (Manager.MAIN.WSF 84588 . 87232) (
-Manager.MAINCLOSE 87234 . 88344) (Manager.MAINMENUITEMS 88346 . 89423) (Manager.MAINOPEN 89425 . 94818
-) (Manager.MAINUPDATE 94820 . 95456) (Manager.MAKEFILE.ADV 95458 . 96494) (Manager.MENUCOLUMNS 96496
- . 97300) (Manager.MENUHASITEM 97302 . 97659) (Manager.MENUITEMS 97661 . 97906) (
-Manager.REMOVE.DUPLICATE.ADVICE 97908 . 99514) (Manager.RESETSUBITEMS 99516 . 100753) (
-Manager.SET-ANCHOR 100755 . 101074) (Manager.SORT.COMS 101076 . 101608) (Manager.SORTBYCOLUMN 101610
- . 102846)))))
+  (FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959
+ . 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) (
+Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) (
+Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 . 
+53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED? 
+55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF
+ 58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) (
+Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065
+ . 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) (
+Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870
+) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 . 
+79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742
+ . 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS 
+87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) (
+Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 . 
+93130)))))
 STOP

lispusers/QIX

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "24-Aug-2022 07:58:48" |{DSK}<home>larry>medley>lispusers>QIX.;2|
 11276  
+
(FILECREATED "14-Jun-2024 14:54:24" |{WMEDLEY}<lispusers>QIX.;4|
 12192  
 
-      :CHANGES-TO (FNS QIX.IDLE)
+      :EDIT-BY |rmk|
 
-      :PREVIOUS-DATE "12-Aug-87 03:05:50" |{DSK}<home>larry>medley>lispusers>QIX.;1|)
+      :CHANGES-TO (FNS QIX.GROW)
 
+      :PREVIOUS-DATE "14-Jun-2024 14:49:48" |{WMEDLEY}<lispusers>QIX.;3|)
 
-; Copyright (c) 1987 by Xerox Corporation.
 
 (PRETTYCOMPRINT QIXCOMS)
 
@@ -18,69 +18,72 @@
 (DEFINEQ
 
 (QIX.GROW

-  (LAMBDA (WINDOW DONTDISMISS)
                       (* \; "Edited  1-Aug-87 16:57 by JEFF.SHRAGER")

-          
-          (* * |This| |sets| |up| \a QIX |the| |specified| |window.|
-
          |The| |QIX's| |parameters| |are| |defined| |at| |random,| |but| |with| 
-
          |reasonable| |value| |ranges.| |The| |dismiss| |argument| |tell| |the| QIX 
-
          |whether| |to| DISMISS |every| |cycle| |or| |not.|
-
          B\e |careful.|)

+  (LAMBDA (WINDOW DONTDISMISS)
                              (* \; "Edited 14-Jun-2024 14:54 by rmk")

+                                                             (* \; 
+
                                                             "Edited  1-Aug-87 16:57 by JEFF.SHRAGER")

+
+(* |;;;| "This sets up a QIX the specified window.  The QIX's parameters are defined at random, but with reasonable value ranges.  The dismiss argument tell the QIX whether to DISMISS every cycle or not.  Be careful.")

 
     (PROG (P P2 (W (OR WINDOW (CREATEW)))
              L)
           (SETQ *STOP.QIXS* NIL)
-          
-          (* * P |and| P2 |define| \a QIX.)

+
+(* |;;;| "P and P2 define a QIX.")

 
           (SETQ P (|create|
 QIX.POINT
-                         X _ (RAND 1 200)
-                         Y _ (RAND 1 100)
+                         QX _ (RAND 1 200)
+                         QY _ (RAND 1 100)
                          VH _ (RAND 1 20)
                          VV _ (RAND 1 20)))
           (SETQ P2 (|create|
 QIX.POINT
-                          X _ (RAND 1 200)
-                          Y _ (RAND 1 100)
+                          QX _ (RAND 1 200)
+                          QY _ (RAND 1 100)
                           VH _ (RAND 1 20)
                           VV _ (RAND 1 20)))
-          
-          (* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and| 
-
          |gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's| 
-
          |own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)

+
+(* |;;;| "L is the tail list.  It starts out full of NILs and gets filled as the QIX moves.  It is also inserted in it's own mouth so that the whole thing wraps around.")

 
           (SETQ L (APPEND (|for|
 X |from|
 1 |to|
 (RAND 5 25)
                              |collect|
 (COPY '(A S D F)))
-                         (LIST (LIST (|fetch|
 X P)
-                                     (|fetch|
 Y P)
-                                     (|fetch|
 X P2)
-                                     (|fetch|
 Y P2)))))
+                         (LIST (LIST (|fetch|
 (QIX.POINT QX)
+                                            P)
+                                     (|fetch|
 (QIX.POINT QY)
+                                            P)
+                                     (|fetch|
 (QIX.POINT QX)
+                                            P2)
+                                     (|fetch|
 (QIX.POINT QY)
+                                            P2)))))
           (RPLACD (LAST L)
                  L)
       LOOP
           (COND
              (*STOP.QIXS* (RPLACD L NIL)
                     (RETURN NIL)))
-          
-          (* * |Draw| |the| |QIX's| |head| |line.|)

 
-          (MOVETO (|fetch|
 X P)
-                 (|fetch|
 Y P)
+(* |;;;| "Draw the QIX's head line.")

+
+          (MOVETO (|fetch|
 (QIX.POINT QX)
+                         P)
+                 (|fetch|
 (QIX.POINT QY)
+                        P)
                  W)
-          (DRAWTO (|fetch|
 X P2)
-                 (|fetch|
 Y P2)
+          (DRAWTO (|fetch|
 (QIX.POINT QX)
+                         P2)
+                 (|fetch|
 (QIX.POINT QY)
+                        P2)
                  1
                  'REPLACE W)
-          
-          (* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)

+
+(* |;;;| "Move the points according to their QX and QY velocities.")

 
           (QIX.MOVE.POINT
 P W)
           (QIX.MOVE.POINT
 P2 W)
-          
-          (* * |Take| \a |deep| |breath| |if| |the| |user| |asks| |you| |to.|
-
          |This| |slows| |things| |down.|)

+
+(* |;;;| "Take a deep breath if the user asks you to.  This slows things down.")

 
           (OR DONTDISMISS (DISMISS))
-          
-          (* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)

+
+(* |;;;| "Delete the first object on the tail list.")

 
           (COND
              ((EQ (CAAR L)
@@ -93,60 +96,63 @@
                              (CADDDR OLD)
                              1
                              'ERASE W))))
-          
-          (* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which| 
-
          |effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| 
-
          |them| |immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| 
-
          |list.|)

+
+(* |;;;| "Replace the current point with the new head, which effectively adds it to the end of the list, since we them immediately move to the next elt in this circular list.")

 
           (RPLACA (CAR L)
-                 (|fetch|
 X P))
+                 (|fetch|
 (QIX.POINT QX)
+                        P))
           (RPLACA (CDAR L)
-                 (|fetch|
 Y P))
+                 (|fetch|
 (QIX.POINT QY)
+                        P))
           (RPLACA (CDDAR L)
-                 (|fetch|
 X P2))
+                 (|fetch|
 (QIX.POINT QX)
+                        P2))
           (RPLACA (CDDDAR L)
-                 (|fetch|
 Y P2))
+                 (|fetch|
 (QIX.POINT QY)
+                        P2))
           (SETQ L (CDR L))
           (GO LOOP))))
 
 (QIX.IDLE

-  (LAMBDA (W)
                                             (* \; "Edited 24-Aug-2022 07:53 by larry")

+  (LAMBDA (W)
                                               (* \; "Edited 14-Jun-2024 14:49 by rmk")


+                                                          (* \; "Edited 24-Aug-2022 07:53 by larry")

                                                              (* \; 
 
                                                             "Edited  1-Aug-87 16:58 by JEFF.SHRAGER")

 
-         (* * CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND
-
         (WASTING SPACE) FROM BEFORE.)

+(* |;;;| "CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND (WASTING SPACE) FROM BEFORE.")

 
     (AND (BOUNDP '*OLD-QIXS*)
          (FOR
 Q IN
 *OLD-QIXS* DO
 (RPLACD Q NIL)))
     (PROG (P P2 L QIXS)
 
-         (* * P |and| P2 |define| \a QIX.)

+(* |;;;| "P and P2 define a QIX.")

 
           (SETQ QIXS (|for|
 I |from|
 1 |to|
 5
                         |collect|
 (PROGN (SETQ P (|create|
 QIX.POINT
-                                                        X _ (RAND 1 200)
-                                                        Y _ (RAND 1 100)
+                                                        QX _ (RAND 1 200)
+                                                        QY _ (RAND 1 100)
                                                         VH _ (RAND 1 20)
                                                         VV _ (RAND 1 20)))
                                          (SETQ P2 (|create|
 QIX.POINT
-                                                         X _ (RAND 1 200)
-                                                         Y _ (RAND 1 100)
+                                                         QX _ (RAND 1 200)
+                                                         QY _ (RAND 1 100)
                                                          VH _ (RAND 1 20)
                                                          VV _ (RAND 1 20)))
 
-         (* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and| 
-
         |gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's| 
-
         |own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)

+(* |;;;| "L is the tail list.  It starts out full of NILs and gets filled as the QIX moves.  It is also inserted in it's own mouth so that the whole thing wraps around.")

 
                                          (SETQ L
                                           (APPEND (|for|
 X |from|
 1 |to|
 (RAND 5 25)
                                                      |collect|
 (COPY '(A S D F)))
-                                                 (LIST (LIST (|fetch|
 X P)
-                                                             (|fetch|
 Y P)
-                                                             (|fetch|
 X P2)
-                                                             (|fetch|
 Y P2)))))
+                                                 (LIST (LIST (|fetch|
 (QIX.POINT QX)
+                                                                    P)
+                                                             (|fetch|
 (QIX.POINT QY)
+                                                                    P)
+                                                             (|fetch|
 (QIX.POINT QX)
+                                                                    P2)
+                                                             (|fetch|
 (QIX.POINT QY)
+                                                                    P2)))))
                                          (RPLACD (LAST L)
                                                 L)
                                          (LIST P P2 L))))
@@ -157,22 +163,26 @@
                                   (SETQ P2 (CADR Q))
                                   (SETQ L (CADDR Q)) 
 
-         (* * |Draw| |the| |QIX's| |head| |line.|)

+(* |;;;| "Draw the QIX's head line.")

 
-                                  (MOVETO (|fetch|
 X P)
-                                         (|fetch|
 Y P)
+                                  (MOVETO (|fetch|
 (QIX.POINT QX)
+                                                 P)
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P)
                                          W)
-                                  (DRAWTO (|fetch|
 X P2)
-                                         (|fetch|
 Y P2)
+                                  (DRAWTO (|fetch|
 (QIX.POINT QX)
+                                                 P2)
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P2)
                                          1
                                          'REPLACE W) 
 
-         (* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)

+(* |;;;| "Move the points according to their QX and QY velocities.")

 
                                   (QIX.MOVE.POINT
 P W)
                                   (QIX.MOVE.POINT
 P2 W) 
 
-         (* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)

+(* |;;;| "Delete the first object on the tail list.")

 
                                   (COND
                                      ((EQ (CAAR L)
@@ -186,34 +196,36 @@
                                                      1
                                                      'ERASE W)))) 
 
-         (* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which| 
-
         |effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| THEN 
-
         |immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| |list.|)

+(* |;;;| "Replace the current point with the new head, which effectively adds it to the end of the list, since we THEN immediately move to the next elt in this circular list.")

 
                                   (RPLACA (CAR L)
-                                         (|fetch|
 X P))
+                                         (|fetch|
 (QIX.POINT QX)
+                                                P))
                                   (RPLACA (CDAR L)
-                                         (|fetch|
 Y P))
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P))
                                   (RPLACA (CDDAR L)
-                                         (|fetch|
 X P2))
+                                         (|fetch|
 (QIX.POINT QX)
+                                                P2))
                                   (RPLACA (CDDDAR L)
-                                         (|fetch|
 Y P2))
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P2))
                                   (RPLACA (CDDR Q)
                                          (CDR L)))
           (GO LOOP))))
 
 (QIX.MOVE.POINT

-  (LAMBDA (P W)
                                              (* |edited:| "16-May-85 00:39")

-          
-          (* * |This| |guy| |updates| |the| QIX |line| |endpoints| |according| |to| 
-
          |their| |velocities| |in| |the| X |and| Y |directions.|
-
          I\f |we| |hit| \a |wall,| |then| |simply| |negate| |the| |relevant| |velocity| 
-
          |vector.|)

+  (LAMBDA (P W)
                                             (* \; "Edited 14-Jun-2024 14:48 by rmk")

+                                                             (* |edited:| "16-May-85 00:39")

+
+(* |;;;| "This guy updates the QIX line endpoints according to their velocities in the X and Y directions.  If we hit a wall, then simply negate the relevant velocity vector.")

 
     (PROG ((VV (|fetch|
 VV P))
            (VH (|fetch|
 VH P))
-           (X (|fetch|
 X P))
-           (Y (|fetch|
 Y P)))
+           (X (|fetch|
 (QIX.POINT QX)
+                     P))
+           (Y (|fetch|
 (QIX.POINT QY)
+                     P)))
           (PROG ((NEWX (IPLUS X VH))
                  (NEWY (IPLUS Y VV)))
                 (COND
@@ -230,8 +242,10 @@
                    ((GREATERP NEWX (WINDOWPROP W 'WIDTH))
                     (SETQ NEWX (WINDOWPROP W 'WIDTH))
                     (SETQ VH (ITIMES -1 VH))))
-                (|replace|
 Y P NEWY)
-                (|replace|
 X P NEWX)
+                (|replace|
 (QIX.POINT QY)
+                       P NEWY)
+                (|replace|
 (QIX.POINT QX)
+                       P NEWX)
                 (|replace|
 VV P VV)
                 (|replace|
 VH P VH)))))
 
@@ -249,13 +263,12 @@
 )
 (DECLARE\: EVAL@COMPILE
 
-(RECORD QIX.POINT
 (X Y VH VV))
+(RECORD QIX.POINT
 (QX QY VH VV))
 )
 
 (SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE)
                            IDLE.FUNCTIONS))
-(PUTPROPS QIX COPYRIGHT ("Xerox Corporation" 1987))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (592 11044 (QIX.GROW 602 . 4158) (QIX.IDLE 4160 . 8972) (QIX.MOVE.POINT 8974 . 10356) (
-QIX.PLAY 10358 . 11042)))))
+  (FILEMAP (NIL (544 12010 (QIX.GROW 554 . 4311) (QIX.IDLE 4313 . 9800) (QIX.MOVE.POINT 9802 . 11322) (
+QIX.PLAY 11324 . 12008)))))
 STOP

lispusers/SOLITAIRE

@@ -1,16 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Aug-2022 08:54:17" {DSK}<home>larry>medley>lispusers>SOLITAIRE.;2
 26883  
+
(FILECREATED "14-Jun-2024 15:48:55" {WMEDLEY}<lispusers>SOLITAIRE.;4
 27251  
 
-      :CHANGES-TO (FNS SOLO DEALDECK GETCARD)
-                  (VARS SOLITAIRECOMS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "15-Jan-86 23:32:05" {DSK}<home>larry>medley>lispusers>SOLITAIRE.;1)
+      :CHANGES-TO (RECORDS CARD)
+                  (FNS GETCARD MOVECARD UPCARD NXTCARD)
 
+      :PREVIOUS-DATE "24-Aug-2022 08:54:17" {WMEDLEY}<lispusers>SOLITAIRE.;2)
 
-(* ; "
-Copyright (c) 1982, 1985-1986 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT SOLITAIRECOMS)
 
@@ -169,11 +167,12 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
       else
 NIL])
 
 (GETCARD

-  [LAMBDA (I)                                                (* bas%: "30-JUL-82 19:04")

+  [LAMBDA (I)
                                                (* ; "Edited 14-Jun-2024 15:48 by rmk")

+                                                             (* bas%: "30-JUL-82 19:04")

     (PROG ((C (ELT DECK I)))
           (if
 (fetch
 FACE of
 C)
             else
 (replace
 FACE of
 C with
 (CARDIMAGE
 C))
-                 (replace
 SAV of
 C with
 (BITMAPCREATE CardWidth CardHeight)))
+                 (replace
 (CARD CDSAV) of
 C with
 (BITMAPCREATE CardWidth CardHeight)))
           (replace
 CX of
 C with
 (replace
 CY of
 C with
 NIL))
           (RETURN C])
 
@@ -192,13 +191,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
         then
 (SEARCHSTACKS
 (TOP H])
 
 (MOVECARD

-  [LAMBDA (C X Y)                                            (* lmm " 6-Aug-85 00:04")

+  [LAMBDA (C X Y)
                                            (* ; "Edited 14-Jun-2024 15:46 by rmk")

+                                                             (* lmm " 6-Aug-85 00:04")

     (if
 (fetch
 CX of
 C)
         then
 (DOMOVE
 (fetch
 FACE of
 C)
                     (fetch
 CX of
 C)
                     (fetch
 CY of
 C)
-                    X Y (fetch
 SAV of
 C))
-      else
 (BITBLT SOLOW X Y (fetch
 SAV of
 C)
+                    X Y (fetch
 (CARD CDSAV) of
 C))
+      else
 (BITBLT SOLOW X Y (fetch
 (CARD CDSAV) of
 C)
                   NIL NIL NIL NIL 'INPUT 'REPLACE)
            (BITBLT (fetch
 FACE of
 C)
                   NIL NIL SOLOW X Y NIL NIL 'INPUT 'REPLACE))
@@ -264,7 +264,8 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
              (PUSHCARD
 S2 (CAR L])
 
 (UPCARD

-  [LAMBDA (X Y)                                              (* lmm " 6-Aug-85 00:04")

+  [LAMBDA (X Y)
                                              (* ; "Edited 14-Jun-2024 15:46 by rmk")

+                                                             (* lmm " 6-Aug-85 00:04")

 
          (* Brings up X image which is assumed to be overlapped by Y image.
 
         Assumes YOFFSET only)

@@ -272,14 +273,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
     (if
 Y
         then
 (PROG [(DY (IDIFFERENCE (fetch
 CY of
 X)
                                (fetch
 CY of
 Y]
-                   (BITBLT (fetch
 SAV of
 X)
-                          0 0 (fetch
 SAV of
 Y)
+                   (BITBLT (fetch
 (CARD CDSAV) of
 X)
+                          0 0 (fetch
 (CARD CDSAV) of
 Y)
                           0 DY CardWidth (IDIFFERENCE CardHeight DY)
                           'INPUT
                           'REPLACE)
                    (BITBLT SOLOW (fetch
 CX of
 X)
                           (fetch
 CY of
 X)
-                          (fetch
 SAV of
 X)
+                          (fetch
 (CARD CDSAV) of
 X)
                           0 0 CardWidth (IDIFFERENCE CardHeight DY)
                           'INPUT
                           'REPLACE)
@@ -308,7 +309,8 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
                       (RETURN T])
 
 (NXTCARD

-  [LAMBDA (S)                                                (* bas%: "15-Jan-86 21:44")

+  [LAMBDA (S)
                                                (* ; "Edited 14-Jun-2024 15:46 by rmk")

+                                                             (* bas%: "15-Jan-86 21:44")

     (PROG1 (pop
 (fetch
 FACEDOWN of
 S))
         [if
 (fetch
 FACEDOWN of
 S)
           else
 
@@ -335,7 +337,7 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
                       'REPLACE)
                (if
 (fetch
 FACEUP of
 S)
                    then
 (BLTSHADE (DSPTEXTURE NIL SOLOW)
-                               (fetch
 SAV of
 (BOTTOM S))
+                               (fetch
 (CARD CDSAV) of
 (BOTTOM S))
                                0
                                (IMINUS (fetch
 YO of
 S))
                                (IDIFFERENCE CardWidth (fetch
 XO of
 S))
@@ -531,7 +533,7 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
 
 (DECLARE%: EVAL@COMPILE
 
-(DATATYPE CARD
 (SUIT RANK FACE SAV CX CY)
+(DATATYPE CARD
 (SUIT RANK FACE CDSAV CX CY)
                (ACCESSFNS CARD (COLOR (ILESSP (fetch
 SUIT of
 DATUM)
                                              Diamonds))))
 
@@ -642,15 +644,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
 (RPAQ? SOLORESULTS
 )
 
 (ADDTOVAR IDLE.FUNCTIONS
 ("Solitaire" 'SOLO))
-(PUTPROPS SOLITAIRE COPYRIGHT ("Xerox Corporation" 1982 1985 1986))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1950 4087 (SOLO 1960 . 3297) (SOLITAIRE 3299 . 4085)) (4088 20454 (CARDIMAGE 4098 . 
-5754) (COUNTCARDS 5756 . 5969) (CREATEHAND 5971 . 6576) (CREATESTACK 6578 . 7427) (DEALDECK 7429 . 
-8012) (FLIPSTACK 8014 . 8249) (GETCARD 8251 . 8701) (GOODMOVE? 8703 . 9100) (HTOS? 9102 . 9269) (
-MOVECARD 9271 . 9910) (DOMOVE 9912 . 11543) (MOVEHS 11545 . 11816) (MOVES 11818 . 12129) (MOVES1 12131
- . 12433) (UPCARD 12435 . 13651) (MOVESSS 13653 . 14595) (NXTCARD 14597 . 16369) (PUSHCARD 16371 . 
-17033) (POSTVALUE 17035 . 18036) (SEARCHSTACKS 18038 . 18281) (SHOWCARDSTACK 18283 . 18912) (
-SHUFFLEDECK 18914 . 19718) (STACKLOC 19720 . 20052) (STOS? 20054 . 20316) (TOPSUITSTACK 20318 . 20452)
-) (20455 22457 (HIST 20465 . 22054) (ARRAYMAX 22056 . 22455)) (22479 24001 (SHOWCONFIG 22489 . 22951) 
-(PRINTCARDSTACK 22953 . 23305) (CARDNAME 23307 . 23999)))))
+  (FILEMAP (NIL (1885 4022 (SOLO 1895 . 3232) (SOLITAIRE 3234 . 4020)) (4023 20888 (CARDIMAGE 4033 . 
+5689) (COUNTCARDS 5691 . 5904) (CREATEHAND 5906 . 6511) (CREATESTACK 6513 . 7362) (DEALDECK 7364 . 
+7947) (FLIPSTACK 7949 . 8184) (GETCARD 8186 . 8754) (GOODMOVE? 8756 . 9153) (HTOS? 9155 . 9322) (
+MOVECARD 9324 . 10090) (DOMOVE 10092 . 11723) (MOVEHS 11725 . 11996) (MOVES 11998 . 12309) (MOVES1 
+12311 . 12613) (UPCARD 12615 . 13967) (MOVESSS 13969 . 14911) (NXTCARD 14913 . 16803) (PUSHCARD 16805
+ . 17467) (POSTVALUE 17469 . 18470) (SEARCHSTACKS 18472 . 18715) (SHOWCARDSTACK 18717 . 19346) (
+SHUFFLEDECK 19348 . 20152) (STACKLOC 20154 . 20486) (STOS? 20488 . 20750) (TOPSUITSTACK 20752 . 20886)
+) (20889 22891 (HIST 20899 . 22488) (ARRAYMAX 22490 . 22889)) (22913 24435 (SHOWCONFIG 22923 . 23385) 
+(PRINTCARDSTACK 23387 . 23739) (CARDNAME 23741 . 24433)))))
 STOP

lispusers/UNDIGESTIFY

@@ -1,19 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Sep-2023 14:26:57" {WMEDLEY}<lispusers>UNDIGESTIFY.;3
 17040  
+
(FILECREATED " 3-Jun-2024 23:02:57" {WMEDLEY}<lispusers>UNDIGESTIFY.;5
 16776  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS UNDIGESTIFYCOMS)
-                  (FNS OPEN-SPACE-IN-FILE)
 
-      :PREVIOUS-DATE "29-Jul-87 08:47:18" {WMEDLEY}<lispusers>UNDIGESTIFY.;1)
+      :PREVIOUS-DATE " 3-Jun-2024 23:01:00" {WMEDLEY}<lispusers>UNDIGESTIFY.;4)
 
 
-(* ; "
-Copyright (c) 1986-1987 by Xerox Corporation.
-")
-
 (PRETTYCOMPRINT UNDIGESTIFYCOMS)
 
 (RPAQQ UNDIGESTIFYCOMS

@@ -22,8 +17,7 @@ Copyright (c) 1986-1987 by Xerox Corporation.
         (FNS INSTALL-UNDIGESTIFY LAFITE-DISPLAY LAFITE-TRUNCATE-FILE LAFITE-UNDIGESTIFY MOVE-TO-EOL 
              OPEN-SPACE-IN-FILE PARSE-AND-MAYBE-MERGE-HEADER SKIP-EOLS BACKUP-PTR 
              TEDIT.FIND.NOT.CASELESS)
-        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM library/LAFITE)
-                                                LAFITEDECLS))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES LAFITE-DECLS))
         (P (INSTALL-UNDIGESTIFY))))
 
 (RPAQ? *DELETE-DIGEST-FLAG*
 NIL)
@@ -312,15 +306,13 @@ Copyright (c) 1986-1987 by Xerox Corporation.
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
-(FILESLOAD (FROM
 library/LAFITE)
-       LAFITEDECLS)
+(FILESLOAD LAFITE-DECLS)
 )
 
 (INSTALL-UNDIGESTIFY
)
-(PUTPROPS UNDIGESTIFY COPYRIGHT ("Xerox Corporation" 1986 1987))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1183 16831 (INSTALL-UNDIGESTIFY 1193 . 3206) (LAFITE-DISPLAY 3208 . 3507) (
-LAFITE-TRUNCATE-FILE 3509 . 3920) (LAFITE-UNDIGESTIFY 3922 . 13578) (MOVE-TO-EOL 13580 . 14040) (
-OPEN-SPACE-IN-FILE 14042 . 14762) (PARSE-AND-MAYBE-MERGE-HEADER 14764 . 15984) (SKIP-EOLS 15986 . 
-16297) (BACKUP-PTR 16299 . 16461) (TEDIT.FIND.NOT.CASELESS 16463 . 16829)))))
+  (FILEMAP (NIL (1016 16664 (INSTALL-UNDIGESTIFY 1026 . 3039) (LAFITE-DISPLAY 3041 . 3340) (
+LAFITE-TRUNCATE-FILE 3342 . 3753) (LAFITE-UNDIGESTIFY 3755 . 13411) (MOVE-TO-EOL 13413 . 13873) (
+OPEN-SPACE-IN-FILE 13875 . 14595) (PARSE-AND-MAYBE-MERGE-HEADER 14597 . 15817) (SKIP-EOLS 15819 . 
+16130) (BACKUP-PTR 16132 . 16294) (TEDIT.FIND.NOT.CASELESS 16296 . 16662)))))
 STOP

scripts/copy-all.sh

@@ -1,35 +1,151 @@
 #!/bin/sh
 
-if [ ! -x run-medley ] ; then
-    echo run from MEDLEYDIR
-    exit 1
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	echo ">>>>> START ${script_name}"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}"       \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}"       \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+	if [ "${1}" = "-apps" ]; then
+	    /bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/apps.sysout "${LOADUP_OUTDIR}"   \
+	        | sed -e "s#${MEDLEYDIR}/##g"
+	fi
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/whereis.hash "${LOADUP_OUTDIR}"      \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/exports.all "${LOADUP_OUTDIR}"       \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}"      \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}"      \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}"      \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}"   \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+	if [ "${1}" = "-apps" ]; then
+	    /bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}"  \
+	        | sed -e "s#${MEDLEYDIR}/##g"
+	fi
+
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS library                        \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS.LCOM library                   \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+
+	echo "<<<<< END ${script_name}"
+	echo ""
+	exit 0
+}
+
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
+then
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-. scripts/loadup-setup.sh
-
-echo ">>>>> START ${script_name}"
-
-./scripts/cpv "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}"  | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}"  | sed -e "s#${MEDLEYDIR}/##g"
-if [ "${1}" = "-apps" ]; then
-    ./scripts/cpv "${LOADUP_WORKDIR}"/apps.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-fi
-
-./scripts/cpv "${LOADUP_WORKDIR}"/whereis.hash "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/exports.all "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-
-./scripts/cpv "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-if [ "${1}" = "-apps" ]; then
-    ./scripts/cpv "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-fi
-
-
-./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS library | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS.LCOM library | sed -e "s#${MEDLEYDIR}/##g"
-
-echo "<<<<< END ${script_name}"
-echo ""
-exit 0
+main "$@"

scripts/copy-db.sh

@@ -1,17 +1,118 @@
 #!/bin/sh
 
-if [ ! -x run-medley ] ; then
-    echo run from MEDLEYDIR
-    exit 1
+main() {
+
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	echo ">>>>> START ${script_name}"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/fuller.database "${LOADUP_OUTDIR}"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/fuller.dribble "${LOADUP_OUTDIR}"
+
+	echo "<<<<< END ${script_name}"
+	echo ""
+	exit 0
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
+then
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-. scripts/loadup-setup.sh
-
-echo ">>>>> START ${script_name}"
-
-./scripts/cpv "${LOADUP_WORKDIR}"/fuller.database "${LOADUP_OUTDIR}"
-./scripts/cpv "${LOADUP_WORKDIR}"/fuller.dribble "${LOADUP_OUTDIR}"
-
-echo "<<<<< END ${script_name}"
-echo ""
-exit 0
+main "$@"

scripts/copy-full.sh

@@ -1,24 +1,130 @@
 #!/bin/sh
 
-if [ ! -x run-medley ] ; then
-    echo run from MEDLEYDIR
-    exit 1
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	echo ">>>>> START ${script_name}"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}"  \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}"  \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS library                   \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+	/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS.LCOM library              \
+	    | sed -e "s#${MEDLEYDIR}/##g"
+
+	echo "<<<<< END ${script_name}"
+	echo ""
+	exit 0
+}
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
+then
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-. scripts/loadup-setup.sh
-
-echo ">>>>> START ${script_name}"
-
-./scripts/cpv "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}"  | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}"  | sed -e "s#${MEDLEYDIR}/##g"
-
-./scripts/cpv "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
-
-./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS library | sed -e "s#${MEDLEYDIR}/##g"
-./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS.LCOM library | sed -e "s#${MEDLEYDIR}/##g"
-
-echo "<<<<< END ${script_name}"
-echo ""
-exit 0
+main "$@"

scripts/loadup-all.sh

@@ -1,50 +1,146 @@
 #!/bin/sh
 # shellcheck disable=SC2181
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	# look thru args looking to see if -apps, --apps, or -a was specified in args
+	apps=""
+	j=1
+	jmax=$#
+	while [ "$j" -le "$jmax" ]
+	do
+	  if [ "$(eval "printf %s \${${j}}")" = "-a" ] ||    \
+	     [ "$(eval "printf %s \${${j}}")" = "-apps" ] || \
+	     [ "$(eval "printf %s \${${j}}")" = "--apps" ]
+	  then
+	    apps="-apps"
+	    break
+	  fi
+	done
+
+	#  Do loadup components
+	/bin/sh "${LOADUP_SCRIPTDIR}/loadup-init.sh"                   \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-mid-from-init.sh"       \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-lisp-from-mid.sh"       \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-full-from-lisp.sh"      \
+	&& {                                                           \
+	     if [ -n "${apps}" ];                                      \
+	     then                                                      \
+	       /bin/sh "${LOADUP_SCRIPTDIR}/loadup-apps-from-full.sh"; \
+	     fi;                                                       \
+	    }                                                          \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-aux.sh"                 \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/copy-all.sh" "${apps}"
+
+	if [ $? -eq 0 ]
+	then
+	  echo "+++++ loadup-all.sh: SUCCESS +++++"
+	else
+	  echo "----- loadup-all.sh: FAILURE -----"
+	fi
+
+}
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-# look thru args looking to see if -apps, --apps, or -a was specified in args
-apps=true
-j=1
-jmax=$#
-while [ "$j" -le "$jmax" ]
-do
-  if [ "$(eval "printf %s \${${j}}")" = "-a" ] || \
-     [ "$(eval "printf %s \${${j}}")" = "-apps" ] || \
-     [ "$(eval "printf %s \${${j}}")" = "--apps" ]
-  then
-    apps="./scripts/loadup-apps-from-full.sh"
-    break
-  fi
-done
-
-#  Do loadup components
-./scripts/loadup-init.sh && \
-    ./scripts/loadup-mid-from-init.sh && \
-    ./scripts/loadup-lisp-from-mid.sh && \
-    ./scripts/loadup-full-from-lisp.sh && \
-    ${apps} && \
-    ./scripts/loadup-aux.sh && \
-    ./scripts/copy-all.sh "$1"
-
-if [ $? -eq 0 ]
-then
-  echo "+++++ loadup-all.sh: SUCCESS +++++"
-else
-  echo "----- loadup-all.sh: FAILURE -----"
-fi
-
-
-
-
-
+main "$@"

scripts/loadup-apps-from-full.sh

@@ -1,76 +1,171 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	loadup_start
+
+	export ROOMSDIR="${MEDLEYDIR}/rooms"
+	export CLOSDIR="${MEDLEYDIR}/clos"
+
+	export NOTECARDSDIR="${MEDLEYDIR}/notecards"
+	if [ ! -e "${NOTECARDSDIR}" ]
+	then
+	    NOTECARDSDIR=$(cd "${MEDLEYDIR}/../" && pwd)/notecards
+	    if [ ! -e "${NOTECARDSDIR}" ]
+	    then
+	        NOTECARDSDIR=$(cd "${MEDLEYDIR}/../../" && pwd)/notecards
+	        if [ ! -e "${NOTECARDSDIR}" ]
+	        then
+	            NOTECARDSDIR=""
+	        fi
+	    fi
+	fi
+
+	if [ -z "${NOTECARDSDIR}" ]
+	then
+	    echo "Error: Cannot find the Notecards directory"
+	    echo "It should be located at ${MEDLEYDIR}/../notecards or"
+	    echo "${MEDLEYDIR}/../../notecards.  But its not."
+	    echo "Exiting"
+	    exit 1
+	fi
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+
+	(PROGN
+	   (IL:MEDLEY-INIT-VARS 'IL:GREET)
+	   (IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
+	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD)
+	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD)
+	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD)
+	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD)
+	   (IL:LOAD
+	       (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM))
+	       'IL:SYSLOAD
+	   )
+	   (IL:HARDRESET)
+	)
+	SHH
+	(PROGN
+	   (IL:ENDLOADUP)
+	   (CLOS::LOAD-CLOS)
+	   (IL:|Apps.LOADUP|)
+	   (IL:DRIBBLE)
+	   (IL:MAKESYS
+	       (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.sysout)))
+	       :APPS)
+	)
+	(IL:LOGOUT T)
+
+	"
+	EOF
+
+	run_medley "${LOADUP_WORKDIR}/full.sysout"
+
+	loadup_finish "apps.sysout" "apps.*"
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-export ROOMSDIR="${MEDLEYDIR}/rooms"
-export CLOSDIR="${MEDLEYDIR}/clos"
-
-export NOTECARDSDIR="${MEDLEYDIR}/notecards"
-if [ ! -e "${NOTECARDSDIR}" ]
-then
-    NOTECARDSDIR=$(cd "${MEDLEYDIR}/../" && pwd)/notecards
-    if [ ! -e "${NOTECARDSDIR}" ]
-    then
-        NOTECARDSDIR=$(cd "${MEDLEYDIR}/../../" && pwd)/notecards
-        if [ ! -e "${NOTECARDSDIR}" ]
-        then
-            NOTECARDSDIR=""
-        fi
-    fi
-fi
-
-if [ -z "${NOTECARDSDIR}" ]
-then
-    echo "Error: Cannot find the Notecards directory"
-    echo "It should be located at ${MEDLEYDIR}/../notecards or"
-    echo "${MEDLEYDIR}/../../notecards.  But its not."
-    echo "Exiting"
-    exit 1
-fi
-
-cat >"${cmfile}" <<"EOF"
-"
-
-(PROGN
-   (IL:MEDLEY-INIT-VARS 'IL:GREET)
-   (IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
-   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD)
-   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD)
-   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD)
-   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD)
-   (IL:LOAD
-       (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM))
-       'IL:SYSLOAD
-   )
-   (IL:HARDRESET)
-)
-SHH
-(PROGN
-   (IL:ENDLOADUP)
-   (CLOS::LOAD-CLOS)
-   (IL:|Apps.LOADUP|)
-   (IL:DRIBBLE)
-   (IL:MAKESYS
-       (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.sysout)))
-       :APPS)
-)
-(IL:LOGOUT T)
-
-"
-EOF
-
-run_medley "${LOADUP_WORKDIR}/full.sysout"
-
-loadup_finish "apps.sysout" "apps.*"
+main "$@"

scripts/loadup-aux.sh

@@ -1,36 +1,135 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+
+	loadup_start
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+	(PROG
+	  ((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
+	  (IL:MEDLEY-INIT-VARS)
+	  (IL:LOAD(QUOTE MEDLEY-UTILS))
+          (DRIBBLE (QUOTE {DSK}<TMP>FOOBAR))
+	  (IL:MAKE-EXPORTS-ALL (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE exports.all))))
+	  (DRIBBLE)
+	  (IL:MAKE-WHEREIS-HASH
+	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.dribble)))
+	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash-tmp)))
+	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash)))
+	  )
+	  (IL:LOGOUT T)
+	)
+	"
+	EOF
+
+	run_medley "${LOADUP_WORKDIR}/full.sysout"
+
+	loadup_finish "whereis.hash" "whereis.hash" "exports.all"
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-cat >"${cmfile}" <<"EOF"
-"
-(PROG
-  ((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
-  (IL:MEDLEY-INIT-VARS)
-  (IL:LOAD(QUOTE MEDLEY-UTILS))
-  (IL:MAKE-EXPORTS-ALL (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE exports.all))))
-  (IL:MAKE-WHEREIS-HASH
-    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.dribble)))
-    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash-tmp)))
-    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash)))
-  )
-  (IL:LOGOUT T)
-)
-"
-EOF
-
-run_medley "${LOADUP_WORKDIR}/full.sysout"
-
-loadup_finish "whereis.hash" "whereis.hash" "exports.all"
+main "$@"

scripts/loadup-db-from-full.sh

@@ -1,46 +1,141 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	loadup_start
+
+	SYSOUT="${MEDLEYDIR}/loadups/full.sysout"
+	if [ ! -f "${SYSOUT}" ];
+	then
+	  echo "Error: cannot find ${SYSOUT}.  Exiting."
+	  exit 1
+	fi
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+
+	(PROG
+	  ((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
+	  (IL:MEDLEY-INIT-VARS)
+	  (IL:FILESLOAD MEDLEY-UTILS)
+	  (SETQ IL:DIRECTORIES (CONS (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) IL:DIRECTORIES))
+	  (IL:MAKE-FULLER-DB
+	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.dribble)))
+	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.database)))
+	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.sysout)))
+	  )
+	  (IL:LOGOUT T)
+	)
+
+	"
+	EOF
+
+	run_medley "${SYSOUT}"
+
+	loadup_finish "fuller.database" "fuller*"
+}
+
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-SYSOUT="${MEDLEYDIR}/loadups/full.sysout"
-if [ ! -f "${SYSOUT}" ];
-then
-  echo "Error: cannot find ${SYSOUT}.  Exiting."
-  exit 1
-fi
-
-cat >"${cmfile}" <<"EOF"
-"
-
-(PROG
-  ((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
-  (IL:MEDLEY-INIT-VARS)
-  (IL:FILESLOAD MEDLEY-UTILS)
-  (SETQ IL:DIRECTORIES (CONS (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) IL:DIRECTORIES))
-  (IL:MAKE-FULLER-DB
-    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.dribble)))
-    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.database)))
-    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.sysout)))
-  )
-  (IL:LOGOUT T)
-)
-
-"
-EOF
-
-run_medley "${SYSOUT}"
-
-loadup_finish "fuller.database" "fuller*"
-
+main "$@"

scripts/loadup-db.sh

@@ -1,26 +1,121 @@
 #!/bin/sh
-# shellcheck disable=SC2181
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main () {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/loadup-db-from-full.sh"  \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/copy-db.sh"
+
+        # shellcheck disable=SC2181
+	if [ $? -eq 0 ];
+	then
+	  echo "+++++ loadup-db.sh: SUCCESS +++++"
+	else
+	  echo "----- loadup-db.sh: FAILURE -----"
+	fi
+}
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-./scripts/loadup-db-from-full.sh && ./scripts/copy-db.sh
-
-if [ $? -eq 0 ];
-then
-  echo "+++++ loadup-db.sh: SUCCESS +++++"
-else
-  echo "----- loadup-db.sh: FAILURE -----"
-fi
+main "$@"
 
 
 

scripts/loadup-full-from-lisp.sh

@@ -1,38 +1,132 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	loadup_start
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+
+	(PROGN
+	  (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR))(QUOTE /LOADUP-FULL.LCOM)))
+	  (IL:LOADUP-FULL (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.dribble))))
+	  (IL:HARDRESET)
+	)
+	SHH
+	(PROGN
+	  (IL:ENDLOADUP)
+	  (IL:MAKESYS (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.sysout))) :FULL))
+	  (IL:LOGOUT T)
+	)
+
+	"
+	EOF
+
+	run_medley "${LOADUP_WORKDIR}/lisp.sysout"
+
+	loadup_finish "full.sysout" "full.*"
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-cat >"${cmfile}" <<"EOF"
-"
-
-(PROGN
-  (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR))(QUOTE /LOADUP-FULL.LCOM)))
-  (IL:LOADUP-FULL (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.dribble))))
-  (IL:HARDRESET)
-)
-SHH
-(PROGN
-  (IL:ENDLOADUP)
-  (IL:MAKESYS (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.sysout))) :FULL))
-  (IL:LOGOUT T)
-)
-
-"
-EOF
-
-run_medley "${LOADUP_WORKDIR}/lisp.sysout"
-
-loadup_finish "full.sysout" "full.*"
-
+main "$@"

scripts/loadup-full.sh

@@ -1,29 +1,121 @@
 #!/bin/sh
-# shellcheck disable=SC2181
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	/bin/sh "${LOADUP_SCRIPTDIR}/loadup-init.sh"              \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-mid-from-init.sh"  \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-lisp-from-mid.sh"  \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-full-from-lisp.sh" \
+	&& /bin/sh "${LOADUP_SCRIPTDIR}/copy-full.sh"             ;
+
+	# shellcheck disable=SC2181
+	if [ $? -eq 0 ];
+	then
+	  echo "+++++ loadup-full.sh: SUCCESS +++++"
+	else
+	  echo "----- loadup-full.sh: FAILURE -----"
+	fi
+}
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. ./scripts/loadup-setup.sh
-
-./scripts/loadup-init.sh && \
-./scripts/loadup-mid-from-init.sh && \
-./scripts/loadup-lisp-from-mid.sh && \
-./scripts/loadup-full-from-lisp.sh && \
-./scripts/copy-full.sh
-
-if [ $? -eq 0 ];
-then
-  echo "+++++ loadup-full.sh: SUCCESS +++++"
-else
-  echo "----- loadup-full.sh: FAILURE -----"
-fi
-
-
+main "$@"

scripts/loadup-init.sh

@@ -1,50 +1,145 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	loadup_start
+
+	cat >"${cmfile}" <<-"EOF"
+	(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh")
+
+	(SETQ MEDLEYDIR NIL)
+	(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
+	(MEDLEY-INIT-VARS)
+	(CNDIR (UNIX-GETENV "LOADUP_WORKDIR"))
+	(DRIBBLE "init.dribble")
+
+	(UNADVISE)
+	(ADVISE 'PAGEFULLFN '(RETURN))
+	(ADVISE '(ERROR IN \DO-DEFINE-FILE-INFO) '(RETURN))
+	(MOVD? 'NILL 'SETTEMPLATE)
+	(DEFINEQ (RRE (LAMBDA (X Y) Y)))
+	(MOVD? 'RRE 'READ-READER-ENVIRONMENT)
+
+	(LOAD (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/" "MAKEINIT.LCOM"))
+	(PROG
+	  ((WORKDIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_WORKDIR") "/"))
+	   (LOADUP-SOURCE-DIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/"))
+	  )
+	  (SETQ DIRECTORIES (CONS LOADUP-SOURCE-DIR DIRECTORIES))
+	  (RESETLST (RESETSAVE OK.TO.MODIFY.FNS T)
+	    (MAKEINITGREET (CONCAT WORKDIR "init.sysout") (CONCAT WORKDIR "init.dlinit"))
+	  )
+	)
+	(DRIBBLE)
+	(LOGOUT T)
+	STOP
+	EOF
+
+	run_medley "${LOADUP_SOURCEDIR}/starter.sysout"
+
+	loadup_finish "init.dlinit" "init.*" "RDSYS*" "I-NEW*"
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-cat >"${cmfile}" <<"EOF"
-(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh")
-
-(SETQ MEDLEYDIR NIL)
-(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
-(MEDLEY-INIT-VARS)
-(CNDIR (UNIX-GETENV "LOADUP_WORKDIR"))
-(DRIBBLE "init.dribble")
-
-(UNADVISE)
-(ADVISE 'PAGEFULLFN '(RETURN))
-(ADVISE '(ERROR IN \DO-DEFINE-FILE-INFO) '(RETURN))
-(MOVD? 'NILL 'SETTEMPLATE)
-(DEFINEQ (RRE (LAMBDA (X Y) Y)))
-(MOVD? 'RRE 'READ-READER-ENVIRONMENT)
-
-(LOAD (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/" "MAKEINIT.LCOM"))
-(PROG
-  ((WORKDIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_WORKDIR") "/"))
-   (LOADUP-SOURCE-DIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/"))
-  )
-  (SETQ DIRECTORIES (CONS LOADUP-SOURCE-DIR DIRECTORIES))
-  (RESETLST (RESETSAVE OK.TO.MODIFY.FNS T)
-    (MAKEINITGREET (CONCAT WORKDIR "init.sysout") (CONCAT WORKDIR "init.dlinit"))
-  )
-)
-(DRIBBLE)
-(LOGOUT T)
-STOP
-EOF
-
-run_medley "${LOADUP_SOURCEDIR}/starter.sysout"
-
-loadup_finish "init.dlinit" "init.*" "RDSYS*" "I-NEW*"
+main "$@"

scripts/loadup-lisp-from-mid.sh

@@ -1,39 +1,134 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	loadup_start
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+
+	(PROGN
+	  (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE MEDLEYDIR)) (QUOTE /sources/MEDLEYDIR.LCOM)))
+	  (MEDLEY-INIT-VARS)
+	  (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM)))
+	  (LOADUP-LISP (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /lisp.dribble)))
+	  (HARDRESET)
+	)
+	SHH
+	(PROGN
+	  (IL:ENDLOADUP)
+	  (IL:MAKESYS (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR)) (IL:L-CASE (QUOTE /lisp.sysout))) :LISP)
+	  (IL:LOGOUT T)
+	)
+
+	"
+	EOF
+
+	run_medley "${LOADUP_WORKDIR}/init-mid.sysout"
+
+	loadup_finish "lisp.sysout" "lisp.*"
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-cat >"${cmfile}" <<"EOF"
-"
-
-(PROGN
-  (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE MEDLEYDIR)) (QUOTE /sources/MEDLEYDIR.LCOM)))
-  (MEDLEY-INIT-VARS)
-  (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM)))
-  (LOADUP-LISP (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /lisp.dribble)))
-  (HARDRESET)
-)
-SHH
-(PROGN
-  (IL:ENDLOADUP)
-  (IL:MAKESYS (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR)) (IL:L-CASE (QUOTE /lisp.sysout))) :LISP)
-  (IL:LOGOUT T)
-)
-
-"
-EOF
-
-run_medley "${LOADUP_WORKDIR}/init-mid.sysout"
-
-loadup_finish "lisp.sysout" "lisp.*"
+main "$@"

scripts/loadup-mid-from-init.sh

@@ -1,30 +1,131 @@
 #!/bin/sh
 
-if [ ! -h ./medley ] || [ ! -d ./lispusers ]
+main() {
+	# shellcheck source=./loadup-setup.sh
+	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
+
+	loadup_start
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+	(MOVD? (QUOTE NILL) (QUOTE PROMPTPRINT))
+	(MOVD? (QUOTE NILL) (QUOTE CURSORP))
+	(MOVD? (QUOTE NILL) (QUOTE CHANGEBACKGROUNDBORDER))
+	(LOGOUT)
+	"
+	EOF
+
+	run_medley "${LOADUP_WORKDIR}/init.dlinit" -NF -prog ldeinit --vmem "${LOADUP_WORKDIR}/init-mid.sysout"
+        if [ "${exit_code}" -eq 54 ]
+        then
+          echo "NOTE: The loadup script $0 requires the ldeinit executable"
+          echo "in addition to the lde executable be available in MAIKODIR."
+          echo "The ldeinit executable could not be found."
+	fi
+
+	echo " "
+
+	loadup_finish "init-mid.sysout" "init-mid.sysout"
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${LOADUP_SCRIPTDIR}" ]
 then
-    echo "*** ERROR ***"
-    echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
-    echo "The cwd ($(pwd)) is not a Medley top-level directory."
-    echo "Exiting."
-    exit 1
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
+	export LOADUP_SCRIPTDIR
+
 fi
 
-# shellcheck source=./loadup-setup.sh
-. scripts/loadup-setup.sh
-
-loadup_start
-
-cat >"${cmfile}" <<"EOF"
-"
-(MOVD? (QUOTE NILL) (QUOTE PROMPTPRINT))
-(MOVD? (QUOTE NILL) (QUOTE CURSORP))
-(MOVD? (QUOTE NILL) (QUOTE CHANGEBACKGROUNDBORDER))
-(LOGOUT)
-"
-EOF
-
-run_medley "${LOADUP_WORKDIR}/init.dlinit" -NF -prog ldeinit --vmem "${LOADUP_WORKDIR}/init-mid.sysout"
-
-echo " "
-
-loadup_finish "init-mid.sysout" "init-mid.sysout"
+main "$@"

scripts/loadup-setup.sh

@@ -1,7 +1,7 @@
-#!sh
+#!to_be_sourced_only
 # shellcheck shell=sh
 
-MEDLEYDIR="$(pwd)"
+MEDLEYDIR=$(cd "${LOADUP_SCRIPTDIR}/.."; pwd)
 export MEDLEYDIR
 
 if [ -z "${LOADUP_WORKDIR}" ]
@@ -141,18 +141,19 @@ loadup_finish () {
 run_medley () {
   if [ ! "${LOADUP_OLDSCHOOL}" = true ]
   then
-    ./medley --config -                                 \
-             --id loadup_+                                     \
-             --geometry "${geometry}"                   \
-             --noscroll                                 \
-             --logindir "${LOADUP_LOGINDIR}"            \
-             --greet "${cmfile}"                        \
-             --sysout "$1"                              \
-             "$2" "$3" "$4" "$5" "$6" "$7"              ;
+    /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command"  \
+             --config -                                          \
+             --id loadup_+                                       \
+             --geometry "${geometry}"                            \
+             --noscroll                                          \
+             --logindir "${LOADUP_LOGINDIR}"                     \
+             --greet "${cmfile}"                                 \
+             --sysout "$1"                                       \
+             "$2" "$3" "$4" "$5" "$6" "$7"                       ;
     exit_code=$?
   else
     # shellcheck disable=SC2086
-    ./run-medley ${scr} $2 $3 $4 $5 $6 $7 -loadup "${cmfile}" "$1"
+    "${MEDLEYDIR}/run-medley" ${scr} $2 $3 $4 $5 $6 $7 -loadup "${cmfile}" "$1"
     exit_code=$?
   fi
 

scripts/medley/medley.command

@@ -197,7 +197,7 @@ the value begins with a \"-\", which is not allowed."
 check_file_writeable_or_creatable() {
   local_msg_core="\"$2\" given as the value of the \"$1\" flag"
   local_err_msg=""
-  if [ -e "$%2" ]
+  if [ -e "$2" ]
   then
     if [ ! -f "$2" ]
     then
@@ -228,7 +228,7 @@ Exiting"
 check_dir_writeable_or_creatable() {
   local_msg_core="\"$2\" given as the value of the \"$1\" flag"
   local_err_msg=""
-  if [ -e "$%2" ]
+  if [ -e "$2" ]
   then
     if [ ! -d "$2" ]
     then
@@ -593,7 +593,7 @@ run_id="default"
 screensize=""
 sysout_arg=""
 sysout_stage=""
-title="Medley Interlisp %i"
+title=""
 use_vnc=false
 windows=false
 maikodir_arg=""
@@ -1235,6 +1235,10 @@ if [ -z "${LDEKBDTYPE}" ]; then
 fi
 
 # figure out title situation
+if [ -z "${title}" ]
+then
+  title="Medley Interlisp %i"
+fi
 if [ ! "${run_id}" = default ]
 then
   title="$(printf %s "${title}" | sed -e "s/%i/:: ${run_id}/")"
@@ -1252,47 +1256,63 @@ fi
 
 # Figure out the maiko directory maiko
 check_if_maiko_dir () {
-  if [ -d "$1/bin" ]
+  if [ -d "$1" ] \
+     && [ -d "$1/bin" ] \
+     && [ -x "$1/bin/osversion" ] \
+     && [ -x "$1/bin/machinetype" ]
+  then
+    maiko_exe_subdir="$("$1/bin/osversion").$("$1/bin/machinetype")"
+    return 0
+  fi
+  return 1
+}
+
+check_for_maiko_exe () {
+  if ! check_if_maiko_dir "$1"
   then
-    cd "$1/bin"
-  else
     return 1
   fi
-  if [ -x ./osversion ] && [ -x ./machinetype ]
+  maiko_exe="$1/${maiko_exe_subdir}/${maikoprog_arg}"
+  if [ -x "${maiko_exe}" ]
   then
-    maiko_exe="$1/$(./osversion).$(./machinetype)/${maikoprog_arg}"
-    if [ -x "${maiko_exe}" ]
-    then
-      cd ${OLDPWD}
-      return 0
-    fi
+    return 0
+  else
+    maiko_exe=""
+    return 1
   fi
-  maiko_exe=""
-  cd ${OLDPWD}
-  return 1
 }
 
 if [ -z "${maikodir_arg}" ]
 then
-  if [ -d "${MEDLEYDIR}/maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/maiko"
+  if check_for_maiko_exe "${MEDLEYDIR}/maiko"
   then
     maikodir_arg="${MEDLEYDIR}/maiko"
-  elif [ -d "${MEDLEYDIR}/../maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/../maiko"
+  elif check_for_maiko_exe "${MEDLEYDIR}/../maiko"
   then
     maikodir_arg="$(cd "${MEDLEYDIR}/../maiko"; pwd)"
   else
-    err_msg="ERROR: Cannot find the directory containing the Maiko emulator in either
+    if ! check_if_maiko_dir "${MEDLEYDIR}/maiko" && ! check_if_maiko_dir "${MEDLEYDIR}/../maiko"
+    then
+      err_msg="ERROR: Cannot find the Maiko directory at either
 \"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
-Please use the --maikodir argument to specify the correct Maiko directory.
+You can use the --maikodir argument to specify the Maiko directory.
 Exiting."
-    output_error_msg "${err_msg}"
-    exit 53
+      output_error_msg "${err_msg}"
+      exit 53
+    else
+      err_msg="ERROR: Cannot find the Maiko executable (${maiko_exe_subdir}/${maikoprog_arg}) in either
+\"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
+Exiting."
+      output_error_msg "${err_msg}"
+      exit 54
+    fi
   fi
-elif ! check_if_maiko_dir "${maikodir_arg}"
+elif ! check_if_maiko_dir "${maikodir_arg}" || ! check_for_maiko_exe "${maikodir_arg}"
 then
   err_msg="In ${maikodir_stage}:
 ERROR: The value of the --maikodir argument is not in fact a directory containing
-the Maiko emulator. Exiting."
+the Maiko emulator (${maiko_exe_subdir}/${maikoprog_arg}).
+Exiting."
   output_error_msg "${err_msg}"
   exit 53
 fi

scripts/medley/medley_args.sh

@@ -27,7 +27,7 @@ run_id="default"
 screensize=""
 sysout_arg=""
 sysout_stage=""
-title="Medley Interlisp %i"
+title=""
 use_vnc=false
 windows=false
 maikodir_arg=""

scripts/medley/medley_run.sh

@@ -182,6 +182,10 @@ if [ -z "${LDEKBDTYPE}" ]; then
 fi
 
 # figure out title situation
+if [ -z "${title}" ]
+then
+  title="Medley Interlisp %i"
+fi
 if [ ! "${run_id}" = default ]
 then
   title="$(printf %s "${title}" | sed -e "s/%i/:: ${run_id}/")"
@@ -199,47 +203,63 @@ fi
 
 # Figure out the maiko directory maiko
 check_if_maiko_dir () {
-  if [ -d "$1/bin" ]
+  if [ -d "$1" ] \
+     && [ -d "$1/bin" ] \
+     && [ -x "$1/bin/osversion" ] \
+     && [ -x "$1/bin/machinetype" ]
+  then
+    maiko_exe_subdir="$("$1/bin/osversion").$("$1/bin/machinetype")"
+    return 0
+  fi
+  return 1
+}
+
+check_for_maiko_exe () {
+  if ! check_if_maiko_dir "$1"
   then
-    cd "$1/bin"
-  else
     return 1
   fi
-  if [ -x ./osversion ] && [ -x ./machinetype ]
+  maiko_exe="$1/${maiko_exe_subdir}/${maikoprog_arg}"
+  if [ -x "${maiko_exe}" ]
   then
-    maiko_exe="$1/$(./osversion).$(./machinetype)/${maikoprog_arg}"
-    if [ -x "${maiko_exe}" ]
-    then
-      cd ${OLDPWD}
-      return 0
-    fi
+    return 0
+  else
+    maiko_exe=""
+    return 1
   fi
-  maiko_exe=""
-  cd ${OLDPWD}
-  return 1
 }
 
 if [ -z "${maikodir_arg}" ]
 then
-  if [ -d "${MEDLEYDIR}/maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/maiko"
+  if check_for_maiko_exe "${MEDLEYDIR}/maiko"
   then
     maikodir_arg="${MEDLEYDIR}/maiko"
-  elif [ -d "${MEDLEYDIR}/../maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/../maiko"
+  elif check_for_maiko_exe "${MEDLEYDIR}/../maiko"
   then
     maikodir_arg="$(cd "${MEDLEYDIR}/../maiko"; pwd)"
   else
-    err_msg="ERROR: Cannot find the directory containing the Maiko emulator in either
+    if ! check_if_maiko_dir "${MEDLEYDIR}/maiko" && ! check_if_maiko_dir "${MEDLEYDIR}/../maiko"
+    then
+      err_msg="ERROR: Cannot find the Maiko directory at either
 \"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
-Please use the --maikodir argument to specify the correct Maiko directory.
+You can use the --maikodir argument to specify the Maiko directory.
 Exiting."
-    output_error_msg "${err_msg}"
-    exit 53
+      output_error_msg "${err_msg}"
+      exit 53
+    else
+      err_msg="ERROR: Cannot find the Maiko executable (${maiko_exe_subdir}/${maikoprog_arg}) in either
+\"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
+Exiting."
+      output_error_msg "${err_msg}"
+      exit 54
+    fi
   fi
-elif ! check_if_maiko_dir "${maikodir_arg}"
+elif ! check_if_maiko_dir "${maikodir_arg}" || ! check_for_maiko_exe "${maikodir_arg}"
 then
   err_msg="In ${maikodir_stage}:
 ERROR: The value of the --maikodir argument is not in fact a directory containing
-the Maiko emulator. Exiting."
+the Maiko emulator (${maiko_exe_subdir}/${maikoprog_arg}).
+Exiting."
   output_error_msg "${err_msg}"
   exit 53
 fi

scripts/medley/medley_utils.sh

@@ -51,7 +51,7 @@ the value begins with a \"-\", which is not allowed."
 check_file_writeable_or_creatable() {
   local_msg_core="\"$2\" given as the value of the \"$1\" flag"
   local_err_msg=""
-  if [ -e "$%2" ]
+  if [ -e "$2" ]
   then
     if [ ! -f "$2" ]
     then
@@ -82,7 +82,7 @@ Exiting"
 check_dir_writeable_or_creatable() {
   local_msg_core="\"$2\" given as the value of the \"$1\" flag"
   local_err_msg=""
-  if [ -e "$%2" ]
+  if [ -e "$2" ]
   then
     if [ ! -d "$2" ]
     then

sources/ADIR

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}<sources>ADIR.;38
 67777  
+
(FILECREATED " 6-May-2024 15:54:01" {WMEDLEY}<sources>ADIR.;45
 67756  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY)
+      :CHANGES-TO (FNS \UPF.DIRECTORY)
 
-      :PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31)
+      :PREVIOUS-DATE " 4-May-2024 16:25:09" {WMEDLEY}<sources>ADIR.;44)
 
 
 (PRETTYCOMPRINT ADIRCOMS)
@@ -317,7 +317,8 @@
 (DEFINEQ
 
 (UNPACKFILENAME.STRING

-  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)
     (* ; "Edited  9-Mar-2024 10:23 by rmk")


+  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)
     (* ; "Edited  4-May-2024 12:45 by rmk")


+                                                             (* ; "Edited  9-Mar-2024 10:23 by rmk")


                                                              (* ; "Edited 13-Nov-2023 20:28 by rmk")


                                                              (* ; "Edited 28-Apr-2022 11:40 by rmk")


                                                              (* ; "Edited 24-Apr-2022 14:11 by rmk")

@@ -350,7 +351,6 @@
     (* ;; "")

 
     (* ;; "     If there is at least one / or > then the last one ends the directory, anything before is possibly a relative or subdirectory.  Anything after is a name")

-                                                             (* ; "")

 
     (* ;; "              (Rationale:  Those are not sub-directory brackets)")

 
@@ -662,52 +662,48 @@
                                                   (PUSH
 $$VAL F FVAL])
 
 (\UPF.DIRECTORY

-  [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)
(* ; "Edited  8-Mar-2024 23:03 by rmk")


+  [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)
(* ; "Edited  6-May-2024 15:53 by rmk")


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


+                                                             (* ; "Edited  8-Mar-2024 23:03 by rmk")


                                                              (* ; "Edited 28-Apr-2022 09:15 by rmk")


                                                              (* ; "Edited 27-Apr-2022 08:50 by rmk")


                                                              (* ; "Edited 23-Apr-2022 17:09 by rmk")

 
-    (* ;; "Relative directory {abc}<foo or {abc}< with no >, subdirectory >foo or > with no host or device (DIRSTART=1).  ")

+    (* ;; "Extract the directory field, producing <> for the empty (top-level) directory, normalizing / to < or >.")

 
-    (* ;; "Advance DIRSTART through initial duplicates")

+    (if
 (ILEQ DIREND DIRSTART)
+        then
 
+             (* ;; "An empty directory field is interpreted as the top as per issue #1685:  <xy  >xy  /xy all map to <>")

 
-    (LET ((BRACKET (SELCHARQ (\GETBASECHAR $$FATP $$BASE DIRSTART)
-                        ((< /) 
-                             "<")
-                        (> ">")
-                        NIL)))
-         (IF
 (EQ DIREND DIRSTART)
-             THEN
 
-                  (* ;; "If EQ, the directory is is empty.")

+             (MKSTRING "<")
+      else
 (CL:WHEN (MEMB (\GETBASECHAR $$FATP $$BASE DIRSTART)
+                          (CHARCODE (< / >)))                (* ; "Skip leading brackets")

+               (ADD
 DIRSTART 1)) 
 
-                  (MKSTRING "")
-           ELSE
 (CL:WHEN BRACKET                             (* ; "Skip the < or /")

-                    (ADD
 DIRSTART 1)) 
+           (* ;; 
+
           "If DIRDIRTY, the string contained at least one / that has to be converted to < or >")

 
-                (* ;; 
-
         "Convert / to >, remove all  // /> >> duplicate sequences (keep the first, skip the others)")

+           (IF
 DIRDIRTY
+               THEN
 (FOR
 DIROFF C DEST DESTBASE (DESTPOS _ -1) FROM
 DIRSTART TO
 DIREND
+                       FIRST
 (SETQ DEST (ALLOCSTRING (ADD1 (IDIFFERENCE DIREND DIRSTART))
+                                               NIL NIL $$FATP))
+                             (SETQ DESTBASE (FETCH
 (STRINGP BASE) OF
 DEST))
+                       DO
 (ADD
 DESTPOS 1)
+                          (SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF))
+                          (SELCHARQ C
+                               ((> /) 
+                                    (\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >))
 
-                (IF
 DIRDIRTY
-                    THEN
 (FOR
 DIROFF C DEST DESTBASE (DESTPOS _ -1) FROM
 DIRSTART TO
 DIREND
-                            FIRST
 (SETQ DEST (ALLOCSTRING (ADD1 (IDIFFERENCE DIREND DIRSTART))
-                                                    NIL NIL $$FATP))
-                                  (SETQ DESTBASE (FETCH
 (STRINGP BASE) OF
 DEST))
-                            DO
 (ADD
 DESTPOS 1)
-                               (SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF))
-                               (SELCHARQ C
-                                    ((> /) 
-                                         (\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >))
+                                    (* ;; "Advance past duplicates")

 
-                                         (* ;; "Advance past duplicates")

-
-                                         (FIND
 I FROM
 (ADD1 DIROFF) TO
 DIREND
-                                            WHILE
 (FMEMB (\GETBASECHAR $$FATP $$BASE I)
-                                                         (CHARCODE (> /)))
-                                            FINALLY
 (SETQ DIROFF (SUB1 I))))
-                                    (\PUTBASECHAR $$FATP DESTBASE DESTPOS C))
-                            FINALLY
 (REPLACE
 (STRINGP LENGTH) OF
 DEST WITH
 DESTPOS)
-                                  (RETURN DEST))
-                  ELSE
 (\UPF.EXTRACT DIRSTART (SUB1 DIREND])
+                                    (FIND
 I FROM
 (ADD1 DIROFF) TO
 DIREND
+                                       WHILE
 (FMEMB (\GETBASECHAR $$FATP $$BASE I)
+                                                    (CHARCODE (> /))) FINALLY
 (SETQ DIROFF
+                                                                               (SUB1 I))))
+                               (\PUTBASECHAR $$FATP DESTBASE DESTPOS C))
+                       FINALLY
 (REPLACE
 (STRINGP LENGTH) OF
 DEST WITH
 DESTPOS)
+                             (RETURN DEST))
+             ELSE
 (\UPF.EXTRACT DIRSTART (SUB1 DIREND])
 )
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -1254,14 +1250,14 @@
 (ADDTOVAR LAMA
 PACKFILENAME.STRING PACKFILENAME)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3169 15826 (DELFILE 3179 . 3340) (FULLNAME 3342 . 3709) (INFILE 3711 . 3970) (INFILEP 
-3972 . 4107) (IOFILE 4109 . 4360) (OPENFILE 4362 . 4665) (OPENSTREAM 4667 . 9007) (OUTFILE 9009 . 9271
-) (OUTFILEP 9273 . 9409) (RENAMEFILE 9411 . 9717) (SIMPLE.FINDFILE 9719 . 10129) (VMEMSIZE 10131 . 
-10298) (\COPYSYS 10300 . 14545) (\FLUSHVM 14547 . 15619) (\LOGOUT0 15621 . 15824)) (16284 38972 (
-UNPACKFILENAME.STRING 16294 . 36274) (\UPF.DIRECTORY 36276 . 38970)) (40500 42806 (UNPACKFILENAME 
-40510 . 40696) (LASTCHPOS 40698 . 41392) (FILENAMEFIELD 41394 . 41688) (FILENAMEFIELD.STRING 41690 . 
-42094) (PACKFILENAME 42096 . 42439) (PACKFILENAME.STRING 42441 . 42804)) (57276 58189 (
-FILEDIRCASEARRAY 57286 . 58187)) (58356 65536 (LOGOUT 58366 . 59283) (MAKESYS 59285 . 60914) (SYSOUT 
-60916 . 62468) (SAVEVM 62470 . 63270) (HERALD 63272 . 63432) (INTERPRET.REM.CM 63434 . 65159) (
-\USEREVENT 65161 . 65534)) (65718 67445 (USERNAME 65728 . 66684) (SETUSERNAME 66686 . 67443)))))
+  (FILEMAP (NIL (3112 15769 (DELFILE 3122 . 3283) (FULLNAME 3285 . 3652) (INFILE 3654 . 3913) (INFILEP 
+3915 . 4050) (IOFILE 4052 . 4303) (OPENFILE 4305 . 4608) (OPENSTREAM 4610 . 8950) (OUTFILE 8952 . 9214
+) (OUTFILEP 9216 . 9352) (RENAMEFILE 9354 . 9660) (SIMPLE.FINDFILE 9662 . 10072) (VMEMSIZE 10074 . 
+10241) (\COPYSYS 10243 . 14488) (\FLUSHVM 14490 . 15562) (\LOGOUT0 15564 . 15767)) (16227 38951 (
+UNPACKFILENAME.STRING 16237 . 36252) (\UPF.DIRECTORY 36254 . 38949)) (40479 42785 (UNPACKFILENAME 
+40489 . 40675) (LASTCHPOS 40677 . 41371) (FILENAMEFIELD 41373 . 41667) (FILENAMEFIELD.STRING 41669 . 
+42073) (PACKFILENAME 42075 . 42418) (PACKFILENAME.STRING 42420 . 42783)) (57255 58168 (
+FILEDIRCASEARRAY 57265 . 58166)) (58335 65515 (LOGOUT 58345 . 59262) (MAKESYS 59264 . 60893) (SYSOUT 
+60895 . 62447) (SAVEVM 62449 . 63249) (HERALD 63251 . 63411) (INTERPRET.REM.CM 63413 . 65138) (
+\USEREVENT 65140 . 65513)) (65697 67424 (USERNAME 65707 . 66663) (SETUSERNAME 66665 . 67422)))))
 STOP

sources/CMLEXEC

@@ -1,15 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Dec-2021 09:48:29" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLEXEC.;5
 91886  
+
(FILECREATED "24-May-2024 20:54:49" {MEDLEY}<SOURCES>CMLEXEC.;3
 92134  
 
-      :CHANGES-TO (VARS CMLEXECCOMS)
+      :EDIT-BY "mth"
 
-      :PREVIOUS-DATE " 8-Oct-2021 10:51:35" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLEXEC.;3)
+      :CHANGES-TO (FUNCTIONS PRINT-ALL-DOCUMENTATION)
+                  (VARS CMLEXECCOMS)
+
+      :PREVIOUS-DATE "20-May-2024 21:28:00" {MEDLEY}<SOURCES>CMLEXEC.;2)
 
 
 (* ; "
-Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
+Copyright (c) 1985-1988, 1990-1991, 1993, 2021, 2024 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT CMLEXECCOMS)
@@ -58,9 +60,11 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
         (* ;; "Arrange to use the correct compiler")

 
         (PROP FILETYPE CMLEXEC)
-        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DIR)
-                                                                             (NLAML)
-                                                                             (LAMA])
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
+               (ADDVARS (NLAMA DIR)
+                      (NLAML)
+                      (LAMA PROCESS-EXEC-ID PRINT-EVENT PRINT-HISTORY EXEC-PRIN1 EVENTS-INPUT 
+                            EVAL-INPUT EXEC-READ])
 
 (FILESLOAD CMLUNDO PROFILE)
 
@@ -422,12 +426,13 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
                          IT)))
         (CL:VALUES-LIST VALUES)))
 
-(CL:DEFUN PRINT-ALL-DOCUMENTATION
 (NAME)
+(CL:DEFUN PRINT-ALL-DOCUMENTATION
 (NAME)
                     (* ; "Edited 24-May-2024 20:52 by mth")

    "Print all documentation strings for NAME (as symbol and string)."
    (LET ((FOUND NIL))
         (CL:DOLIST (TYPE FILEPKGTYPES)
             (CL:WHEN (AND (CL:SYMBOLP TYPE)
-                          (GET TYPE 'DEFINED-BY)
+                          (OR (GET TYPE :DEFINED-BY)
+                              (GET TYPE 'DEFINED-BY))
                           (HASH-TABLE-FOR-DOC-TYPE TYPE))
                 (SETQ FOUND (OR (PRINT-DOCUMENTATION
 NAME TYPE)
                                 FOUND))
@@ -1737,26 +1742,28 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
 
 (ADDTOVAR NLAML
 )
 
-(ADDTOVAR LAMA
 )
+(ADDTOVAR LAMA
 PROCESS-EXEC-ID PRINT-EVENT PRINT-HISTORY EXEC-PRIN1 EVENTS-INPUT EVAL-INPUT EXEC-READ)
+)
+(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021 2024)
 )
-(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4002 4407 (XCL::EXEC-CLOSEFN 4002 . 4407)) (4409 4745 (XCL::EXEC-SHRINKFN 4409 . 4745))
- (4747 4987 (XCL::SETUP-EXEC-WINDOW 4747 . 4987)) (4989 5235 (XCL::EXEC-TITLE-FUNCTION 4989 . 5235)) (
-5237 8404 (FIX-FORM 5237 . 8404)) (8406 8526 (XCL::GET-PROCESS-PROFILE 8406 . 8526)) (8528 8809 (
-XCL::SAVE-CURRENT-EXEC-PROFILE 8528 . 8809)) (8811 9097 (XCL::SETF-GET-PROCESS-PROFILE 8811 . 9097)) (
-9099 9666 (XCL:SET-EXEC-TYPE 9099 . 9666)) (9668 9750 (XCL:SET-DEFAULT-EXEC-TYPE 9668 . 9750)) (9752 
-10159 (XCL::ENTER-EXEC-FUNCTION 9752 . 10159)) (10234 16465 (DO-EVENT 10234 . 16465)) (16467 23064 (
-EXEC 16467 . 23064)) (23066 24317 (EXEC-EVAL 23066 . 24317)) (24319 25050 (PRINT-ALL-DOCUMENTATION 
-24319 . 25050)) (25052 25494 (PRINT-DOCUMENTATION 25052 . 25494)) (25577 26652 (ADD-EXEC 25577 . 26652
-)) (26654 30264 (EXEC-READ-LINE 26654 . 30264)) (30335 30821 (FIND-EXEC-COMMAND 30335 . 30821)) (30823
- 32709 (CIRCLAR-COPYER 30823 . 32709)) (32710 33664 (COPY-CIRCLE 32720 . 33662)) (33742 37047 (
-EXEC-READ 33752 . 36913) (DIR 36915 . 37045)) (39301 66435 (DO-APPLY-EVENT 39311 . 39873) (
-DO-HISTORY-SEARCH 39875 . 41332) (EVAL-INPUT 41334 . 46763) (EVENTS-INPUT 46765 . 48143) (EXEC-PRIN1 
-48145 . 48321) (EXEC-VALUE-OF 48323 . 48662) (GET-NEXT-HISTORY-EVENT 48664 . 50159) (
-HISTORY-ADD-TO-SPELLING-LISTS 50161 . 51149) (HISTORY-NTH 51151 . 51901) (PRINT-HISTORY 51903 . 52524)
- (FIND-HISTORY-EVENTS 52526 . 57587) (PRINT-EVENT 57589 . 61810) (PRINT-EVENT-PROMPT 61812 . 63016) (
-PROCESS-EXEC-ID 63018 . 63963) (SEARCH-FOR-EVENT-NUMBER 63965 . 64593) (\PICK.EVALQT 64595 . 65106) (
-LISPXREPRINT 65108 . 66433)) (67615 67714 (EXEC-PRINT 67615 . 67714)) (67716 67981 (EXEC-FORMAT 67716
- . 67981)))))
+  (FILEMAP (NIL (4032 4437 (XCL::EXEC-CLOSEFN 4032 . 4437)) (4439 4775 (XCL::EXEC-SHRINKFN 4439 . 4775))
+ (4777 5017 (XCL::SETUP-EXEC-WINDOW 4777 . 5017)) (5019 5265 (XCL::EXEC-TITLE-FUNCTION 5019 . 5265)) (
+5267 8434 (FIX-FORM 5267 . 8434)) (8436 8556 (XCL::GET-PROCESS-PROFILE 8436 . 8556)) (8558 8839 (
+XCL::SAVE-CURRENT-EXEC-PROFILE 8558 . 8839)) (8841 9127 (XCL::SETF-GET-PROCESS-PROFILE 8841 . 9127)) (
+9129 9696 (XCL:SET-EXEC-TYPE 9129 . 9696)) (9698 9780 (XCL:SET-DEFAULT-EXEC-TYPE 9698 . 9780)) (9782 
+10189 (XCL::ENTER-EXEC-FUNCTION 9782 . 10189)) (10264 16495 (DO-EVENT 10264 . 16495)) (16497 23094 (
+EXEC 16497 . 23094)) (23096 24347 (EXEC-EVAL 23096 . 24347)) (24349 25206 (PRINT-ALL-DOCUMENTATION 
+24349 . 25206)) (25208 25650 (PRINT-DOCUMENTATION 25208 . 25650)) (25652 25731 (VALUE-OF 25652 . 25731
+)) (25733 26808 (ADD-EXEC 25733 . 26808)) (26810 30420 (EXEC-READ-LINE 26810 . 30420)) (30422 30489 (
+EXEC-EVENT-ID-PROMPT 30422 . 30489)) (30491 30977 (FIND-EXEC-COMMAND 30491 . 30977)) (30979 32865 (
+CIRCLAR-COPYER 30979 . 32865)) (32866 33820 (COPY-CIRCLE 32876 . 33818)) (33898 37203 (EXEC-READ 33908
+ . 37069) (DIR 37071 . 37201)) (39457 66591 (DO-APPLY-EVENT 39467 . 40029) (DO-HISTORY-SEARCH 40031 . 
+41488) (EVAL-INPUT 41490 . 46919) (EVENTS-INPUT 46921 . 48299) (EXEC-PRIN1 48301 . 48477) (
+EXEC-VALUE-OF 48479 . 48818) (GET-NEXT-HISTORY-EVENT 48820 . 50315) (HISTORY-ADD-TO-SPELLING-LISTS 
+50317 . 51305) (HISTORY-NTH 51307 . 52057) (PRINT-HISTORY 52059 . 52680) (FIND-HISTORY-EVENTS 52682 . 
+57743) (PRINT-EVENT 57745 . 61966) (PRINT-EVENT-PROMPT 61968 . 63172) (PROCESS-EXEC-ID 63174 . 64119) 
+(SEARCH-FOR-EVENT-NUMBER 64121 . 64749) (\PICK.EVALQT 64751 . 65262) (LISPXREPRINT 65264 . 66589)) (
+66723 67717 (CASE-EQUALP 66723 . 67717)) (67719 67769 (EXEC-EVENT-PROPS 67719 . 67769)) (67771 67870 (
+EXEC-PRINT 67771 . 67870)) (67872 68137 (EXEC-FORMAT 67872 . 68137)))))
 STOP

sources/CMLTYPES

@@ -1,15 +1,20 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
-
(IL:FILECREATED " 4-Jan-93 17:55:42" IL:|{DSK}<python>lde>lispcore>sources>CMLTYPES.;2|
 66088  
+(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
 
-      IL:|previous| IL:|date:| "16-May-90 14:50:29" IL:|{DSK}<python>lde>lispcore>sources>CMLTYPES.;1|
+
(IL:FILECREATED " 4-Jun-2024 23:32:50" IL:|{DSK}<home>matt>Interlisp>medley>SOURCES>CMLTYPES.;2|
 66046  
+
+      :EDIT-BY "mth"
+
+      :CHANGES-TO (IL:FUNCTIONS SYMBOL-TYPE)
+
+      :PREVIOUS-DATE " 4-Jan-93 17:55:42" IL:|{DSK}<home>matt>Interlisp>medley>SOURCES>CMLTYPES.;1|
 )
 
 
-; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1985-1988, 1990, 1993, 2024 by Venue & Xerox Corporation.
 
 (IL:PRETTYCOMPRINT IL:CMLTYPESCOMS)
 
-(IL:RPAQQ IL:CMLTYPESCOMS
 
+(IL:RPAQQ IL:CMLTYPESCOMS

           (
 
 (IL:* IL:|;;;| "Implementation of Common Lisp type system.  ")

@@ -137,8 +142,8 @@
    (IL:* IL:|;;| "Check if OBJECT is of type TYPE")

 
    (LET* ((SYMBOL-TYPE
 (IF (CONSP TYPE)
-                               (CAR TYPE)
-                               TYPE))
+                           (CAR TYPE)
+                           TYPE))
           (FN (GETHASH SYMBOL-TYPE *TYPEP-HASH-TABLE*)))
          (IF FN
              (IF (CONSP TYPE)
@@ -174,8 +179,7 @@
                                          (ERROR "Unknown type expression: ~s" TYPE)))))))))
 
 (DEFUN TYPE-OF
 (X)
-   (LET ((TYPENAME (IL:\\INDEXATOMPNAME (IL:|fetch|
 IL:DTDNAME IL:|of|
 (IL:\\GETDTD
-                                                                                (IL:NTYPX X))))))
+   (LET ((TYPENAME (IL:\\INDEXATOMPNAME (IL:|fetch|
 IL:DTDNAME IL:|of|
 (IL:\\GETDTD (IL:NTYPX X))))))
         (SETQ TYPENAME (OR (GET TYPENAME 'CMLTYPE)
                            TYPENAME))
         (OR (LET ((D (GET TYPENAME 'CMLSUBTYPE-DESCRIMINATOR)))
@@ -245,27 +249,27 @@
            (NULL TYPE))))
 
 (XCL:DEFOPTIMIZER TYPEP
 (OBJ TYPE)
-                            (IF (CONSTANTP TYPE)
-                                (LET ((TYPE-EXPR (EVAL TYPE)))
-                                     (IF (%VALID-TYPE-P
 TYPE-EXPR)
-                                         `(,(%TYPEP-PRED
 TYPE-EXPR)
-                                           ,OBJ)
-                                         (PROGN (WARN "Can't optimize (typep ~s ~s); type not known."
-                                                      OBJ TYPE)
-                                                'COMPILER:PASS)))
-                                'COMPILER:PASS))
+                        (IF (CONSTANTP TYPE)
+                            (LET ((TYPE-EXPR (EVAL TYPE)))
+                                 (IF (%VALID-TYPE-P
 TYPE-EXPR)
+                                     `(,(%TYPEP-PRED
 TYPE-EXPR)
+                                       ,OBJ)
+                                     (PROGN (WARN "Can't optimize (typep ~s ~s); type not known." OBJ
+                                                  TYPE)
+                                            'COMPILER:PASS)))
+                            'COMPILER:PASS))
 
 (XCL:DEFOPTIMIZER COERCE
 (OBJECT RESULT-TYPE)
 
-                             (IL:* IL:|;;| "Open code the simple coerce cases ")

+                         (IL:* IL:|;;| "Open code the simple coerce cases ")

 
-                             (IF (CONSTANTP RESULT-TYPE)
-                                 (CASE (EVAL RESULT-TYPE)
-                                     (CHARACTER `(CHARACTER ,OBJECT))
-                                     ((FLOAT SINGLE-FLOAT SHORT-FLOAT LONG-FLOAT DOUBLE-FLOAT) 
-                                        `(FLOAT ,OBJECT))
-                                     (OTHERWISE 'COMPILER:PASS))
-                                 'COMPILER:PASS))
+                         (IF (CONSTANTP RESULT-TYPE)
+                             (CASE (EVAL RESULT-TYPE)
+                                 (CHARACTER `(CHARACTER ,OBJECT))
+                                 ((FLOAT SINGLE-FLOAT SHORT-FLOAT LONG-FLOAT DOUBLE-FLOAT) 
+                                    `(FLOAT ,OBJECT))
+                                 (OTHERWISE 'COMPILER:PASS))
+                             'COMPILER:PASS))
 
 
 
@@ -275,10 +279,10 @@
 (XCL:DEF-DEFINE-TYPE IL:TYPES
 "Common Lisp type definitions")
 
 (XCL:DEFDEFINER (DEFTYPE
 (:PROTOTYPE (LAMBDA (NAME)
-                                                (AND (SYMBOLP NAME)
-                                                     `(DEFTYPE ,NAME ("Arg list")
-                                                         "Body"))))) IL:TYPES (NAME DEFTYPE-ARGS 
-                                                                                    &BODY BODY)
+                                            (AND (SYMBOLP NAME)
+                                                 `(DEFTYPE ,NAME ("Arg list")
+                                                     "Body"))))) IL:TYPES (NAME DEFTYPE-ARGS &BODY 
+                                                                                BODY)
    (UNLESS (AND NAME (SYMBOLP NAME))
           (ERROR "Illegal name used in DEFTYPE: ~S" NAME))
    (LET
@@ -321,8 +325,8 @@
 
 (DEFUN TYPE-EXPANDER
 (TYPE)
    (LET* ((SYMBOL-TYPE
 (ETYPECASE TYPE
-                               (SYMBOL TYPE)
-                               (CONS (CAR TYPE))))
+                           (SYMBOL TYPE)
+                           (CONS (CAR TYPE))))
           (EXPANDER (OR (GET SYMBOL-TYPE ':TYPE-EXPANDER)
                         (GET SYMBOL-TYPE 'IL:TYPE-EXPANDER))))
          (IF (AND (NULL EXPANDER)
@@ -342,7 +346,7 @@
                             (IL:FILEPKGFLG NIL)
 
                             (IL:* IL:|;;| 
-
      "DFNFLG nil makes sure this has an effect and filepkgflg nil makes sure it isn't remembered.")

+
        "DFNFLG nil makes sure this has an effect and filepkgflg nil makes sure it isn't remembered.")

 
                             )
                            (EVAL DEFTYPE-FORM)))
@@ -394,10 +398,13 @@
                 (LIST 'ARRAY (ARRAY-ELEMENT-TYPE ARRAY)
                       (ARRAY-DIMENSIONS ARRAY))))))
 
-(DEFUN SYMBOL-TYPE
 (SYMBOL)
-   (IF (KEYWORDP SYMBOL)
-       'KEYWORD
-       'SYMBOL))
+(DEFUN SYMBOL-TYPE
 (SYMBOL)
                           (IL:* IL:\; "Edited  4-Jun-2024 23:23 by mth")

+   (COND
+      ((NULL SYMBOL)
+       'NULL)
+      ((KEYWORDP SYMBOL)
+       'KEYWORD)
+      (T 'SYMBOL)))
 
 (DEFUN XCL:FALSE
 ()
    NIL)
@@ -474,18 +481,18 @@
         T))
 
 (XCL:DEFOPTIMIZER NUMBERP
 (X)
-                              `(AND (IL:NUMBERP ,X)
-                                    T))
+                          `(AND (IL:NUMBERP ,X)
+                                T))
 
 (XCL:DEFOPTIMIZER FLOATP
 (X)
-                             `(AND (IL:FLOATP ,X)
-                                   T))
+                         `(AND (IL:FLOATP ,X)
+                               T))
 
 (XCL:DEFOPTIMIZER XCL:FALSE
 (&BODY IL:FORMS)
-                                `(PROG1 NIL ,@IL:FORMS))
+                            `(PROG1 NIL ,@IL:FORMS))
 
 (XCL:DEFOPTIMIZER XCL:TRUE
 (&BODY XCL::FORMS)
-                               `(PROG1 T ,@XCL::FORMS))
+                           `(PROG1 T ,@XCL::FORMS))
 
 
 
@@ -546,7 +553,7 @@
 (DEFCONSTANT *COMMON-LISP-BASE-TYPES*

 
    (IL:* IL:|;;| 
-
 "The types which are known to be disjoint from any type explicitly handled by subtypep.")

+
   "The types which are known to be disjoint from any type explicitly handled by subtypep.")

 
    '(
      (IL:* IL:|;;| "The only types that need to be in this list are types on page 43 that expand into a satisfies or datatype clause, i.e. any type that expands into something that base-subtypep doesn't know to handle, e.g. satisfies.")

@@ -554,10 +561,10 @@
      ARRAY ATOM BIGNUM                                       (IL:* IL:\; "even though bignum expands into a datatype, that datatype is not a subdatatype of integer, etc. so must be explicitly handled.")

      CHARACTER COMMON COMPLEX COMPILED-FUNCTION CONS IL:DATATYPE 
                                                              (IL:* IL:\; 
-
              "this is only here for back-compatibility.  The first global recompile, this can go.")

+
                "this is only here for back-compatibility.  The first global recompile, this can go.")

      :DATATYPE FLOAT FUNCTION HASH-TABLE INTEGER KEYWORD NIL NULL NUMBER PACKAGE PATHNAME 
      RANDOM-STATE RATIO                                      (IL:* IL:\; 
-
                                                           "same comment for ratio as bignum.")

+
                                                             "same comment for ratio as bignum.")

      RATIONAL READTABLE SIMPLE-ARRAY STANDARD-CHAR STREAM STRING-CHAR SYMBOL T))
 
 (DEFCONSTANT *BASE-TYPE-LATTICE*

@@ -572,14 +579,14 @@
      #'COMPILED-FUNCTION
      (NIL)
      (IL:DATATYPE :DATATYPE)                                 (IL:* IL:\; 
-
                                           "the presence of il:datatype is for back compatibility.")

+
                                             "the presence of il:datatype is for back compatibility.")

      (:DATATYPE IL:DATATYPE))
    "the lattice which tells the (base) subtypes of any base type.")
 
 (DEFUN SUBTYPEP
 (TYPE1 TYPE2)
 
    (IL:* IL:|;;| 
-
 "Returns T if type1 is a subtype of type2.  If second value is nil, couldn't decide.")

+
   "Returns T if type1 is a subtype of type2.  If second value is nil, couldn't decide.")

 
    (IF (EQUAL TYPE1 TYPE2)
 
@@ -608,7 +615,7 @@
            (OR 
 
               (IL:* IL:|;;| 
-
            "(subtypep '(or t1 t2 ...) 't3) <=> (and (subtypep 't1 't3) (subtypep 't2 't3) ...)")

+
              "(subtypep '(or t1 t2 ...) 't3) <=> (and (subtypep 't1 't3) (subtypep 't2 't3) ...)")

 
               (LET ((RESULT T)
                     CERTAINTY
@@ -628,7 +635,7 @@
                                                (RETURN T)
 
                                                (IL:* IL:|;;| 
-
                                             "else continue to look for a more cetain result")

+
                                               "else continue to look for a more cetain result")

 
                                                (SETQ LOOP-CERTAINTY NIL)))
                                           (T (IF (NULL CONJUNCT-CERTAINTY)
@@ -669,7 +676,7 @@
                                                            (RETURN T)
 
                                                            (IL:* IL:|;;| 
-
                                                   "else continue to look for a more cetain result")

+
                                                     "else continue to look for a more cetain result")

 
                                                            (SETQ LOOP-CERTAINTY NIL)))
                                                       (T (IF (NULL CONJUNCT-CERTAINTY)
@@ -680,7 +687,7 @@
                           (IL:* IL:|;;| "(subtypep 't1 '(or t2 t3 ...)) <=> (or (subtypep 't1 't2) (subtypep 't1 't3) ...  ) because '(or t1 t2 ...) denotes the union of types t1, t2, ...")

 
                           (IL:* IL:|;;| 
-
        "We can't ever return (values nil t) because the t2..tn might form a partition of t1, i.e.")

+
          "We can't ever return (values nil t) because the t2..tn might form a partition of t1, i.e.")

 
                           (IL:* IL:|;;| "(deftype evenp nil '(and integer (satisfies %evenp)))")

 
@@ -709,7 +716,7 @@
                                      (SUBTYPEP
 TYPE1 NEW-TYPE2)
 
                                      (IL:* IL:|;;| 
-
   "we have now handled everything but base types.  There is no further expansion etc, to be done.")

+
     "we have now handled everything but base types.  There is no further expansion etc, to be done.")

 
                                      (BASE-SUBTYPEP
 TYPE1 TYPE2)))))))))))
 
@@ -737,10 +744,9 @@
 
    (DO* ((TYPE-NUMBER-1 (IL:\\TYPENUMBERFROMNAME TYPE1))
          (TYPE-NUMBER-2 (IL:\\TYPENUMBERFROMNAME TYPE2))
-         (SUPER-TYPE-NUMBER TYPE-NUMBER-1 (IL:|fetch|
 IL:DTDSUPERTYPE IL:|of|
 (IL:\\GETDTD
-                                                                                       
+         (SUPER-TYPE-NUMBER TYPE-NUMBER-1 (IL:|fetch|
 IL:DTDSUPERTYPE IL:|of|
 (IL:\\GETDTD 
                                                                                     SUPER-TYPE-NUMBER
-                                                                                       ))))
+                                                                                     ))))
         ((EQ %NO-SUPER-TYPE SUPER-TYPE-NUMBER)
 
          (IL:* IL:|;;| "we didn't find type2 on type1's super chain so return NIL  ")

@@ -752,7 +758,7 @@
 (DEFUN EQUAL-DIMENSIONS
 (DIMS1 DIMS2)
 
    (IL:* IL:|;;| 
-
 "Says if dims1 and dims2 are the same in each dimension (allowing for wildcard's (*'s)).")

+
   "Says if dims1 and dims2 are the same in each dimension (allowing for wildcard's (*'s)).")

 
    (OR (EQ DIMS1 '*)
        (EQ DIMS2 '*)
@@ -784,12 +790,12 @@
                         TYPE
                         (LIST TYPE))))
         (CASE (CAR LIST-TYPE)
-            ((SIMPLE-ARRAY ARRAY) (XCL:DESTRUCTURING-BIND (ARRAY-TYPE
 &OPTIONAL
-                                                                 (ELEMENT-TYPE '*)
+            ((SIMPLE-ARRAY ARRAY) (XCL:DESTRUCTURING-BIND (ARRAY-TYPE
 &OPTIONAL (ELEMENT-TYPE
+                                                                                 '*)
                                                                  (DIMENSIONS '*))
                                          LIST-TYPE
                                          (LIST ARRAY-TYPE ELEMENT-TYPE (
-
                                                                     COMPLETE-ARRAY-TYPE-DIMENSIONS

+
                                                                       COMPLETE-ARRAY-TYPE-DIMENSIONS

                                                                         DIMENSIONS))))
             ((INTEGER FLOAT RATIONAL) (XCL:DESTRUCTURING-BIND (NUMERIC-TYPE &OPTIONAL
                                                                      (LOWER '*)
@@ -886,17 +892,17 @@
            (IL:* IL:|;;| "from this point on, we are only dealing with Common Lisp base types.")

 
            ((EQ TYPE1 T)                                     (IL:* IL:\; 
-
                                 "t is not a subtype of anything but t, and that's checked above).")

+
                                   "t is not a subtype of anything but t, and that's checked above).")

             (VALUES NIL T))
            ((EQ TYPE2 NIL)                                   (IL:* IL:\; 
-
                           "nil is not a supertype of anything but nil, and that's checked above).")

+
                             "nil is not a supertype of anything but nil, and that's checked above).")

             (VALUES NIL T))
            ((EQ TYPE2 'ATOM)
 
             (IL:* IL:|;;| "this case could be explicitly added to the type lattice.  But if someone adds a base type, then they would have to remember to add it as a sub type of atom, (which they wouldn't.)")

 
             (IF (EQ TYPE1 'CONS)                             (IL:* IL:\; 
-
                                         "this is the only base type that isn't a subtype of atom.")

+
                                           "this is the only base type that isn't a subtype of atom.")

                 (VALUES NIL T)
                 (VALUES T T)))
            ((NOT (OR (EQ SYMBOL-TYPE1 SYMBOL-TYPE2)
@@ -918,14 +924,13 @@
                        ((ARRAY SIMPLE-ARRAY) 
 
                           (IL:* IL:|;;| 
-
                        "the type will look like (simple-array element-type dimensions)")

+
                          "the type will look like (simple-array element-type dimensions)")

 
                           (XCL:DESTRUCTURING-BIND (ARRAY-TYPE1 ELEMENT-TYPE-1 DIMS-1)
                                  TYPE1
                                  (XCL:DESTRUCTURING-BIND (ARRAY-TYPE2 ELEMENT-TYPE-2 DIMS-2)
                                         TYPE2
-                                        (IF (AND (EQUAL-ELEMENT-TYPE
 ELEMENT-TYPE-1 
-                                                        ELEMENT-TYPE-2)
+                                        (IF (AND (EQUAL-ELEMENT-TYPE
 ELEMENT-TYPE-1 ELEMENT-TYPE-2)
                                                  (EQUAL-DIMENSIONS
 DIMS-1 DIMS-2))
                                             (VALUES T T)
                                             (VALUES NIL T)))))
@@ -940,7 +945,7 @@
                                                      (NUMBER 
 
                                                         (IL:* IL:|;;| 
-
                                          "number doesn't take ranges, there's nothing  to verify.")

+
                                            "number doesn't take ranges, there's nothing  to verify.")

 
                                                         (VALUES T T))
                                                      (OTHERWISE (XCL:DESTRUCTURING-BIND
@@ -949,8 +954,8 @@
                                                                  (XCL:DESTRUCTURING-BIND
                                                                   (NUMERIC-TYPE2 LOW2 HIGH2)
                                                                   TYPE2
-                                                                  (IF (RANGE<=
 LOW2 LOW1 HIGH1 
-                                                                             HIGH2 NUMERIC-TYPE1 
+                                                                  (IF (RANGE<=
 LOW2 LOW1 HIGH1 HIGH2
+                                                                             NUMERIC-TYPE1 
                                                                              NUMERIC-TYPE2)
                                                                       (VALUES T T)
                                                                       (VALUES NIL T)))))))
@@ -1220,7 +1225,7 @@
 (DEFTYPE VECTOR
 (&OPTIONAL ELEMENT-TYPE SIZE)
 
    (IL:* IL:|;;| 
-
 "this type must be defined in terms of array so that subtypep can reason(?) about them.")

+
   "this type must be defined in terms of array so that subtypep can reason(?) about them.")

 
    `(ARRAY ,ELEMENT-TYPE (,SIZE)))
 
@@ -1351,7 +1356,7 @@
                              (SYMBOL-PACKAGE NAME))))
 
          (IL:* IL:|;;| 
-
       "the eval-when insures  that the functions in the hash table are always  compiled")

+
         "the eval-when insures  that the functions in the hash table are always  compiled")

 
          `(PROGN (EVAL-WHEN (LOAD)
                         (SETF (SYMBOL-FUNCTION ',TYPEP-NAME)
@@ -1582,54 +1587,67 @@
 (IL:* IL:|;;;| "for TYPE-OF Interlisp types that have different common Lisp names")

 
 
-(IL:PUTPROPS IL:CHARACTER CMLTYPE
 CHARACTER)
+(IL:PUTPROPS IL:CHARACTER
 CMLTYPE
 CHARACTER)
 
-(IL:PUTPROPS IL:FIXP CMLTYPE
 BIGNUM)
+(IL:PUTPROPS IL:FIXP
 CMLTYPE
 BIGNUM)
 
-(IL:PUTPROPS IL:FLOATP CMLTYPE
 SINGLE-FLOAT)
+(IL:PUTPROPS IL:FLOATP
 CMLTYPE
 SINGLE-FLOAT)
 
-(IL:PUTPROPS IL:GENERAL-ARRAY CMLTYPE
 ARRAY)
+(IL:PUTPROPS IL:GENERAL-ARRAY
 CMLTYPE
 ARRAY)
 
-(IL:PUTPROPS IL:LISTP CMLTYPE
 CONS)
+(IL:PUTPROPS IL:LISTP
 CMLTYPE
 CONS)
 
-(IL:PUTPROPS IL:LITATOM CMLTYPE
 SYMBOL)
+(IL:PUTPROPS IL:LITATOM
 CMLTYPE
 SYMBOL)
 
-(IL:PUTPROPS IL:ONED-ARRAY CMLTYPE
 ARRAY)
+(IL:PUTPROPS IL:ONED-ARRAY
 CMLTYPE
 ARRAY)
 
-(IL:PUTPROPS IL:SMALLP CMLTYPE
 FIXNUM)
+(IL:PUTPROPS IL:SMALLP
 CMLTYPE
 FIXNUM)
 
-(IL:PUTPROPS IL:HARRAYP CMLTYPE
 HASH-TABLE)
+(IL:PUTPROPS IL:HARRAYP
 CMLTYPE
 HASH-TABLE)
 
-(IL:PUTPROPS IL:TWOD-ARRAY CMLTYPE
 ARRAY)
+(IL:PUTPROPS IL:TWOD-ARRAY
 CMLTYPE
 ARRAY)
 
-(IL:PUTPROPS SYMBOL CMLSUBTYPE-DESCRIMINATOR
 SYMBOL-TYPE)
+(IL:PUTPROPS SYMBOL
 CMLSUBTYPE-DESCRIMINATOR
 SYMBOL-TYPE)
 
-(IL:PUTPROPS ARRAY CMLSUBTYPE-DESCRIMINATOR
 ARRAY-TYPE)
+(IL:PUTPROPS ARRAY
 CMLSUBTYPE-DESCRIMINATOR
 ARRAY-TYPE)
 
 
 
 (IL:* IL:|;;;| "tell the filepkg what to do with the type-expander property")

 
 
-(IL:PUTPROPS :TYPE-EXPANDER IL:PROPTYPE
 IGNORE)
+(IL:PUTPROPS :TYPE-EXPANDER
 IL:PROPTYPE
 IGNORE)
 
-(IL:PUTPROPS IL:TYPE-EXPANDER IL:PROPTYPE
 IGNORE)
+(IL:PUTPROPS IL:TYPE-EXPANDER
 IL:PROPTYPE
 IGNORE)
 
 
 
 (IL:* IL:|;;;| "Compiler options")

 
 
-(IL:PUTPROPS IL:CMLTYPES IL:FILETYPE
 COMPILE-FILE)
+(IL:PUTPROPS IL:CMLTYPES
 IL:FILETYPE
 COMPILE-FILE)
 
-(IL:PUTPROPS IL:CMLTYPES IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE "LISP"))
+(IL:PUTPROPS IL:CMLTYPES
 IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE "LISP"))
 (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY 
 (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY
 
 (IL:LOCALVARS . T)
 )
 )
-(IL:PUTPROPS IL:CMLTYPES IL:COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993))
+(IL:PUTPROPS IL:CMLTYPES IL:COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2024)
+)
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL)))
+  (IL:FILEMAP (NIL (4086 4144 (COMMONP 4086 . 4144)) (4257 6153 (TYPEP 4257 . 6153)) (6155 6504 (TYPE-OF
+ 6155 . 6504)) (6506 7652 (COERCE 6506 . 7652)) (7654 8477 (TYPECASE 7654 . 8477)) (8479 8916 (
+%VALID-TYPE-P 8479 . 8916)) (12020 12451 (TYPE-EXPAND 12020 . 12451)) (12453 13582 (TYPE-EXPANDER 
+12453 . 13582)) (13584 13696 (SETF-TYPE-EXPANDER 13584 . 13696)) (13918 15237 (ARRAY-TYPE 13918 . 
+15237)) (15239 15457 (SYMBOL-TYPE 15239 . 15457)) (15459 15490 (XCL:FALSE 15459 . 15490)) (15492 15520
+ (XCL:TRUE 15492 . 15520)) (15522 18961 (%RANGE-TYPE 15522 . 18961)) (18963 19020 (NUMBERP 18963 . 
+19020)) (19022 19077 (FLOATP 19022 . 19077)) (19555 21413 (%TYPEP-PRED 19555 . 21413)) (21415 21504 (
+BIGNUMP 21415 . 21504)) (23517 31063 (SUBTYPEP 23517 . 31063)) (31065 31379 (SUBTYPEP-TYPE-EXPAND 
+31065 . 31379)) (31381 31560 (SI::DATATYPE-P 31381 . 31560)) (31562 32330 (SI::SUB-DATATYPE-P 31562 . 
+32330)) (32332 33015 (EQUAL-DIMENSIONS 32332 . 33015)) (33017 33216 (COMPLETE-ARRAY-TYPE-DIMENSIONS 
+33017 . 33216)) (33218 34693 (COMPLETE-META-EXPRESSION-DEFAULTS 33218 . 34693)) (34695 36276 (RANGE<= 
+34695 . 36276)) (36278 42968 (BASE-SUBTYPEP 36278 . 42968)) (42970 43336 (EQUAL-ELEMENT-TYPE 42970 . 
+43336)) (43338 43672 (USEFUL-TYPE-EXPANSION-P 43338 . 43672)))))
 IL:STOP

sources/EDITINTERFACE

@@ -1,16 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "22-Jun-2022 13:32:08" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;45
 47672  
+
(FILECREATED "21-May-2024 22:10:45" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;2
 47745  
 
-      :CHANGES-TO (FNS FIXEDITDATE)
+      :EDIT-BY "mth"
 
-      :PREVIOUS-DATE "13-May-2022 08:16:23" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;44)
+      :CHANGES-TO (FNS EDITLOADFNS?)
+
+      :PREVIOUS-DATE "22-Jun-2022 13:32:08" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;1
+)
 
 
 (* ; "
-Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
+Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT EDITINTERFACECOMS)
@@ -374,12 +375,18 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
                                                   (CDR X])
 
 (EDITLOADFNS?

-  [LAMBDA (FN STR ASKFLG FILES)
                              (* lmm "20-Nov-86 21:23")

-                                                             (* ;; "Value is name of file from which function or functions can be loaded.  If STR is non-NIL, user is asked to approve, and STR used in the message.  EDITLOADFNS?  is also used by prettyprint")

+  [LAMBDA (FN STR ASKFLG FILES)
                              (* ; "Edited 21-May-2024 18:18 by mth")

+                                                             (* lmm "20-Nov-86 21:23")

+
+    (* ;; "Value is name of file from which function or functions can be loaded.  If STR is non-NIL, user is asked to approve, and STR used in the message.  EDITLOADFNS?  is also used by prettyprint")

+
     (AND FN FILEPKGFLG (PROG ((LST (WHEREIS FN 'FNS FILES))
                               FILE DATES FD)
                              (OR (COND
-                                    ((EQ FILES T)            (* ;; "if FILES = T, means consult data base.  if user has removed a function from one of those files, as evidenced by the fact that editloafns?  was called with files=T, then dont offer that file.")

+                                    ((EQ FILES T)
+
+                                 (* ;; "if FILES = T, means consult data base.  if user has removed a function from one of those files, as evidenced by the fact that editloafns?  was called with files=T, then dont offer that file.")

+
                                      (SETQ LST (LDIFFERENCE LST FILELST)))
                                     (T LST))
                                  (RETURN))
@@ -394,8 +401,10 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
                                                 (RETURN)))
                                            (T (CAR LST]
                              [SETQ DATES (LISTP (GETPROP FILE 'FILEDATES]
-                                                             (* ;; 
-
                            "only look at file in FILEDATES if the file has been LOADed or LOADFROMd")

+
+                        (* ;; 
+
                        "only look at file in FILEDATES if the file has been LOADed or LOADFROMd")

+
                              (SETQ FILE (OR (AND DATES (FMEMB (CDAR (GETPROP FILE 'FILE))
                                                               '(LOADFNS T))
                                                  (INFILEP (CDAR DATES)))
@@ -412,15 +421,16 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
 
                                     "found a goood version of file on a different name.  smash name")

                                      (/RPLACD (CAR DATES)
                                             FILE))
-                                    (T (CL:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded." 
+                                    (T (CL:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded."
                                               FILE FD (CDAR DATES)
                                               (CAAR DATES]
                              (COND
                                 ((STREQUAL STR ""))
                                 ((NULL ASKFLG)
                                  (if
 STR
-                                     then
 (EXEC-FORMAT "~&~A~A" STR FILE)
-                                   else
 (EXEC-FORMAT "~&Loading definition of ~S from ~A." FN FILE)))
+                                     then
 (EXEC-FORMAT "~&~A~A~&" STR FILE)
+                                   else
 (EXEC-FORMAT "~&Loading definition of ~S from ~A.~&" FN FILE)
+                                     ))
                                 ((NEQ (ASKUSER DWIMWAIT 'Y (LIST FN STR FILE)
                                              NIL T)
                                       'Y)
@@ -942,13 +952,13 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
+(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2024))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4089 10388 (ED 4089 . 10388)) (10390 14366 (INSTALL-PROTOTYPE-DEFN 10390 . 14366)) (
-14367 31150 (EDITDEF.FNS 14377 . 15713) (EDITF 15715 . 16595) (EDITFB 16597 . 17445) (EDITFNS 17447 . 
-18767) (EDITLOADFNS? 18769 . 22569) (EDITMODE 22571 . 24581) (EDITP 24583 . 25094) (EDITV 25096 . 
-25735) (DC 25737 . 26418) (DF 26420 . 27462) (DP 27464 . 28548) (DV 28550 . 29122) (EDITPROP 29124 . 
-29343) (EF 29345 . 29674) (EP 29676 . 29859) (EV 29861 . 30040) (EDITE 30042 . 30920) (EDITL 30922 . 
-31148)) (31500 46817 (NEW/EDITDATE 31510 . 31732) (FIXEDITDATE 31734 . 40341) (EDITDATE? 40343 . 43371
-) (EDITDATE 43373 . 44820) (SETINITIALS 44822 . 46815)))))
+  (FILEMAP (NIL (4081 10380 (ED 4081 . 10380)) (10382 14358 (INSTALL-PROTOTYPE-DEFN 10382 . 14358)) (
+14359 31218 (EDITDEF.FNS 14369 . 15705) (EDITF 15707 . 16587) (EDITFB 16589 . 17437) (EDITFNS 17439 . 
+18759) (EDITLOADFNS? 18761 . 22637) (EDITMODE 22639 . 24649) (EDITP 24651 . 25162) (EDITV 25164 . 
+25803) (DC 25805 . 26486) (DF 26488 . 27530) (DP 27532 . 28616) (DV 28618 . 29190) (EDITPROP 29192 . 
+29411) (EF 29413 . 29742) (EP 29744 . 29927) (EV 29929 . 30108) (EDITE 30110 . 30988) (EDITL 30990 . 
+31216)) (31568 46885 (NEW/EDITDATE 31578 . 31800) (FIXEDITDATE 31802 . 40409) (EDITDATE? 40411 . 43439
+) (EDITDATE 43441 . 44888) (SETINITIALS 44890 . 46883)))))
 STOP

sources/NSFILING

@@ -1,19 +1,18 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "28-Jun-99 17:07:34" {DSK}<project>medley3.5>sources>NSFILING.;2
 294552 
 
-      changes to%:  (FNS \NSFILING.GENERATEFILES)
+
(FILECREATED "23-May-2024 23:20:49" {DSK}<home>frank>il>medley>sources>NSFILING.;2
 293309 
 
-      previous date%: "19-Jan-93 10:59:09" {DSK}<project>medley3.5>sources>NSFILING.;1)
+      :EDIT-BY "frank"
 
+      :CHANGES-TO (FNS \NSRANDOM.CREATE.STREAM \NSFILING.GETFILE)
+
+      :PREVIOUS-DATE "28-Jun-99 17:07:34" {DSK}<home>frank>il>medley>sources>NSFILING.;1)
 
-(* ; "
-Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT NSFILINGCOMS)
 
 (RPAQQ NSFILINGCOMS

-       [(COMS                                                (* ; "Filing Protocol")

+       [(COMS                                                (* ; "Filing Protocol")

               (COURIERPROGRAMS FILING FILING.4)
               (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * NSFILINGCONSTANTS)
                      (RECORDS NSFILINGSTREAM FILINGSESSION FILINGHANDLE NSFILESERVER 
@@ -54,24 +53,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                (*NSFILING-PAGE-CACHE-INCREMENT* 4)
                (*NSFILING-SESSION-TIMEOUT* '(900 . 21600))
                (\NSRANDOM.CHECK.CACHE))
-        (COMS                                                (* ; "Connection maintenance")

+        (COMS                                                (* ; "Connection maintenance")

               (FNS \GETFILINGCONNECTION \NSFILING.GET.NEW.SESSION \NSFILING.GET.STREAM 
                    \NSFILING.COURIER.OPEN \NSFILING.CLOSE.BULKSTREAM \NSFILING.RELEASE.BULKSTREAM 
                    FILING.CALL \NSFILING.LOGIN \NSFILING.AFTER.LOGIN \NSFILING.SET.CONTINUANCE 
                    \NSFILING.LOGOUT \NSFILING.DISCARD.SESSION \VALID.FILING.CONNECTIONP 
                    \NSFILING.CLOSE.CONNECTIONS BREAK.NSFILING.CONNECTION)
               (ADDVARS (\AFTERLOGINFNS \NSFILING.AFTER.LOGIN)))
-        (COMS                                                (* ; "Support")

+        (COMS                                                (* ; "Support")

               (FNS \NSFILING.CONNECT \NSFILING.MAYBE.CREATE \NSFILING.REMOVEQUOTES 
                    \NSFILING.ADDQUOTES \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE 
                    \LISP.TO.NSFILING.ATTRIBUTE))
-        (COMS                                                (* ; "FILINGHANDLE stuff")

+        (COMS                                                (* ; "FILINGHANDLE stuff")

               (FNS \NSFILING.GETFILE \NSFILING.LOOKUP.CACHE \NSFILING.ADD.TO.CACHE 
                    \NSFILING.OPEN.HANDLE \NSFILING.CONFLICTP \NSFILING.CHECK.ACCESS 
                    \NSFILING.FILLIN.ATTRIBUTES \NSFILING.COMPOSE.PATHNAME \NSFILING.PARSE.FILENAME 
                    \NSFILING.ERRORHANDLER \NSFILING.WHENCLOSED \NSFILING.CLOSE.HANDLE 
                    \NSFILING.FULLNAME))
-        (COMS                                                (* ; "NSFILING device")

+        (COMS                                                (* ; "NSFILING device")

               (FNS \NSFILING.OPENFILE \NSFILING.HANDLE.ERROR \NSFILING.CLOSEFILE \NSFILING.EVENTFN 
                    \NSFILING.DELETEFILE \NSFILING.CHILDLESS-P \NSFILING.DIRECTORYNAMEP 
                    \NSFILING.HOSTNAMEP \NSFILING.GETFILENAME \NSFILING.GETFILEINFO 
@@ -80,21 +79,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                    \NSFILING.GETEOFPTR \NSFILING.GENERATEFILES \NSFILING.GENERATE.STARS 
                    \NSFILING.NEXTFILE \NSFILING.FILEINFOFN \NSFILING.RENAMEFILE \NSFILING.COPYFILE 
                    \NSFILING.COPY/RENAME))
-        (COMS                                                (* ; "Random access methods")

+        (COMS                                                (* ; "Random access methods")

               (FNS \NSRANDOM.CLOSEFILE \NSRANDOM.RELEASE.HANDLE \NSRANDOM.RELEASE.LOCK 
                    \NSRANDOM.RELEASE.IF.ERROR \NSRANDOM.CREATE.STREAM \NSRANDOM.READPAGES 
                    \NSRANDOM.READ.SEGMENT \NSRANDOM.PREPARE.CACHE \NSRANDOM.FETCH.CACHE 
                    \NSRANDOM.CHECK.CACHE \NSRANDOM.WRITEPAGES \NSRANDOM.WRITE.SEGMENT 
                    \NSRANDOM.WROTE.HANDLE \NSRANDOM.SETEOFPTR \NSRANDOM.TRUNCATEFILE 
                    \NSRANDOM.UPDATE.VALIDATION \NSRANDOM.OPENFILE)
-                                                             (* ; "error handling")

+                                                             (* ; "error handling")

               (FNS \NSRANDOM.HANDLE.ERROR \NSRANDOM.PROCEEDABLE.ERROR \NSRANDOM.REESTABLISH 
                    \NSRANDOM.STREAM.CHANGED \NSRANDOM.DESTROY.STREAM \NSRANDOM.SESSION.WATCHER 
                    \NSRANDOM.ENSURE.WATCHER))
-        (COMS                                                (* ; "Cleaning up directories")

+        (COMS                                                (* ; "Cleaning up directories")

               (FNS GC-FILING-DIRECTORY \NSGC.COLLECT.DIRECTORIES))
-        (COMS                                                (* ; 
-
                                                           "Deserialize (special for NSMAIL)")

+        (COMS                                                (* ; "Deserialize (special for NSMAIL)")

               (FNS \NSFILING.DESERIALIZE \NSFILING.DESERIALIZE1))
         [COMS (FNS \NSFILING.INIT)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NSFILING.INIT]
@@ -418,106 +416,100 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
 
 (DECLARE%: EVAL@COMPILE
 
-(ACCESSFNS NSFILINGSTREAM
 (                              (* ; 
-
                                 "Overlays STREAM.  F1-2 and FW6-8 are used by the bulkdata device")

-                               (NSFILING.CONNECTION (fetch
 F3 of
 DATUM)
-                                      (replace
 F3 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                                           "Session on which this stream is open")

-                               (NSFILING.HANDLE (fetch
 F4 of
 DATUM)
-                                      (replace
 F4 of
 DATUM with
 NEWVALUE))
-                                                             (* ; "Filing HANDLE")

-                               (NSFILING.NEW.ATTRIBUTES (fetch
 F5 of
 DATUM)
-                                      (replace
 F5 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                   "For output sequential files, the attributes to install after we write the file")

-                               (NSFILING.PAGE.CACHE (fetch
 F1 of
 DATUM)
-                                      (replace
 F1 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                       "Cache of pages read from server but not yet read by client")

-                               (NSFILING.SERVER.LENGTH (fetch
 F2 of
 DATUM)
-                                      (replace
 F2 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                       "For random-access streams, actual length of file on server")

-                               (NSFILING.LAST.REQUEST (fetch
 FW6 of
 DATUM)
-                                      (replace
 FW6 of
 DATUM with
 NEWVALUE))
-                                                             (* ; 
-
                                                        "Last page requested to be read or written")

-                               ))
+(ACCESSFNS NSFILINGSTREAM
 (                                  (* ; 
+
                                   "Overlays STREAM.  F1-2 and FW6-8 are used by the bulkdata device")

+                           (NSFILING.CONNECTION (fetch
 F3 of
 DATUM)
+                                  (replace
 F3 of
 DATUM with
 NEWVALUE))
+                                                             (* ; 
+
                                                             "Session on which this stream is open")

+                           (NSFILING.HANDLE (fetch
 F4 of
 DATUM)
+                                  (replace
 F4 of
 DATUM with
 NEWVALUE))
+                                                             (* ; "Filing HANDLE")

+                           (NSFILING.NEW.ATTRIBUTES (fetch
 F5 of
 DATUM)
+                                  (replace
 F5 of
 DATUM with
 NEWVALUE))
+                                                             (* ; 
+
                     "For output sequential files, the attributes to install after we write the file")

+                           (NSFILING.PAGE.CACHE (fetch
 F1 of
 DATUM)
+                                  (replace
 F1 of
 DATUM with
 NEWVALUE))
+                                                             (* ; 
+
                                         "Cache of pages read from server but not yet read by client")

+                           (NSFILING.SERVER.LENGTH (fetch
 F2 of
 DATUM)
+                                  (replace
 F2 of
 DATUM with
 NEWVALUE))
+                                                             (* ; 
+
                                         "For random-access streams, actual length of file on server")

+                           (NSFILING.LAST.REQUEST (fetch
 FW6 of
 DATUM)
+                                  (replace
 FW6 of
 DATUM with
 NEWVALUE))
+                                                             (* ; 
+
                                                          "Last page requested to be read or written")

+                           ))
 
-(DATATYPE FILINGSESSION
 ((FSLOGINCHANGED FLAG)           (* ; 
-
                                                         "True if login info changes for this host")

-                             (FSREALACTIVITY FLAG)           (* ; 
-
                            "Set true when there have been non-CONTINUE calls made on this session")

-                             (NIL BITS 6)
-                             (FSPARSEDNAME POINTER)          (* ; "Canonical NSNAME of server")

-                             (FSNAMESTRING POINTER)          (* ; "same as a Lisp string")

-                             (FSADDRESS POINTER)             (* ; "NSADDRESS of server")

-                             (FSPROCESSNAME POINTER)         (* ; 
-
                                             "Courier stream open for this session, or NIL if none")

-                             (FSSESSIONHANDLE POINTER)       (* ; "Handle for this session")

-                             (FSSESSIONLOCK POINTER)
-                             (FSLASTREALACTIVITYTIMER POINTER)
-                                                             (* ; 
-
                                                           "Time of last interesting activity")

-                             (FSDEVICENAME POINTER)
-                             (FSCOURIERSTREAMS POINTER)      (* ; 
-
                                                           "Courier streams usable by session")

-                             (FSCACHEDHANDLES POINTER)       (* ; 
-
           "Zero or more instances of FILINGHANDLE describing handles we have open in this session")

-                             (FSLOGINNAME POINTER)           (* ; 
-
                                                       "Name under which this session is logged in")

-                             (FSPROTOCOLNAME POINTER)        (* ; "FILING or OLDFILING")

-                             (FSPROTOCOLDEF POINTER)         (* ; 
-
                                                           "Courier def for FILING.CALL to use")

-                             (FSSESSIONTIMER POINTER)        (* ; 
-
                                                 "Time we last did anything at all in this session")

-                             (FSCONTINUANCE WORD)            (* ; 
-
                             "How long in msecs we can be idle without having server close session")

-                             (FSVERSION WORD)                (* ; 
-
                                                    "Version of the protocol in use by this server")

-                                                             (* ; "Spares")

-                             (NIL POINTER)
-                             (NIL POINTER)
-                             (NIL POINTER)))
+(DATATYPE FILINGSESSION
 ((FSLOGINCHANGED FLAG)               (* ; 
+
                                                           "True if login info changes for this host")

+                         (FSREALACTIVITY FLAG)               (* ; 
+
                              "Set true when there have been non-CONTINUE calls made on this session")

+                         (NIL BITS 6)
+                         (FSPARSEDNAME POINTER)              (* ; "Canonical NSNAME of server")

+                         (FSNAMESTRING POINTER)              (* ; "same as a Lisp string")

+                         (FSADDRESS POINTER)                 (* ; "NSADDRESS of server")

+                         (FSPROCESSNAME POINTER)             (* ; 
+
                                               "Courier stream open for this session, or NIL if none")

+                         (FSSESSIONHANDLE POINTER)           (* ; "Handle for this session")

+                         (FSSESSIONLOCK POINTER)
+                         (FSLASTREALACTIVITYTIMER POINTER)   (* ; "Time of last interesting activity")

+                         (FSDEVICENAME POINTER)
+                         (FSCOURIERSTREAMS POINTER)          (* ; "Courier streams usable by session")

+                         (FSCACHEDHANDLES POINTER)           (* ; 
+
             "Zero or more instances of FILINGHANDLE describing handles we have open in this session")

+                         (FSLOGINNAME POINTER)               (* ; 
+
                                                         "Name under which this session is logged in")

+                         (FSPROTOCOLNAME POINTER)            (* ; "FILING or OLDFILING")

+                         (FSPROTOCOLDEF POINTER)             (* ; 
+
                                                             "Courier def for FILING.CALL to use")

+                         (FSSESSIONTIMER POINTER)            (* ; 
+
                                                   "Time we last did anything at all in this session")

+                         (FSCONTINUANCE WORD)                (* ; 
+
                               "How long in msecs we can be idle without having server close session")

+                         (FSVERSION WORD)                    (* ; 
+
                                                      "Version of the protocol in use by this server")

+                                                             (* ; "Spares")

+                         (NIL POINTER)
+                         (NIL POINTER)
+                         (NIL POINTER)))
 
-(DATATYPE FILINGHANDLE
 ((NSHDIRECTORYP FLAG)             (* ; "Handle is a directory")

-                            (NSHWASREAD FLAG)                (* ; 
-
"True if we have read file since we obtained the handle (in which case read date has been updated)")

-                            (NSHWASWRITTEN FLAG)
-                            (NSHWASMODIFIED FLAG)
-                            (NIL BITS 4)
-                            (NSHDATUM POINTER)               (* ; 
-
                                                      "The file handle datum used in Courier calls")

-                            (NSHFILEID POINTER)              (* ; "FILE.ID of file")

-                            (NSHNAME POINTER)                (* ; 
-
                                                           "Full name of the file referenced")

-                            (NSHPATHNAME POINTER)            (* ; "Canonical pathname of file")

-                            (NSHATTRIBUTES POINTER)          (* ; "Cached attributes")

-                            (NSHACCESS POINTER)              (* ; 
-
                                                           "Current access controls on handle")

-                            (NSHTIMER POINTER)               (* ; "Last reference to this handle")

-                            (NSHBUSYCOUNT WORD)              (* ; 
-
                                                           "Number of current users of handle")

-                            (NIL WORD)
-                            (NSHDIRECTORYPATH POINTER)       (* ; 
-
                                                      "For directories, the list of component dirs")

-                            (NIL POINTER))
-                           NSHTIMER _ (SETUPTIMER 0)
-                           NSHDIRECTORYPATH _ T)
+(DATATYPE FILINGHANDLE
 ((NSHDIRECTORYP FLAG)                 (* ; "Handle is a directory")

+                        (NSHWASREAD FLAG)                    (* ; 
+
  "True if we have read file since we obtained the handle (in which case read date has been updated)")

+                        (NSHWASWRITTEN FLAG)
+                        (NSHWASMODIFIED FLAG)
+                        (NIL BITS 4)
+                        (NSHDATUM POINTER)                   (* ; 
+
                                                        "The file handle datum used in Courier calls")

+                        (NSHFILEID POINTER)                  (* ; "FILE.ID of file")

+                        (NSHNAME POINTER)                    (* ; "Full name of the file referenced")

+                        (NSHPATHNAME POINTER)                (* ; "Canonical pathname of file")

+                        (NSHATTRIBUTES POINTER)              (* ; "Cached attributes")

+                        (NSHACCESS POINTER)                  (* ; "Current access controls on handle")

+                        (NSHTIMER POINTER)                   (* ; "Last reference to this handle")

+                        (NSHBUSYCOUNT WORD)                  (* ; "Number of current users of handle")

+                        (NIL WORD)
+                        (NSHDIRECTORYPATH POINTER)           (* ; 
+
                                                        "For directories, the list of component dirs")

+                        (NIL POINTER))
+                       NSHTIMER _ (SETUPTIMER 0)
+                       NSHDIRECTORYPATH _ T)
 
 (RECORD NSFILESERVER
 (NSFSPARSEDNAME . NSFSADDRESSES))
 
 (RECORD NSFILINGDEVICEINFO
 (NSFILESERVER NSWATCHERPROC NSFILINGLOCK NSFILINGNAME NSRANDOMDEVICE
                                                                                      . NSCONNECTIONS))
 
-(RECORD \NSFILING.GENFILESTATE
 (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES
-                                          NSBULKSTREAM))
+(RECORD \NSFILING.GENFILESTATE
 (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES 
+                                      NSBULKSTREAM))
 
 (RECORD NSFILINGPARSE
 (NSDIRECTORIES NSROOTNAME NSVERSION NSDIRECTORYP NSHASPERIOD))
 
 (RECORD NSPAGECACHE
 (NSPSIZE . NSPHEADER)
-                        (RECORD NSPHEADER (NSPTAIL . NSPBUFFERS)))
+                    (RECORD NSPHEADER (NSPTAIL . NSPBUFFERS)))
 )
 
 (/DECLAREDATATYPE 'FILINGSESSION
@@ -571,13 +563,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS WITHOUT.SESSION.MONITOR  MACRO

-   [(SESSION . FORMS)
-    (LET ((LOCK (fetch
 FSSESSIONLOCK of
 SESSION)))
-         (DECLARE
 (LOCALVARS LOCK))
-         (RELEASE.MONITORLOCK LOCK)
-         (PROG1 (PROGN . FORMS)
-                (OBTAIN.MONITORLOCK LOCK])
+(PUTPROPS WITHOUT.SESSION.MONITOR
 MACRO
 [(SESSION . FORMS)
+                                         (LET ((LOCK (fetch
 FSSESSIONLOCK of
 SESSION)))
+                                              (DECLARE
 (LOCALVARS LOCK))
+                                              (RELEASE.MONITORLOCK LOCK)
+                                              (PROG1 (PROGN . FORMS)
+                                                     (OBTAIN.MONITORLOCK LOCK])
 )
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -749,10 +740,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
 (RPAQQ \NSFILING.NULL.HANDLE
 (0 0))
 
 (RPAQQ \NSFILING.PROTECTION.BITS
 ((READ . 16)
-                                      (WRITE . 8)
-                                      (DELETE . 1)
-                                      (CREATE . 2)
-                                      (MODIFY . 4)))
+                                  (WRITE . 8)
+                                  (DELETE . 1)
+                                  (CREATE . 2)
+                                  (MODIFY . 4)))
 
 (RPAQQ \NSFILING.ATTRIBUTES

        ((CHECKSUM 0 CARDINAL)
@@ -801,11 +792,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
         (FILETYPE FILE.TYPE)))
 
 (RPAQ \NSFILING.USEFUL.ATTRIBUTE.TYPES
 (\FILING.ATTRIBUTE.TYPE.SEQUENCE '(CREATED.ON FILE.ID 
-                                                                                    IS.DIRECTORY 
-                                                                                    PATHNAME 
-                                                                                    SIZE.IN.BYTES 
-                                                                                    FILE.TYPE VERSION
-                                                                                    )))
+                                                                                IS.DIRECTORY PATHNAME
+                                                                                SIZE.IN.BYTES 
+                                                                                FILE.TYPE VERSION)))
 )
 
 (RPAQ? FILING.CACHE.LIMIT
 6)
@@ -1608,6 +1597,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
 
 (\NSFILING.GETFILE

   [LAMBDA (DEVICE FILENAME ACCESS RECOG OPTION PARAMETERS DIROK SEQUENTIAL OLDSTREAM)

+                                                           (* ; "Edited 23-May-2024 23:12 by frank")


                                                              (* ; "Edited 19-Aug-88 17:17 by bvm")

 
     (* ;; "Opens FILENAME for specified ACCESS and RECOG, returning a stream.  If OPTION is NAME, ATTRIBUTES, or HANDLE, just return the appropriate information instead of a stream.  If OPTION is DIRECTORY, return T or NIL if FILENAME is a directory or not -- PARAMETERS gives the CREATE? option in case the directory doesn't exist.  If ACCESS is not NONE, then PARAMETERS gives extra parameters for the open.")

@@ -1621,56 +1611,53 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                   (RETURN NIL)))
               [COND
                  ((EQ ACCESS 'SERIALIZE)                     (* ; 
-
                                             "Like INPUT, but retrieve a serialized stream on file")

+
                                               "Like INPUT, but retrieve a serialized stream on file")

                   (SETQ ACCESS 'INPUT)
                   (SETQ SERIALIZE 'SERIALIZE)
                   (SETQ SEQUENTIAL T))
                  ((AND (NOT SEQUENTIAL)
                        (NOT OPTION)
                        *NSFILING-RANDOM-ACCESS*)             (* ; 
-
                                             "RANDEVICE set if we want to open a randaccess stream")

-                  (SETQ RANDEVICE (fetch
 NSRANDOMDEVICE of
 (fetch
 DEVICEINFO of

-                                                                                         DEVICE]
+
                                               "RANDEVICE set if we want to open a randaccess stream")

+                  (SETQ RANDEVICE (fetch
 NSRANDOMDEVICE of
 (fetch
 DEVICEINFO of
 DEVICE]
           RETRY
               [COND
                  [(SETQ HANDLE (\NSFILING.LOOKUP.CACHE
 SESSION FILENAME))
                                                              (* ; "Cache hit")

                   (COND
                      (OPTION                                 (* ; 
-
              "Got handle, so just do what the option said (else fall thru and try to open a file)")

+
                "Got handle, so just do what the option said (else fall thru and try to open a file)")

                             (GO HANDLE.OPTION]
                  ((AND (LISTP FILENAME)
                        (EQ (CAR FILENAME)
                            'FILE.ID))                        (* ; "Identifying file by ID, take shortcut.  Do this second just in case we have cached this file already")

                   (SETQ FILE.ID (CADR FILENAME)))
                  (T                                          (* ; 
-
                                                       "Parse the name and go thru all this hassle")

+
                                                         "Parse the name and go thru all this hassle")

                     (SETQ PARSE (\NSFILING.PARSE.FILENAME
 FILENAME))
                     (SETQ DIRPATH (fetch
 NSDIRECTORIES of
 PARSE))
                     (COND
                        ((NULL DIRPATH)                       (* ; 
-
                                                     "No directories specified, so is illegal name")

+
                                                       "No directories specified, so is illegal name")

                         (GO FILE.NOT.FOUND))
                        [(EQ OPTION 'DIRECTORY)
                         (RETURN (AND (fetch
 NSDIRECTORYP of
 PARSE)
-                                     (SETQ HANDLE (\NSFILING.CONNECT
 SESSION DIRPATH T PARAMETERS
-                                                         ))
+                                     (SETQ HANDLE (\NSFILING.CONNECT
 SESSION DIRPATH T PARAMETERS))
                                      (GO HANDLE.OPTION]
                        ((AND (fetch
 NSDIRECTORYP of
 PARSE)
                              (NOT DIROK))                    (* ; 
-
                    "No name, just a directory.  Failure unless caller said a directory file is ok")

+
                      "No name, just a directory.  Failure unless caller said a directory file is ok")

                         (GO FILE.NOT.FOUND)))
                     (SETQ EXPLICIT-VERSION (fetch
 NSVERSION of
 PARSE))
                     (SETQ ROOTNAME (fetch
 NSROOTNAME of
 PARSE]
               [COND
                  (HANDLE                                     (* ; 
-
                                                       "We have an open file handle from the cache")

+
                                                         "We have an open file handle from the cache")

                         )
                  [FILE.ID                                    (* ; 
-
                                                           "Try to open an existing file by ID.")

+
                                                             "Try to open an existing file by ID.")

                         (COND
-                           ([SETQ HANDLE (\NSFILING.OPEN.HANDLE
 SESSION
-                                                `((FILE.ID ,FILE.ID))
+                           ([SETQ HANDLE (\NSFILING.OPEN.HANDLE
 SESSION `((FILE.ID ,FILE.ID))
                                                 (AND RANDEVICE (SELECTQ ACCESS
                                                                    ((BOTH APPEND) 
                                                                         'OUTPUT)
@@ -1680,16 +1667,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                  (T                                          (* ; "open by name")

                     (SETQ OLDHANDLE (\NSFILING.OPEN.HANDLE

                                      SESSION
-                                     [\NSFILING.COMPOSE.PATHNAME

-                                      DIRPATH ROOTNAME (OR EXPLICIT-VERSION
-                                                           (SELECTQ RECOG
-                                                               (OLDEST '-)
-                                                               '+]
+                                     [\NSFILING.COMPOSE.PATHNAME
 DIRPATH ROOTNAME
+                                            (OR EXPLICIT-VERSION (SELECTQ RECOG
+                                                                     (OLDEST '-)
+                                                                     '+]
                                      (AND RANDEVICE (SETQ HAVELOCK
                                                      (SELECTQ ACCESS
                                                          ((OUTPUT BOTH APPEND) 
                                                              (* ; 
-
"When opening for output, only get lock right now if we know we will be playing with the old file.")

+
  "When opening for output, only get lock right now if we know we will be playing with the old file.")

                                                               (AND (OR EXPLICIT-VERSION
                                                                        (NEQ RECOG 'NEW))
                                                                    'OUTPUT))
@@ -1703,18 +1689,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                                      'ACCESS.ERROR)
                                  (EQ (CADDR OLDHANDLE)
                                      'FileNotFound]          (* ; 
-
                                                       "No file of any version exists by this name")

+
                                                         "No file of any version exists by this name")

                         (SETQ HAVELOCK NIL)
                         (SELECTQ RECOG
                             ((OLD OLDEST)                    (* ; 
-
                                                 "No version exists, so certainly this one doesn't")

+
                                                   "No version exists, so certainly this one doesn't")

                                  (RETURN NIL))
                             (COND
                                ((EQ ACCESS 'INPUT)           (* ; 
-
                                                    "Version given explicitly, file does not exist")

+
                                                      "Version given explicitly, file does not exist")

                                 (RETURN NIL))
                                ((NULL EXPLICIT-VERSION)      (* ; 
-
                                                           "No extant version, so create number 1")

+
                                                             "No extant version, so create number 1")

                                 (OR RANDEVICE (SETQ VERSION 1)))
                                (T (SETQ VERSION EXPLICIT-VERSION]
                        ((LISTP OLDHANDLE)                    (* ; "Error case")

@@ -1723,11 +1709,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                         (GO HANDLE.ERROR))
                        ((AND (fetch
 NSHDIRECTORYP of
 OLDHANDLE)
                              (NOT DIROK))                    (* ; 
-
                                            "It's a directory, don't try to treat as ordinary file")

+
                                              "It's a directory, don't try to treat as ordinary file")

                         (GO FILE.NOT.FOUND))
                        [(OR EXPLICIT-VERSION (NEQ RECOG 'NEW))
                                                              (* ; 
-
                             "Old file exists, use it unless we explicitly requested a new version")

+
                               "Old file exists, use it unless we explicitly requested a new version")

                         (SETQ HANDLE OLDHANDLE)
                         (COND
                            (EXPLICIT-VERSION (SETQ VERSION EXPLICIT-VERSION]
@@ -1735,7 +1721,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                         (SETQ VERSION (ADD1 (OR [CADR (ASSOC 'VERSION (OR (fetch
 NSHATTRIBUTES
                                                                              of
 OLDHANDLE)
                                                                           (
-
                                                                        \NSFILING.FILLIN.ATTRIBUTES

+
                                                                          \NSFILING.FILLIN.ATTRIBUTES

                                                                            SESSION OLDHANDLE]
                                                 (GO FILE.NOT.FOUND]
 
@@ -1745,7 +1731,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                                     VERSION))
               (COND
                  (OPTION                                     (* ; 
-
                                                           "Not opening file, something simpler")

+
                                                             "Not opening file, something simpler")

                         (GO HANDLE.OPTION))
                  ((AND HANDLE (NOT OLDSTREAM)
                        (\NSFILING.CONFLICTP
 DEVICE SESSION HANDLE ACCESS))
@@ -1753,10 +1739,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
               (SELECTQ ACCESS
                   (INPUT (COND
                             ((NULL HANDLE)                   (* ; 
-
                                                "Odd to get here.  E.g., open for INPUT recog NEW.")

+
                                                  "Odd to get here.  E.g., open for INPUT recog NEW.")

                              (GO FILE.NOT.FOUND))
-                            (RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM
 SESSION HANDLE
-                                                               'INPUT HAVELOCK OLDSTREAM)))
+                            (RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM
 SESSION HANDLE 
+                                                               RANDEVICE 'INPUT HAVELOCK OLDSTREAM)))
                             [(NEQ (fetch
 NSHACCESS of
 HANDLE)
                                   'OUTPUT)                   (* ; "Just retrieve old file")

                              (SETQ FILESTREAM (FILING.CALL
 SESSION (OR SERIALIZE 'RETRIEVE)
@@ -1767,18 +1753,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                        (COND
                           ((AND (NEQ ACCESS 'OUTPUT)
                                 (NOT RANDEVICE))             (* ; 
-
                                                           "Sequential can only write whole files")

+
                                                             "Sequential can only write whole files")

                            (GO FILE.WONT.OPEN)))
                        (COND
                           [HANDLE                            (* ; 
-
                                                           "File already exists, need to overwrite")

+
                                                             "File already exists, need to overwrite")

                                  (COND
-                                    (RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM
 SESSION
-                                                                       HANDLE ACCESS HAVELOCK 
-                                                                       OLDSTREAM T)))
+                                    (RANDEVICE (SETQ FILESTREAM
+                                                (\NSRANDOM.CREATE.STREAM
 SESSION HANDLE RANDEVICE 
+                                                       ACCESS HAVELOCK OLDSTREAM T)))
                                     [(NULL (fetch
 NSHACCESS of
 HANDLE))
                                                              (* ; 
-
                                                           "Overwrite existing file sequentially")

+
                                                             "Overwrite existing file sequentially")

                                      [SETQ FILESTREAM (OR (\NSFILING.CHECK.ACCESS
 SESSION HANDLE
                                                                  'WRITE)
                                                           (FILING.CALL
 SESSION 'REPLACE
@@ -1788,15 +1774,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                                      (COND
                                         ((type?
 STREAM FILESTREAM)
                                                              (* ; 
-
                                                           "Cache of saved attributes is now wrong")

+
                                                             "Cache of saved attributes is now wrong")

                                          (replace
 NSHATTRIBUTES of
 HANDLE with
 NIL)
                                                              (* ; 
-
                                                   "Save attributes to change after file is stored")

-                                         (replace
 NSFILING.NEW.ATTRIBUTES of
 FILESTREAM
-                                            with
 PARAMETERS]
+
                                                     "Save attributes to change after file is stored")

+                                         (replace
 NSFILING.NEW.ATTRIBUTES of
 FILESTREAM with
 
+                                                                                           PARAMETERS
+                                                ]
                                     (T (GO FILE.BUSY]
                           (OLDSTREAM                         (* ; 
-
                                                           "Trying to reopen old stream, failed.")

+
                                                             "Trying to reopen old stream, failed.")

                                  (RETURN NIL))
                           [(SETQ OLDHANDLE (\NSFILING.CONNECT
 SESSION DIRPATH T T))
                                                              (* ; "Need to create the file, so first had to get a handle on the parent (CREATE and STORE procedures do not permit PATHNAME as one of the specifying attributes).")

@@ -1808,7 +1795,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                                        'CREATE
                                        (fetch
 NSHDATUM of
 OLDHANDLE)
                                        `([NAME ,(\NSFILING.REMOVEQUOTES
 (fetch
 NSROOTNAME
-                                                                               of
 PARSE]
+                                                                           of
 PARSE]
                                          ,@[AND VERSION `((VERSION ,VERSION]
                                          ,@PARAMETERS)
                                        '((LOCK EXCLUSIVE))
@@ -1824,43 +1811,41 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                                                                    NSHDATUM _ HANDLE
                                                                    NSHACCESS _ 'OUTPUT]
                                                              (* ; 
-
                       "Create failed or we can't read its attributes!  Fall thru to error handler")

+
                         "Create failed or we can't read its attributes!  Fall thru to error handler")

                                          (SETQ FILESTREAM HANDLE)
                                          (GO HANDLE.ERROR))
                                         ((type?
 STREAM (SETQ FILESTREAM
-                                                            (\NSRANDOM.CREATE.STREAM
 SESSION 
-                                                                   HANDLE ACCESS T)))
+                                                        (\NSRANDOM.CREATE.STREAM
 SESSION HANDLE 
+                                                               RANDEVICE ACCESS T)))
                                                              (* ; 
-
                                "Succeeded in opening stream, i.e., no further conflicts detected.")

+
                                  "Succeeded in opening stream, i.e., no further conflicts detected.")

                                          (SETQ FULLNAME (\NSFILING.FULLNAME
 SESSION HANDLE)))
                                         (T (GO HANDLE.ERROR]
                               (T                             (* ; "Start writing new file, guessing the version.  Ideally we shouldn't guess the version, but Lisp wants a full file name NOW (grumble).")

                                  (SETQ FILESTREAM
                                   (OR (\NSFILING.CHECK.ACCESS
 SESSION OLDHANDLE 'ADD)
-                                      (FILING.CALL
 SESSION 'STORE (fetch
 NSHDATUM
-                                                                         of
 OLDHANDLE)
-                                             `([NAME ,(\NSFILING.REMOVEQUOTES
 (fetch
 
-                                                                                         NSROOTNAME
-                                                                                     of
 PARSE]
+                                      (FILING.CALL
 SESSION 'STORE (fetch
 NSHDATUM of
 OLDHANDLE)
+                                             `([NAME ,(\NSFILING.REMOVEQUOTES
 (fetch
 NSROOTNAME
+                                                                                 of
 PARSE]
                                                (VERSION ,VERSION)
                                                ,@PARAMETERS)
                                              NIL NIL SESSION 'RETURNERRORS 'KEEPSTREAM]
                           (T (GO FILE.NOT.FOUND))))
                   (\ILLEGAL.ARG ACCESS))
               (COND
-                 ((NOT (type?
 STREAM FILESTREAM))        (* ; 
-
                                                           "Had handle, but failed to open it.")

+                 ((NOT (type?
 STREAM FILESTREAM))            (* ; 
+
                                                             "Had handle, but failed to open it.")

                   (GO HANDLE.ERROR)))
               (replace
 FULLFILENAME of
 FILESTREAM with
 (COND
-                                                                      (*UPPER-CASE-FILE-NAMES*
-                                                                       (MKATOM (U-CASE FULLNAME)))
-                                                                      (T FULLNAME)))
+                                                          (*UPPER-CASE-FILE-NAMES*
+                                                           (MKATOM (U-CASE FULLNAME)))
+                                                          (T FULLNAME)))
               (replace
 NSFILING.CONNECTION of
 FILESTREAM with
 SESSION)
               (replace
 NSFILING.HANDLE of
 FILESTREAM with
 HANDLE)
               (replace
 DEVICE of
 FILESTREAM with
 (OR RANDEVICE DEVICE))
               (COND
                  (HANDLE (add
 (fetch
 NSHBUSYCOUNT of
 HANDLE)
-                                1)))
+                              1)))
               (RETURN FILESTREAM)
           HANDLE.OPTION
               
@@ -1870,12 +1855,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
               (RETURN (SELECTQ OPTION
                           (NAME (if
 HANDLE
                                     then
 (\NSFILING.FULLNAME
 SESSION HANDLE NIL 
-                                                    *UPPER-CASE-FILE-NAMES*)
-                                  else
                   (* ; 
-
                                          "OUTFILEP case: no handle, but we have computed the name")

-                                        FULLNAME))
+                                                *UPPER-CASE-FILE-NAMES*)
+                                  else
                       (* ; 
+
                                            "OUTFILEP case: no handle, but we have computed the name")

+                                       FULLNAME))
                           (DIRECTORY                         (* ; 
-
          "I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.")

+
            "I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.")

                                      (AND HANDLE (fetch
 NSHDIRECTORYP of
 HANDLE)
                                           (\NSFILING.FULLNAME
 SESSION HANDLE NIL 
                                                  *UPPER-CASE-FILE-NAMES*)))
@@ -1898,7 +1883,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                   (SETQ HAVELOCK (SETQ HANDLE (SETQ VERSION NIL)))
                   (GO RETRY))
                  (T                                          (* ; 
-
                    "Can't get connection at all?  OH well, die as if it were true from the start.")

+
                      "Can't get connection at all?  OH well, die as if it were true from the start.")

                     (RETURN NIL)))
           FILE.NOT.FOUND
               (COND
@@ -3480,7 +3465,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
     (AND RESETSTATE (\NSRANDOM.RELEASE.LOCK
 SESSION HANDLE])
 
 (\NSRANDOM.CREATE.STREAM

-  [LAMBDA (SESSION HANDLE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS)

+  [LAMBDA (SESSION HANDLE DEVICE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS)

+                                                           (* ; "Edited 23-May-2024 23:07 by frank")


                                                              (* ; "Edited 19-Aug-88 17:24 by bvm")

     (PROG NIL
           [COND
@@ -3492,38 +3478,35 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                     ERROR)
                    [COND
                       ((SELECTQ OLDACCESS
-                           ((NIL)                            (* ; 
-
                                                           "Just a cached handle, no controls")

+                           ((NIL)                            (* ; "Just a cached handle, no controls")

                                 NIL)
                            (OUTPUT                           (* ; 
-
                                            "Handle already open for write, can't do anything else")

+
                                              "Handle already open for write, can't do anything else")

                                    T)
                            (INPUT                            (* ; 
-
                                             "Open for input, so only other input streams allowed.")

+
                                               "Open for input, so only other input streams allowed.")

                                   (NEQ ACCESS 'INPUT))
                            (SHOULDNT))
                        (RETURN (LISPERROR "FILE WON'T OPEN" (\NSFILING.FULLNAME
 SESSION HANDLE]
                    (COND
                       ((NEQ OLDACCESS 'INPUT)                (* ; 
-
     "Get a share/exclusive control.  If OLDACCESS is INPUT, we have already obtained this control")

+
       "Get a share/exclusive control.  If OLDACCESS is INPUT, we have already obtained this control")

                        (COND
-                          ((SETQ ERROR (FILING.CALL

-                                        SESSION
-                                        'CHANGE.CONTROLS
-                                        (fetch
 NSHDATUM of
 HANDLE)
-                                        `[(LOCK ,(SELECTQ ACCESS
-                                                     (INPUT 'SHARE)
-                                                     'EXCLUSIVE]
-                                        SESSION
-                                        'RETURNERRORS))
+                          ((SETQ ERROR (FILING.CALL
 SESSION 'CHANGE.CONTROLS (fetch
 NSHDATUM
+                                                                                of
 HANDLE)
+                                              `[(LOCK ,(SELECTQ ACCESS
+                                                           (INPUT 'SHARE)
+                                                           'EXCLUSIVE]
+                                              SESSION
+                                              'RETURNERRORS))
                            (RETURN ERROR)))
                        (RESETSAVE NIL (LIST (FUNCTION \NSRANDOM.RELEASE.IF.ERROR)
                                             SESSION HANDLE)) (* ; 
-
                                      "If this open doesn't succeed, be sure to release this lock.")

+
                                        "If this open doesn't succeed, be sure to release this lock.")

                        (replace
 NSHACCESS of
 HANDLE with
 (SELECTQ ACCESS
-                                                                         ((BOTH APPEND) 
-                                                                              'OUTPUT)
-                                                                         ACCESS]
+                                                             ((BOTH APPEND) 
+                                                                  'OUTPUT)
+                                                             ACCESS]
           [COND
              (CHECKACCESS 
 
@@ -3536,37 +3519,33 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
                  (LEN (CADR (ASSOC 'SIZE.IN.BYTES ATTRS)))
                  S EOF)
                 [COND
-                   (OLDSTREAM [LET [(OLDATTRS (fetch
 NSHATTRIBUTES of
 (fetch
 
-                                                                                     NSFILING.HANDLE
-                                                                                 of
 OLDSTREAM]
+                   (OLDSTREAM [LET [(OLDATTRS (fetch
 NSHATTRIBUTES of
 (fetch
 NSFILING.HANDLE
+                                                                         of
 OLDSTREAM]
                                    (COND
-                                      ([OR (NOT (EQUAL LEN (fetch
 NSFILING.SERVER.LENGTH
-                                                              of
 OLDSTREAM)))
+                                      ([OR (NOT (EQUAL LEN (fetch
 NSFILING.SERVER.LENGTH of
 OLDSTREAM
+                                                                  )))
                                            (NOT (EQUAL (CADR (ASSOC 'CREATED.ON ATTRS))
                                                        (CADR (ASSOC 'CREATED.ON OLDATTRS]
                                                              (* ; "file has changed!")

                                        (\NSRANDOM.STREAM.CHANGED
 OLDSTREAM HANDLE]
-                                                             (* ; 
-
                                                           "If got here, user let us continue")

+                                                             (* ; "If got here, user let us continue")

                           (replace
 NSFILING.HANDLE of
 (SETQ S OLDSTREAM) with
 HANDLE))
                    (T (SETQ EOF (SELECTQ ACCESS
                                     (OUTPUT 0)
                                     LEN))
                       (SETQ S (create
 STREAM
+                                     DEVICE _ DEVICE
                                      EPAGE _ (FOLDLO EOF BYTESPERPAGE)
                                      EOFFSET _ (IMOD EOF BYTESPERPAGE)
                                      MULTIBUFFERHINT _ T))
                       (if
 (EQ ACCESS 'APPEND)
-                          then
                           (* ; "File pos at end")

-                                (freplace
 (STREAM CPAGE) of
 S with
 (fetch

-                                                                                (STREAM EPAGE)
-                                                                                  of
 S))
-                                (freplace
 (STREAM COFFSET) of
 S with
 (fetch

-                                                                                  (STREAM EOFFSET)
-                                                                                    of
 S))
-                        else
                             (* ; "File pos at start")

-                              (freplace
 (STREAM CPAGE) of
 S with
 0)
-                              (freplace
 (STREAM COFFSET) of
 S with
 0]
+                          then
                               (* ; "File pos at end")

+                               (freplace
 (STREAM CPAGE) of
 S with
 (fetch
 (STREAM EPAGE) of
 S))
+                               (freplace
 (STREAM COFFSET) of
 S with
 (fetch
 (STREAM EOFFSET)
+                                                                       of
 S))
+                        else
                                 (* ; "File pos at start")

+                             (freplace
 (STREAM CPAGE) of
 S with
 0)
+                             (freplace
 (STREAM COFFSET) of
 S with
 0]
                 (replace
 NSFILING.SERVER.LENGTH of
 S with
 LEN)
                 (RETURN S])
 
@@ -4657,49 +4636,47 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
 
 (ADDTOVAR LAMA
 FILING.CALL)
 )
-(PUTPROPS NSFILING COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993 1999
-))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (34234 35080 (\FILINGSESSION.DEFPRINT 34244 . 34758) (\FILINGHANDLE.DEFPRINT 34760 . 
-35078)) (35081 38808 (\GET.FILING.ATTRIBUTE 35091 . 36404) (\PUT.FILING.ATTRIBUTE 36406 . 37604) (
-\GET.SESSION.HANDLE 37606 . 38025) (\PUT.SESSION.HANDLE 38027 . 38806)) (41840 77789 (
-\GETFILINGCONNECTION 41850 . 43745) (\NSFILING.GET.NEW.SESSION 43747 . 44232) (\NSFILING.GET.STREAM 
-44234 . 46010) (\NSFILING.COURIER.OPEN 46012 . 46277) (\NSFILING.CLOSE.BULKSTREAM 46279 . 46557) (
-\NSFILING.RELEASE.BULKSTREAM 46559 . 47488) (FILING.CALL 47490 . 56089) (\NSFILING.LOGIN 56091 . 69270
-) (\NSFILING.AFTER.LOGIN 69272 . 69803) (\NSFILING.SET.CONTINUANCE 69805 . 70478) (\NSFILING.LOGOUT 
-70480 . 70661) (\NSFILING.DISCARD.SESSION 70663 . 72360) (\VALID.FILING.CONNECTIONP 72362 . 73958) (
-\NSFILING.CLOSE.CONNECTIONS 73960 . 76822) (BREAK.NSFILING.CONNECTION 76824 . 77787)) (77867 91247 (
-\NSFILING.CONNECT 77877 . 80294) (\NSFILING.MAYBE.CREATE 80296 . 83335) (\NSFILING.REMOVEQUOTES 83337
- . 83962) (\NSFILING.ADDQUOTES 83964 . 86702) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 86704 . 86918) (
-\FILING.ATTRIBUTE.TYPE 86920 . 87423) (\LISP.TO.NSFILING.ATTRIBUTE 87425 . 91245)) (91283 144407 (
-\NSFILING.GETFILE 91293 . 112576) (\NSFILING.LOOKUP.CACHE 112578 . 114640) (\NSFILING.ADD.TO.CACHE 
-114642 . 117005) (\NSFILING.OPEN.HANDLE 117007 . 119110) (\NSFILING.CONFLICTP 119112 . 120606) (
-\NSFILING.CHECK.ACCESS 120608 . 121971) (\NSFILING.FILLIN.ATTRIBUTES 121973 . 123720) (
-\NSFILING.COMPOSE.PATHNAME 123722 . 124223) (\NSFILING.PARSE.FILENAME 124225 . 129762) (
-\NSFILING.ERRORHANDLER 129764 . 134582) (\NSFILING.WHENCLOSED 134584 . 135856) (\NSFILING.CLOSE.HANDLE
- 135858 . 136151) (\NSFILING.FULLNAME 136153 . 144405)) (144440 212555 (\NSFILING.OPENFILE 144450 . 
-149642) (\NSFILING.HANDLE.ERROR 149644 . 150522) (\NSFILING.CLOSEFILE 150524 . 153147) (
-\NSFILING.EVENTFN 153149 . 155907) (\NSFILING.DELETEFILE 155909 . 157577) (\NSFILING.CHILDLESS-P 
-157579 . 158282) (\NSFILING.DIRECTORYNAMEP 158284 . 158691) (\NSFILING.HOSTNAMEP 158693 . 161788) (
-\NSFILING.GETFILENAME 161790 . 162050) (\NSFILING.GETFILEINFO 162052 . 165460) (
-\NSFILING.GET.ATTRIBUTES 165462 . 165858) (\NSFILING.GETFILEINFO.FROM.PLIST 165860 . 168820) (
-\NSFILING.GDATE 168822 . 169012) (\NSFILING.SETFILEINFO 169014 . 172196) (\NSFILING.GET/SETINFO 172198
- . 173662) (\NSFILING.UPDATE.ATTRIBUTES 173664 . 174635) (\NSFILING.GETEOFPTR 174637 . 175171) (
-\NSFILING.GENERATEFILES 175173 . 191035) (\NSFILING.GENERATE.STARS 191037 . 191627) (
-\NSFILING.NEXTFILE 191629 . 193207) (\NSFILING.FILEINFOFN 193209 . 193436) (\NSFILING.RENAMEFILE 
-193438 . 194038) (\NSFILING.COPYFILE 194040 . 194638) (\NSFILING.COPY/RENAME 194640 . 212553)) (212594
- 263202 (\NSRANDOM.CLOSEFILE 212604 . 214400) (\NSRANDOM.RELEASE.HANDLE 214402 . 215595) (
-\NSRANDOM.RELEASE.LOCK 215597 . 215936) (\NSRANDOM.RELEASE.IF.ERROR 215938 . 216138) (
-\NSRANDOM.CREATE.STREAM 216140 . 222206) (\NSRANDOM.READPAGES 222208 . 226998) (\NSRANDOM.READ.SEGMENT
- 227000 . 237526) (\NSRANDOM.PREPARE.CACHE 237528 . 244860) (\NSRANDOM.FETCH.CACHE 244862 . 247035) (
-\NSRANDOM.CHECK.CACHE 247037 . 248082) (\NSRANDOM.WRITEPAGES 248084 . 253627) (\NSRANDOM.WRITE.SEGMENT
- 253629 . 255223) (\NSRANDOM.WROTE.HANDLE 255225 . 257031) (\NSRANDOM.SETEOFPTR 257033 . 258562) (
-\NSRANDOM.TRUNCATEFILE 258564 . 261478) (\NSRANDOM.UPDATE.VALIDATION 261480 . 262383) (
-\NSRANDOM.OPENFILE 262385 . 263200)) (263234 277742 (\NSRANDOM.HANDLE.ERROR 263244 . 265690) (
-\NSRANDOM.PROCEEDABLE.ERROR 265692 . 266948) (\NSRANDOM.REESTABLISH 266950 . 268422) (
-\NSRANDOM.STREAM.CHANGED 268424 . 269694) (\NSRANDOM.DESTROY.STREAM 269696 . 270466) (
-\NSRANDOM.SESSION.WATCHER 270468 . 276377) (\NSRANDOM.ENSURE.WATCHER 276379 . 277740)) (277783 288993 
-(GC-FILING-DIRECTORY 277793 . 285216) (\NSGC.COLLECT.DIRECTORIES 285218 . 288991)) (289043 293734 (
-\NSFILING.DESERIALIZE 289053 . 291155) (\NSFILING.DESERIALIZE1 291157 . 293732)) (293735 294222 (
-\NSFILING.INIT 293745 . 294220)))))
+  (FILEMAP (NIL (33827 34673 (\FILINGSESSION.DEFPRINT 33837 . 34351) (\FILINGHANDLE.DEFPRINT 34353 . 
+34671)) (34674 38401 (\GET.FILING.ATTRIBUTE 34684 . 35997) (\PUT.FILING.ATTRIBUTE 35999 . 37197) (
+\GET.SESSION.HANDLE 37199 . 37618) (\PUT.SESSION.HANDLE 37620 . 38399)) (41234 77183 (
+\GETFILINGCONNECTION 41244 . 43139) (\NSFILING.GET.NEW.SESSION 43141 . 43626) (\NSFILING.GET.STREAM 
+43628 . 45404) (\NSFILING.COURIER.OPEN 45406 . 45671) (\NSFILING.CLOSE.BULKSTREAM 45673 . 45951) (
+\NSFILING.RELEASE.BULKSTREAM 45953 . 46882) (FILING.CALL 46884 . 55483) (\NSFILING.LOGIN 55485 . 68664
+) (\NSFILING.AFTER.LOGIN 68666 . 69197) (\NSFILING.SET.CONTINUANCE 69199 . 69872) (\NSFILING.LOGOUT 
+69874 . 70055) (\NSFILING.DISCARD.SESSION 70057 . 71754) (\VALID.FILING.CONNECTIONP 71756 . 73352) (
+\NSFILING.CLOSE.CONNECTIONS 73354 . 76216) (BREAK.NSFILING.CONNECTION 76218 . 77181)) (77261 90641 (
+\NSFILING.CONNECT 77271 . 79688) (\NSFILING.MAYBE.CREATE 79690 . 82729) (\NSFILING.REMOVEQUOTES 82731
+ . 83356) (\NSFILING.ADDQUOTES 83358 . 86096) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 86098 . 86312) (
+\FILING.ATTRIBUTE.TYPE 86314 . 86817) (\LISP.TO.NSFILING.ATTRIBUTE 86819 . 90639)) (90677 143609 (
+\NSFILING.GETFILE 90687 . 111778) (\NSFILING.LOOKUP.CACHE 111780 . 113842) (\NSFILING.ADD.TO.CACHE 
+113844 . 116207) (\NSFILING.OPEN.HANDLE 116209 . 118312) (\NSFILING.CONFLICTP 118314 . 119808) (
+\NSFILING.CHECK.ACCESS 119810 . 121173) (\NSFILING.FILLIN.ATTRIBUTES 121175 . 122922) (
+\NSFILING.COMPOSE.PATHNAME 122924 . 123425) (\NSFILING.PARSE.FILENAME 123427 . 128964) (
+\NSFILING.ERRORHANDLER 128966 . 133784) (\NSFILING.WHENCLOSED 133786 . 135058) (\NSFILING.CLOSE.HANDLE
+ 135060 . 135353) (\NSFILING.FULLNAME 135355 . 143607)) (143642 211757 (\NSFILING.OPENFILE 143652 . 
+148844) (\NSFILING.HANDLE.ERROR 148846 . 149724) (\NSFILING.CLOSEFILE 149726 . 152349) (
+\NSFILING.EVENTFN 152351 . 155109) (\NSFILING.DELETEFILE 155111 . 156779) (\NSFILING.CHILDLESS-P 
+156781 . 157484) (\NSFILING.DIRECTORYNAMEP 157486 . 157893) (\NSFILING.HOSTNAMEP 157895 . 160990) (
+\NSFILING.GETFILENAME 160992 . 161252) (\NSFILING.GETFILEINFO 161254 . 164662) (
+\NSFILING.GET.ATTRIBUTES 164664 . 165060) (\NSFILING.GETFILEINFO.FROM.PLIST 165062 . 168022) (
+\NSFILING.GDATE 168024 . 168214) (\NSFILING.SETFILEINFO 168216 . 171398) (\NSFILING.GET/SETINFO 171400
+ . 172864) (\NSFILING.UPDATE.ATTRIBUTES 172866 . 173837) (\NSFILING.GETEOFPTR 173839 . 174373) (
+\NSFILING.GENERATEFILES 174375 . 190237) (\NSFILING.GENERATE.STARS 190239 . 190829) (
+\NSFILING.NEXTFILE 190831 . 192409) (\NSFILING.FILEINFOFN 192411 . 192638) (\NSFILING.RENAMEFILE 
+192640 . 193240) (\NSFILING.COPYFILE 193242 . 193840) (\NSFILING.COPY/RENAME 193842 . 211755)) (211796
+ 262065 (\NSRANDOM.CLOSEFILE 211806 . 213602) (\NSRANDOM.RELEASE.HANDLE 213604 . 214797) (
+\NSRANDOM.RELEASE.LOCK 214799 . 215138) (\NSRANDOM.RELEASE.IF.ERROR 215140 . 215340) (
+\NSRANDOM.CREATE.STREAM 215342 . 221069) (\NSRANDOM.READPAGES 221071 . 225861) (\NSRANDOM.READ.SEGMENT
+ 225863 . 236389) (\NSRANDOM.PREPARE.CACHE 236391 . 243723) (\NSRANDOM.FETCH.CACHE 243725 . 245898) (
+\NSRANDOM.CHECK.CACHE 245900 . 246945) (\NSRANDOM.WRITEPAGES 246947 . 252490) (\NSRANDOM.WRITE.SEGMENT
+ 252492 . 254086) (\NSRANDOM.WROTE.HANDLE 254088 . 255894) (\NSRANDOM.SETEOFPTR 255896 . 257425) (
+\NSRANDOM.TRUNCATEFILE 257427 . 260341) (\NSRANDOM.UPDATE.VALIDATION 260343 . 261246) (
+\NSRANDOM.OPENFILE 261248 . 262063)) (262097 276605 (\NSRANDOM.HANDLE.ERROR 262107 . 264553) (
+\NSRANDOM.PROCEEDABLE.ERROR 264555 . 265811) (\NSRANDOM.REESTABLISH 265813 . 267285) (
+\NSRANDOM.STREAM.CHANGED 267287 . 268557) (\NSRANDOM.DESTROY.STREAM 268559 . 269329) (
+\NSRANDOM.SESSION.WATCHER 269331 . 275240) (\NSRANDOM.ENSURE.WATCHER 275242 . 276603)) (276646 287856 
+(GC-FILING-DIRECTORY 276656 . 284079) (\NSGC.COLLECT.DIRECTORIES 284081 . 287854)) (287906 292597 (
+\NSFILING.DESERIALIZE 287916 . 290018) (\NSFILING.DESERIALIZE1 290020 . 292595)) (292598 293085 (
+\NSFILING.INIT 292608 . 293083)))))
 STOP

sources/XCL-LOOP

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LOOP" (USE "LISP" "XCL")) READTABLE "XCL" BASE 10)
 
-
(il:filecreated " 8-Apr-2024 19:38:27" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;13|
 61862  
+
(il:filecreated "14-Jun-2024 23:09:54" il:|{DSK}<home>matt>Interlisp>medley>sources>XCL-LOOP.;4|
 62255  
 
-      :edit-by "lmm"
+      :edit-by "mth"
 
-      :changes-to (il:vars il:xcl-loopcoms)
-                  (il:functions cl::symbol-macrolet with-list-accumulator)
+      :changes-to (il:functions default-type default-value)
 
-      :previous-date " 2-Apr-2024 15:08:27" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;12|)
+      :previous-date " 8-Apr-2024 19:38:27" il:|{DSK}<home>matt>Interlisp>medley>sources>XCL-LOOP.;2|
+)
 
 
 (il:prettycomprint il:xcl-loopcoms)
@@ -476,8 +476,12 @@
                (dig d-type-spec d-var-spec)
                bindings)))
 
-(defun default-type
 (type)
-   (if (eq type t)
+(defun default-type
 (type)
                            (il:* il:\; "Edited 13-Jun-2024 20:05 by mth")

+
+   (il:* il:|;;| "Probably shouldn't ever happen, but if TYPE is NIL")

+
+   (if (or (null type)
+           (eq type t))
        t
        (let ((value (default-value
 type)))
             (if (typep value type)
@@ -489,8 +493,13 @@
                              `(or null ,type)
                              `(or ,default-type ,type))))))))
 
-(defun default-value
 (type)
+(defun default-value
 (type)
                           (il:* il:\; "Edited 13-Jun-2024 20:31 by mth")

    (cond
+      ((null type)
+
+       (il:* il:|;;| "giving NIL specifically as the VAR type probably shouldn't happen, but seems to be \"legal\", so handle it")

+
+       nil)
       ((subtypep type 'bignum)
        (1+ most-positive-fixnum))
       ((subtypep type 'integer)
@@ -1389,7 +1398,7 @@
 
 (il:putprops il:xcl-loop
 il:copyright
 (("Interlisp.org" 2004)
                                        ("Yuji Minejima <ggb01164@nifty.ne.jp>")
-                                       2002 2004))
+                                       2002 2004 2024))
 
 (il:putprops il:xcl-loop
 il:license
 "See COPYRIGHT and LICENSE in the repository
 ;; $Id: loop.lisp,v 1.38 2005/04/16 07:34:27 yuji Exp $
@@ -1417,56 +1426,56 @@
 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.")
 (il:declare\: il:dontcopy
-  (il:filemap (nil (6825 6910 (%keyword 6825 . 6910)) (6912 7095 (%list 6912 . 7095)) (7097 8354 (
-accumulate-in-list 7097 . 8354)) (8356 10036 (accumulation-clause 8356 . 10036)) (10038 10272 (
-accumulator-kind 10038 . 10272)) (10274 12163 (accumulator-spec 10274 . 12163)) (12165 12634 (
-along-with 12165 . 12634)) (12636 13128 (always-never-thereis-clause 12636 . 13128)) (13130 13489 (
-ambiguous-loop-result-error 13130 . 13489)) (13491 13706 (append-context 13491 . 13706)) (13785 14162 
-(bindings 13785 . 14162)) (14164 14504 (bound-variables 14164 . 14504)) (14506 14596 (by-step-fun 
-14506 . 14596)) (14598 14704 (car-type 14598 . 14704)) (14706 14812 (cdr-type 14706 . 14812)) (14814 
-15211 (check-multiple-bindings 14814 . 15211)) (15213 15433 (cl-external-p 15213 . 15433)) (15435 
-15564 (clause* 15435 . 15564)) (15566 15966 (clause1 15566 . 15966)) (15968 16125 (compound-forms* 
-15968 . 16125)) (16127 16251 (compound-forms+ 16127 . 16251)) (16253 17511 (conditional-clause 16253
- . 17511)) (17513 18224 (constant-bindings 17513 . 18224)) (18226 18597 (constant-function-p 18226 . 
-18597)) (18599 18793 (constant-vector 18599 . 18793)) (18795 18886 (constant-vector-p 18795 . 18886)) 
-(18888 19080 (d-var-spec-p 18888 . 19080)) (19082 19312 (d-var-spec1 19082 . 19312)) (19314 19639 (
-d-var-type-spec 19314 . 19639)) (19641 20201 (declarations 19641 . 20201)) (20203 20313 (
-default-binding 20203 . 20313)) (20315 20928 (default-bindings 20315 . 20928)) (20930 21391 (
-default-type 20930 . 21391)) (21393 21914 (default-value 21393 . 21914)) (21916 23406 (
-destructuring-multiple-value-bind 21916 . 23406)) (23408 24693 (destructuring-multiple-value-setq 
-23408 . 24693)) (24695 25222 (dispatch-for-as-subclause 24695 . 25222)) (25224 25293 (do-clause 25224
- . 25293)) (25295 25471 (empty-p 25295 . 25471)) (25473 25747 (enumerate 25473 . 25747)) (25749 27475 
-(extended-loop 25749 . 27475)) (27477 27648 (fill-in 27477 . 27648)) (27650 27727 (finally-clause 
-27650 . 27727)) (27729 27847 (for 27729 . 27847)) (27849 29205 (for-as-across-subclause 27849 . 29205)
-) (29207 30129 (for-as-arithmetic-possible-prepositions 29207 . 30129)) (30131 30847 (
-for-as-arithmetic-step-and-test-functions 30131 . 30847)) (30849 32794 (for-as-arithmetic-subclause 
-30849 . 32794)) (32796 33246 (for-as-being-subclause 32796 . 33246)) (33248 34464 (for-as-clause 33248
- . 34464)) (34466 35994 (for-as-equals-then-subclause 34466 . 35994)) (35996 36274 (for-as-fill-in 
-35996 . 36274)) (36276 38242 (for-as-hash-subclause 36276 . 38242)) (38244 38490 (
-for-as-in-list-subclause 38244 . 38490)) (38492 39985 (for-as-on-list-subclause 38492 . 39985)) (39987
- 41689 (for-as-package-subclause 39987 . 41689)) (41691 41922 (for-as-parallel-p 41691 . 41922)) (
-41924 42072 (form-or-it 41924 . 42072)) (42074 42193 (form1 42074 . 42193)) (42195 42295 (
-gensym-ignorable 42195 . 42295)) (42297 42408 (globally-special-p 42297 . 42408)) (42410 42589 (
-hash-d-var-spec 42410 . 42589)) (42591 42672 (initially-clause 42591 . 42672)) (42674 42831 (
-invalid-accumulator-combination-error 42674 . 42831)) (42833 43450 (keyword1 42833 . 43450)) (43452 
-43922 (keyword? 43452 . 43922)) (43924 44033 (let-form 43924 . 44033)) (44035 44189 (loop-error 44035
- . 44189)) (44191 44382 (loop-finish-test-forms 44191 . 44382)) (44384 44536 (loop-warn 44384 . 44536)
-) (44538 44742 (lp 44538 . 44742)) (44744 45181 (main-clause* 44744 . 45181)) (45183 45279 (mapappend 
-45183 . 45279)) (45281 45811 (multiple-value-list-argument-form 45281 . 45811)) (45813 46206 (
-multiple-value-list-form-p 45813 . 46206)) (46208 46546 (name-clause? 46208 . 46546)) (46548 46827 (
-one 46548 . 46827)) (46829 48474 (ordinary-bindings 46829 . 48474)) (48476 48693 (preposition1 48476
- . 48693)) (48695 48896 (preposition? 48695 . 48896)) (48898 49058 (psetq-forms 48898 . 49058)) (49060
- 49240 (quoted-form-p 49060 . 49240)) (49242 49497 (quoted-object 49242 . 49497)) (49499 50303 (
-reduce-redundant-code 49499 . 50303)) (50305 50534 (repeat-clause 50305 . 50534)) (50536 50626 (
-return-clause 50536 . 50626)) (50628 51463 (selectable-clause 50628 . 51463)) (51465 51616 (
-simple-loop 51465 . 51616)) (51618 51696 (simple-var-p 51618 . 51696)) (51698 51882 (simple-var1 51698
- . 51882)) (51884 51991 (stray-of-type-error 51884 . 51991)) (51993 52278 (cl::symbol-macrolet 51993
- . 52278)) (52280 52714 (type-spec? 52280 . 52714)) (52716 52782 (until-clause 52716 . 52782)) (52784 
-53365 (using-other-var 52784 . 53365)) (53367 53561 (variable-clause* 53367 . 53561)) (53563 53667 (
-while-clause 53563 . 53667)) (53669 53848 (with 53669 . 53848)) (53850 54295 (with-accumulators 53850
- . 54295)) (54297 54547 (with-binding-forms 54297 . 54547)) (54549 55780 (with-clause 54549 . 55780)) 
-(55782 56041 (with-iterator-forms 55782 . 56041)) (56043 57190 (with-list-accumulator 56043 . 57190)) 
-(57192 57629 (with-loop-context 57192 . 57629)) (57631 58869 (with-numeric-accumulator 57631 . 58869))
- (58871 59392 (with-temporaries 58871 . 59392)) (59394 59674 (zero 59394 . 59674)) (59676 59809 (loop 
-59676 . 59809)))))
+  (il:filemap (nil (6777 6862 (%keyword 6777 . 6862)) (6864 7047 (%list 6864 . 7047)) (7049 8306 (
+accumulate-in-list 7049 . 8306)) (8308 9988 (accumulation-clause 8308 . 9988)) (9990 10224 (
+accumulator-kind 9990 . 10224)) (10226 12115 (accumulator-spec 10226 . 12115)) (12117 12586 (
+along-with 12117 . 12586)) (12588 13080 (always-never-thereis-clause 12588 . 13080)) (13082 13441 (
+ambiguous-loop-result-error 13082 . 13441)) (13443 13658 (append-context 13443 . 13658)) (13737 14114 
+(bindings 13737 . 14114)) (14116 14456 (bound-variables 14116 . 14456)) (14458 14548 (by-step-fun 
+14458 . 14548)) (14550 14656 (car-type 14550 . 14656)) (14658 14764 (cdr-type 14658 . 14764)) (14766 
+15163 (check-multiple-bindings 14766 . 15163)) (15165 15385 (cl-external-p 15165 . 15385)) (15387 
+15516 (clause* 15387 . 15516)) (15518 15918 (clause1 15518 . 15918)) (15920 16077 (compound-forms* 
+15920 . 16077)) (16079 16203 (compound-forms+ 16079 . 16203)) (16205 17463 (conditional-clause 16205
+ . 17463)) (17465 18176 (constant-bindings 17465 . 18176)) (18178 18549 (constant-function-p 18178 . 
+18549)) (18551 18745 (constant-vector 18551 . 18745)) (18747 18838 (constant-vector-p 18747 . 18838)) 
+(18840 19032 (d-var-spec-p 18840 . 19032)) (19034 19264 (d-var-spec1 19034 . 19264)) (19266 19591 (
+d-var-type-spec 19266 . 19591)) (19593 20153 (declarations 19593 . 20153)) (20155 20265 (
+default-binding 20155 . 20265)) (20267 20880 (default-bindings 20267 . 20880)) (20882 21530 (
+default-type 20882 . 21530)) (21532 22302 (default-value 21532 . 22302)) (22304 23794 (
+destructuring-multiple-value-bind 22304 . 23794)) (23796 25081 (destructuring-multiple-value-setq 
+23796 . 25081)) (25083 25610 (dispatch-for-as-subclause 25083 . 25610)) (25612 25681 (do-clause 25612
+ . 25681)) (25683 25859 (empty-p 25683 . 25859)) (25861 26135 (enumerate 25861 . 26135)) (26137 27863 
+(extended-loop 26137 . 27863)) (27865 28036 (fill-in 27865 . 28036)) (28038 28115 (finally-clause 
+28038 . 28115)) (28117 28235 (for 28117 . 28235)) (28237 29593 (for-as-across-subclause 28237 . 29593)
+) (29595 30517 (for-as-arithmetic-possible-prepositions 29595 . 30517)) (30519 31235 (
+for-as-arithmetic-step-and-test-functions 30519 . 31235)) (31237 33182 (for-as-arithmetic-subclause 
+31237 . 33182)) (33184 33634 (for-as-being-subclause 33184 . 33634)) (33636 34852 (for-as-clause 33636
+ . 34852)) (34854 36382 (for-as-equals-then-subclause 34854 . 36382)) (36384 36662 (for-as-fill-in 
+36384 . 36662)) (36664 38630 (for-as-hash-subclause 36664 . 38630)) (38632 38878 (
+for-as-in-list-subclause 38632 . 38878)) (38880 40373 (for-as-on-list-subclause 38880 . 40373)) (40375
+ 42077 (for-as-package-subclause 40375 . 42077)) (42079 42310 (for-as-parallel-p 42079 . 42310)) (
+42312 42460 (form-or-it 42312 . 42460)) (42462 42581 (form1 42462 . 42581)) (42583 42683 (
+gensym-ignorable 42583 . 42683)) (42685 42796 (globally-special-p 42685 . 42796)) (42798 42977 (
+hash-d-var-spec 42798 . 42977)) (42979 43060 (initially-clause 42979 . 43060)) (43062 43219 (
+invalid-accumulator-combination-error 43062 . 43219)) (43221 43838 (keyword1 43221 . 43838)) (43840 
+44310 (keyword? 43840 . 44310)) (44312 44421 (let-form 44312 . 44421)) (44423 44577 (loop-error 44423
+ . 44577)) (44579 44770 (loop-finish-test-forms 44579 . 44770)) (44772 44924 (loop-warn 44772 . 44924)
+) (44926 45130 (lp 44926 . 45130)) (45132 45569 (main-clause* 45132 . 45569)) (45571 45667 (mapappend 
+45571 . 45667)) (45669 46199 (multiple-value-list-argument-form 45669 . 46199)) (46201 46594 (
+multiple-value-list-form-p 46201 . 46594)) (46596 46934 (name-clause? 46596 . 46934)) (46936 47215 (
+one 46936 . 47215)) (47217 48862 (ordinary-bindings 47217 . 48862)) (48864 49081 (preposition1 48864
+ . 49081)) (49083 49284 (preposition? 49083 . 49284)) (49286 49446 (psetq-forms 49286 . 49446)) (49448
+ 49628 (quoted-form-p 49448 . 49628)) (49630 49885 (quoted-object 49630 . 49885)) (49887 50691 (
+reduce-redundant-code 49887 . 50691)) (50693 50922 (repeat-clause 50693 . 50922)) (50924 51014 (
+return-clause 50924 . 51014)) (51016 51851 (selectable-clause 51016 . 51851)) (51853 52004 (
+simple-loop 51853 . 52004)) (52006 52084 (simple-var-p 52006 . 52084)) (52086 52270 (simple-var1 52086
+ . 52270)) (52272 52379 (stray-of-type-error 52272 . 52379)) (52381 52666 (cl::symbol-macrolet 52381
+ . 52666)) (52668 53102 (type-spec? 52668 . 53102)) (53104 53170 (until-clause 53104 . 53170)) (53172 
+53753 (using-other-var 53172 . 53753)) (53755 53949 (variable-clause* 53755 . 53949)) (53951 54055 (
+while-clause 53951 . 54055)) (54057 54236 (with 54057 . 54236)) (54238 54683 (with-accumulators 54238
+ . 54683)) (54685 54935 (with-binding-forms 54685 . 54935)) (54937 56168 (with-clause 54937 . 56168)) 
+(56170 56429 (with-iterator-forms 56170 . 56429)) (56431 57578 (with-list-accumulator 56431 . 57578)) 
+(57580 58017 (with-loop-context 57580 . 58017)) (58019 59257 (with-numeric-accumulator 58019 . 59257))
+ (59259 59780 (with-temporaries 59259 . 59780)) (59782 60062 (zero 59782 . 60062)) (60064 60197 (loop 
+60064 . 60197)))))
 il:stop