Some polish on the new loadup scripts - dribble files and lock overrides (#2157)

Three changes to loadup scripts:

1) dribble files are now copied from the workdir into loadups if loadup completes successfully, 

2) if the lock preventing simultaneous runs is already set when loadup starts, it now asks the user if they want to override the lock or to exit (previously it just exited), 

3) there is now a --override flag that will automatically override the lock without asking the user.  

Man page updated accordingly.

.github/ISSUE_TEMPLATE/bug_report.md

@@ -3,6 +3,7 @@ name: Bug report (not specific)
 about: Create a report to help us improve
 title: ''
 labels: ''
+assignees: ''
 
 ---
 
@@ -22,11 +23,13 @@ A clear and concise description of what you expected to happen.
 If applicable, add screenshots to help explain your problem.
 
 **Context (please complete the following information):**
- - OS: [e.g. Mac/Linux/Cygwin]
- - OS Version: [e.g. High Siera/Ubuntu 18/Raspbian]
- - Host arch: [e.g. x86_64, arm7l, arm64, sparc]
+ - Are you using online.interlisp.org? [yes / no]
+ - OS: [e.g. macOS/Linux/Cygwin]
+ - OS Version: [e.g. Ventura, Ubuntu 24, Raspberry Pi OS]
+ - Display/window system: [e.g. X11, SDL, VNC, Web browser]
+ - Host arch: [e.g. x86_64, arm7l, arm64, SPARC]
  - Maiko version: [e.g. commit ID from `git log | head`]
- - IL:MAKESYSDATE: [ date ]
+ - `IL:MAKESYSDATE`: [ date ] or `(il:print-lisp-information)`: copy-paste or screenshot this
 
 **Additional context**
 Add any other context about the problem here.

.github/ISSUE_TEMPLATE/documentation.md

@@ -3,6 +3,7 @@ name: Documentation problem
 about: Problems with this web site?
 title: ''
 labels: ''
+assignees: ''
 
 ---
 

.github/ISSUE_TEMPLATE/feature_request.md

@@ -3,6 +3,7 @@ name: Feature request
 about: Suggest an idea for this project
 title: ''
 labels: ''
+assignees: ''
 
 ---
 

.github/workflows/buildDocker.yml

@@ -70,7 +70,7 @@ jobs:
   # based on the latest commit to the repo
 
   sentry:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     outputs:
       release_not_built: ${{ steps.check.outputs.release_not_built }}
 
@@ -99,7 +99,7 @@ jobs:
 
   build_and-push:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     needs: [sentry]
     if: |
@@ -154,7 +154,8 @@ jobs:
           if [ "${{ inputs.draft }}" = "false" ];
           then
               docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
-              platforms="linux/amd64,linux/arm64"
+              platforms="linux/amd64"
+              #,linux/arm64
           else
               docker_tags="${docker_image}:draft"
               platforms="linux/amd64"
@@ -171,7 +172,8 @@ jobs:
       - name: Set up QEMU
         uses: docker/setup-qemu-action@v3
         with:
-          platforms: linux/amd64,linux/arm64,linux/arm/v7
+          platforms: linux/amd64
+       # ,linux/arm64,linux/arm/v7
 
       # Setup the Docker Buildx funtion
       - name: Set up Docker Buildx
@@ -211,7 +213,7 @@ jobs:
 
   complete:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}

.github/workflows/buildLoadup.yml

@@ -66,7 +66,7 @@ jobs:
   # based on the latest commit to the repo
 
   sentry:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     outputs:
       release_not_built: ${{ steps.check.outputs.release_not_built }}
 
@@ -96,7 +96,7 @@ jobs:
 
   loadup:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     outputs:
       combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
@@ -257,7 +257,7 @@ jobs:
   #
   linux_installer:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     needs: [sentry, loadup]
     if: |
@@ -333,7 +333,7 @@ jobs:
   #
   macos_installer:
 
-    runs-on: macos-12
+    runs-on: macos-14
 
     needs: [sentry, loadup]
     if: |
@@ -507,7 +507,7 @@ jobs:
 
   downloads_page:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     needs: [sentry, loadup, linux_installer, macos_installer, cygwin_installer]
     if: |
@@ -606,7 +606,7 @@ jobs:
 
   complete:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}

.github/workflows/buildReleaseInclDocker.yml

@@ -69,7 +69,7 @@ jobs:
   # the result of a workflow_dispatch or a workflow_call
 
   inputs:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     outputs:
       draft: ${{ steps.one.outputs.draft }}
       force: ${{ steps.one.outputs.force }}
@@ -124,14 +124,14 @@ jobs:
 
   # Kickoff workflow in online repo to build and deploy Medley docker image to oio
   do_oio:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     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
+            gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref main
           fi
         env:
           GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}

.github/workflows/doHCFILES.yml

@@ -45,7 +45,7 @@ jobs:
 
   run_HCFILES:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     steps:
 

.gitignore

@@ -13,11 +13,9 @@ maiko/
 # normally when you have derived files, you ignore them from git
 # because they will get regenerated when you rebuild.
 # MEDLEY-UTILS HCFILES regenerates
-
-# do not ignore .pdf files after all... rather, [new workflow](scripts/make-gh-pages.md) stores it in the src repository gh-pages branch.
-
-# *.pdf
-# index.html
+# index.html files are also produced by HCFILES
+*.pdf
+index.html
 
 
 # all loadup files 
@@ -32,11 +30,16 @@ loadups/*.dribble
 loadups/whereis.hash
 loadups/apps.sysout
 loadups/fuller.database
+loadups/build/
 
 # manual cross-reference files
 
 *.IMPTR
 
+# (Accidentally) created sysouts at any level
+*.sysout
+*.SYSOUT
+
 #compiled code -- leave in for now
 
 # *.lcom

LICENSE

@@ -1,6 +1,6 @@
 MIT License
 
-Copyright Interlisp.org contributors
+Copyright © 2024 Interlisp.org. Portions originally copyrighted by Xerox, Venue, John Sybalsky, and other contributors.
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

docs/man-page/man_medley.html

@@ -1,164 +1,352 @@
 <h1>NAME</h1>
 <p><strong>medley</strong> — starts up Medley Interlisp</p>
 <h1>SYNOPSIS</h1>
-<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ -- <em>PASS_ON_ARGS</em> ]</p>
+<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ --
+<em>PASS_ON_ARGS</em> ]</p>
 <h1>DESCRIPTION</h1>
 <p>Starts Medley Interlisp in a window.</p>
 <h1>OPTIONS</h1>
-<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley and used by many of the options described below. MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of medley.</p>
+<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley
+and used by many of the options described below. MEDLEYDIR is the top
+level directory of the Medley installation that contains the specific
+medley script that is invoked after all symbolic links are resolved. In
+the standard global installation this will be
+/usr/local/interlisp/medley. But Medley can be installed in multiple
+places on any given machine and hence MEDLEYDIR is computed on each
+invocation of medley.</p>
 <h2>Flags</h2>
 <dl>
 <dt>-h, --help</dt>
-<dd><p>Prints out a brief summary of the flags and arguments to medley.</p>
+<dd>
+<p>Prints out a brief summary of the flags and arguments to medley.</p>
 </dd>
 <dt>-z, --man</dt>
-<dd><p>Show the man page for medley</p>
+<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.</p>
-<p>If the given value 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.</p>
-<p>(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.</p>
-<p>(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.</p>
-<p>(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).</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).</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>
+<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).</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.</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.</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>
+<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>
+<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).</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>
+<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. 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>
+<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>, an integer</p>
-<p>If value of “-” is given, the pixel scale factor is set to its default of 1.</p>
+<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>, 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 <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>
+<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 <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>
+<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.</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>
+<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.</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 <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>
+<dt>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - |
+--]</dt>
+<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.</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 <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>
+<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 <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>
+<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>-cm [<em>FILE</em> | -], --rem.cm [<em>FILE</em> | -]</dt>
+<dd>
+<p>Use <em>FILE</em> as the REM.CM file that Medley reads and executes
+at startup - after any greet files. Usually used only for loadups and
+other maintenance operations .</p>
+<p>If the given value is “-”, Medley will start up without using REM.CM
+file.</p>
+<p>There is no default Medley REM.CM file.</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 <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>
+<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>
+<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.</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>
+<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.</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>
+<dd>
+<p>No fork. Relevant only to the Medley loadup workflow.</p>
 </dd>
 <dt>-prog <em>EXE</em>, –maikoprog <em>EXE</em></dt>
-<dd><p>Use <em>EXE</em> as the basename of the Maiko executable. Relevant only to the Medley loadup workflow.</p>
+<dd>
+<p>Use <em>EXE</em> as the basename of the Maiko executable. Relevant
+only to the Medley loadup workflow.</p>
 </dd>
 <dt>–maikodir <em>DIR</em></dt>
-<dd><p>Use <em>DIR</em> as the directory containing the Maiko emulator. For testing purposes only.</p>
+<dd>
+<p>Use <em>DIR</em> as the directory containing the Maiko emulator. For
+testing purposes only.</p>
+</dd>
+<dt>-cc [<em>FILE</em> | -], --repeat [<em>FILE</em> | -]</dt>
+<dd>
+<p>Run Medley once. And then as long as <em>FILE</em> exists and is
+greater then zero length, repeatedly run Medley using <em>FILE</em> as
+the REM.CM file that Medley reads and executes at startup. Each run of
+Medley can change the contents of <em>FILE</em> to effect the subsequent
+run of Medley. To end the cycle, Medley needs to delete <em>FILE</em>.
+WIthin Medley, <em>FILE</em> can be found as the value of the
+environment variable LDEREPEATCM.</p>
+<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
+Medley file system, not the host Windows file system.</p>
 </dd>
 </dl>
 <h2>Other Options</h2>
 <dl>
 <dt><em>SYSOUT_FILE</em></dt>
-<dd><p>The pathname of the file to use as a sysout for Medley to start from. If SYSOUT_FILE is not provided and none of the flags (--apps, --full, --lisp) is used, then Medley will start from the saved virtual memory file from the previous session with the same ID_STRING as this run. If no such virtual memory file exists, then Medley will start from the standard full.sysout (equivalent to specifying the --full flag). On Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
+<dd>
+<p>The pathname of the file to use as a sysout for Medley to start from.
+If SYSOUT_FILE is not provided and none of the flags (--apps, --full,
+--lisp) is used, then Medley will start from the saved virtual memory
+file from the previous session with the same ID_STRING as this run. If
+no such virtual memory file exists, then Medley will start from the
+standard full.sysout (equivalent to specifying the --full flag). On
+Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the
+Medley file system, not the host Windows file system.</p>
 </dd>
 <dt><em>PASS_ON_ARGS</em></dt>
-<dd><p>All arguments after the “--” flag, are passed unaltered to the Maiko emulator.</p>
+<dd>
+<p>All arguments after the “--” flag, are passed unaltered to the Maiko
+emulator.</p>
 </dd>
 </dl>
 <h1>CONFIG FILE</h1>
-<p>A config file can be used to “pre-specify” any of the above command line arguments. The config file consists of command line arguments (flags or flag-value pairs), <em>one per line</em>. These arguments are read from the config file and prepended to the arguments actually given on the command line. Since later arguments override earlier arguments, any argument actually given on the command line will override a conflicting argument given in the config file.</p>
-<p>Unless specified using the -c (–config) argument, the default config file will be $MEDLEYDIR/.medley_config, if it exists, and $HOME/.medley_config, otherwise.</p>
-<p>Specifying, “-c -” or “–config -” on the command line will suppress the use of config files for the current run of Medley.</p>
-<p><em>Note:</em> care must be taken when using -g (–geometry) and/or -s (–screensize) arguments in config files. If only one of these is specified, then the other is conputed. But if both are specified, then the specified dimensions are used as given. Unexpected results can arise if one is specified in the config file but the other is specified on the command line. In this case, the two specified dimensions will be used as given. It will not be the case, as might be expected, that the dimension given in the config file will be overridden by a dimension computed from the dimension given on the command line.</p>
+<p>A config file can be used to “pre-specify” any of the above command
+line arguments. The config file consists of command line arguments
+(flags or flag-value pairs), <em>one per line</em>. These arguments are
+read from the config file and prepended to the arguments actually given
+on the command line. Since later arguments override earlier arguments,
+any argument actually given on the command line will override a
+conflicting argument given in the config file.</p>
+<p>Unless specified using the -c (–config) argument, the default config
+file will be $MEDLEYDIR/.medley_config, if it exists, and
+$HOME/.medley_config, otherwise.</p>
+<p>Specifying, “-c -” or “–config -” on the command line will suppress
+the use of config files for the current run of Medley.</p>
+<p><em>Note:</em> care must be taken when using -g (–geometry) and/or -s
+(–screensize) arguments in config files. If only one of these is
+specified, then the other is conputed. But if both are specified, then
+the specified dimensions are used as given. Unexpected results can arise
+if one is specified in the config file but the other is specified on the
+command line. In this case, the two specified dimensions will be used as
+given. It will not be the case, as might be expected, that the dimension
+given in the config file will be overridden by a dimension computed from
+the dimension given on the command line.</p>
 <h1>OTHER FILES</h1>
 <dl>
 <dt>$HOME/il</dt>
-<dd><p>Default Medley LOGINDIR</p>
+<dd>
+<p>Default Medley LOGINDIR</p>
 </dd>
 <dt>$HOME/il/vmem/lisp.virtualmem</dt>
-<dd><p>Default virtual memory file</p>
+<dd>
+<p>Default virtual memory file</p>
 </dd>
 <dt>$HOME/il/INIT(.LCOM)</dt>
-<dd><p>Default personal init file</p>
+<dd>
+<p>Default personal init file</p>
 </dd>
 <dt>$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)</dt>
-<dd><p>Default Medley greetfile</p>
+<dd>
+<p>Default Medley greetfile</p>
 </dd>
 </dl>
 <h1>BUGS</h1>
-<p>See GitHub Issues: &lt;https://github.com/Interlisp/medley/issues&gt;</p>
+<p>See GitHub Issues:
+&lt;https://github.com/Interlisp/medley/issues&gt;</p>
 <h1>COPYRIGHT</h1>
 <p>Copyright(c) 2023-2024 by Interlisp.org</p>

docs/man-page/medley.1

@@ -1,5 +1,19 @@
-.\" Automatically generated by Pandoc 2.9.2.1
+.\" Automatically generated by Pandoc 3.1.3
 .\"
+.\" Define V font for inline verbatim, using C font in formats
+.\" that render this, and otherwise B font.
+.ie "\f[CB]x\f[]"x" \{\
+. ftr V B
+. ftr VI BI
+. ftr VB B
+. ftr VBI BI
+.\}
+.el \{\
+. ftr V CR
+. ftr VI CI
+. ftr VB CB
+. ftr VBI CBI
+.\}
 .ad l
 .TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
 .nh
@@ -8,8 +22,8 @@
 \f[B]medley\f[R] \[em] starts up Medley Interlisp
 .SH SYNOPSIS
 .PP
-\f[B]medley\f[R] [ flags \&... ] [ \f[I]SYSOUT_FILE\f[R] ] [ --
-\f[I]PASS_ON_ARGS\f[R] ]
+\f[B]medley\f[R] [ flags \&...
+] [ \f[I]SYSOUT_FILE\f[R] ] [ -- \f[I]PASS_ON_ARGS\f[R] ]
 .SH DESCRIPTION
 .PP
 Starts Medley Interlisp in a window.
@@ -291,6 +305,21 @@ On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
 Medley file system, not the host Windows file system.
 .RE
 .TP
+-cm [\f[I]FILE\f[R] | -], --rem.cm [\f[I]FILE\f[R] | -]
+Use \f[I]FILE\f[R] as the REM.CM file that Medley reads and executes at
+startup - after any greet files.
+Usually used only for loadups and other maintenance operations .
+.RS
+.PP
+If the given value is \[lq]-\[rq], Medley will start up without using
+REM.CM file.
+.PP
+There is no default Medley REM.CM file.
+.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 \f[I]DIR\f[R] as LOGINDIR in Medley.
 \f[I]DIR\f[R] must be writeable by the current user.
@@ -341,6 +370,22 @@ Relevant only to the Medley loadup workflow.
 \[en]maikodir \f[I]DIR\f[R]
 Use \f[I]DIR\f[R] as the directory containing the Maiko emulator.
 For testing purposes only.
+.TP
+-cc [\f[I]FILE\f[R] | -], --repeat [\f[I]FILE\f[R] | -]
+Run Medley once.
+And then as long as \f[I]FILE\f[R] exists and is greater then zero
+length, repeatedly run Medley using \f[I]FILE\f[R] as the REM.CM file
+that Medley reads and executes at startup.
+Each run of Medley can change the contents of \f[I]FILE\f[R] to effect
+the subsequent run of Medley.
+To end the cycle, Medley needs to delete \f[I]FILE\f[R].
+WIthin Medley, \f[I]FILE\f[R] can be found as the value of the
+environment variable LDEREPEATCM.
+.RS
+.PP
+On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
+Medley file system, not the host Windows file system.
+.RE
 .SS Other Options
 .PP
 \ 

docs/man-page/medley.1.md

@@ -1,4 +1,4 @@
-% MEDLEY(1) | Start Medley Interlisp
+% MEDLEY(1) | Start Medley Interlisp
 
 ---
 adjusting: l
@@ -210,6 +210,16 @@ 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.
 
+-cm \[*FILE* | -], \-\-rem.cm \[*FILE* | -]
+: Use *FILE* as the REM.CM file that Medley reads and executes at startup - after any greet files.  Usually used only for loadups and other maintenance operations .
+
+    If the given value is "-",  Medley will start up without using REM.CM file.
+
+    There is no default Medley REM.CM file.
+    
+    On Windows/Cygwin installations, *FILE* is
+specified in the Medley file system, not the host Windows file system.
+
 -x \[*DIR* | - | --], \-\-logindir \[*DIR* | - | --]
 : Use *DIR* as LOGINDIR in Medley.  *DIR* must be writeable by the current user.
 
@@ -242,6 +252,12 @@ for the parameter will be reset to the default value - which in the case of *Hos
 --maikodir *DIR*
 : Use *DIR* as the directory containing the Maiko emulator.  For testing purposes only.
 
+-cc \[*FILE* | -], \-\-repeat \[*FILE* | -]
+: Run Medley once.  And then as long as *FILE* exists and is greater then zero length, repeatedly run Medley using *FILE* as the REM.CM file that Medley reads and executes at startup.  Each run of Medley can change the contents of *FILE* to effect the subsequent run of Medley.  To end the cycle, Medley needs to delete *FILE*.  WIthin Medley, *FILE* can be found as the value of the environment variable LDEREPEATCM.
+    
+    On Windows/Cygwin installations, *FILE* is
+specified in the Medley file system, not the host Windows file system.
+
 
 Other Options
 -------------

doctools/IMINDEX

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Apr-2024 09:25:49" {WMEDLEY}<doctools>IMINDEX.;6
 37064  
+
(FILECREATED "24-Mar-2025 10:31:37" {WMEDLEY}<doctools>IMINDEX.;10
 37350  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS IM.INDEX.PUTFN IM.INDEX.GETFN)
+      :CHANGES-TO (FNS IM.INDEX.EDIT)
 
-      :PREVIOUS-DATE " 4-Apr-2024 23:17:47" {WMEDLEY}<doctools>IMINDEX.;5)
+      :PREVIOUS-DATE "17-Mar-2025 12:07:55" {WMEDLEY}<doctools>IMINDEX.;9)
 
 
 (PRETTYCOMPRINT IMINDEXCOMS)
@@ -163,11 +163,13 @@
               (TERPRI PTRFILE])
 
 (IM.INDEX.EDIT

-  [LAMBDA (OBJ TEXTSTREAM)
                                   (* ; "Edited 18-Jul-88 14:10 by burns")

-
+  [LAMBDA (OBJ TEXTSTREAM)
                                   (* ; "Edited 24-Mar-2025 10:30 by rmk")


+                                                             (* ; "Edited 17-Mar-2025 12:06 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 00:14 by rmk")


+                                                             (* ; "Edited 18-Jul-88 14:10 by burns")

     (PROG* ((W (FREEMENU IM.INDEX.OBJ.FREEMENU.SPECS))
             (REGION (WINDOWREGION W))
-            [TEDIT.WINDOW (CAR (fetch
 \WINDOW of
 (TEXTOBJ TEXTSTREAM]
+            (TEDIT.WINDOW (TEDITWINDOWP TEXTSTREAM))
             (TEDIT.REGION (AND TEDIT.WINDOW (WINDOWREGION TEDIT.WINDOW)))
             OBJ.DATA OBJ.DATA.PROPLIST)
            (WINDOWPROP W 'IM.INDEX.OBJ OBJ)
@@ -640,13 +642,13 @@
 
 (IM.INDEX.INIT
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1692 15373 (IM.INDEX.CLOSEF 1702 . 2393) (IM.INDEX.COPYFN 2395 . 2580) (
-IM.INDEX.CREATEOBJ 2582 . 3928) (IM.INDEX.DISPLAY.STRING 3930 . 4351) (IM.INDEX.DISPLAYFN 4353 . 8450)
- (IM.INDEX.EDIT 8452 . 11920) (IM.INDEX.LIST.FROM.STRING 11922 . 12956) (IM.INDEX.SIZEFN 12958 . 13718
-) (IM.INDEX.STRING.FROM.LIST 13720 . 13965) (IM.INDEX.PUTFN 13967 . 14313) (IM.INDEX.GETFN 14315 . 
-14612) (IM.INDEX.BUTTONEVENTFN 14614 . 15371)) (15374 17444 (IM.INDEX.INIT 15384 . 17442)) (17445 
-29361 (IM.INDEX.MENU 17455 . 19143) (IM.INDEX.MENU.WHENSELECTEDFN 19145 . 25900) (
-IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25902 . 29359)) (31877 37020 (IM.CHAP.COPYFN 31887 . 32067) (
-IM.CHAP.CREATEOBJ 32069 . 33495) (IM.CHAP.DISPLAYFN 33497 . 35457) (IM.CHAP.SIZEFN 35459 . 36461) (
-IM.CHAP.PUTFN 36463 . 36647) (IM.CHAP.GETFN 36649 . 36810) (IM.CHAP.BUTTONEVENTFN 36812 . 37018)))))
+  (FILEMAP (NIL (1677 15659 (IM.INDEX.CLOSEF 1687 . 2378) (IM.INDEX.COPYFN 2380 . 2565) (
+IM.INDEX.CREATEOBJ 2567 . 3913) (IM.INDEX.DISPLAY.STRING 3915 . 4336) (IM.INDEX.DISPLAYFN 4338 . 8435)
+ (IM.INDEX.EDIT 8437 . 12206) (IM.INDEX.LIST.FROM.STRING 12208 . 13242) (IM.INDEX.SIZEFN 13244 . 14004
+) (IM.INDEX.STRING.FROM.LIST 14006 . 14251) (IM.INDEX.PUTFN 14253 . 14599) (IM.INDEX.GETFN 14601 . 
+14898) (IM.INDEX.BUTTONEVENTFN 14900 . 15657)) (15660 17730 (IM.INDEX.INIT 15670 . 17728)) (17731 
+29647 (IM.INDEX.MENU 17741 . 19429) (IM.INDEX.MENU.WHENSELECTEDFN 19431 . 26186) (
+IM.INDEX.OBJ.FREEMENU.SELECTEDFN 26188 . 29645)) (32163 37306 (IM.CHAP.COPYFN 32173 . 32353) (
+IM.CHAP.CREATEOBJ 32355 . 33781) (IM.CHAP.DISPLAYFN 33783 . 35743) (IM.CHAP.SIZEFN 35745 . 36747) (
+IM.CHAP.PUTFN 36749 . 36933) (IM.CHAP.GETFN 36935 . 37096) (IM.CHAP.BUTTONEVENTFN 37098 . 37304)))))
 STOP

installers/cygwin/.gitignore

@@ -4,3 +4,4 @@ maiko*.tgz
 setup-x86_64.exe
 medley.bat
 
+

installers/cygwin/medley.iss

@@ -9,7 +9,6 @@
 ;#
 ;###############################################################################
 
-#define x86_or_x64 "x64"
 #if GetEnv('COMBINED_RELEASE_TAG') != ""
 #define VERSION=GetEnv('COMBINED_RELEASE_TAG')
 #else
@@ -24,20 +23,17 @@
 
 [Setup]
 PrivilegesRequired=lowest
-ArchitecturesAllowed={#x86_or_x64}
+ArchitecturesAllowed=x64compatible
+ArchitecturesInstallIn64BitMode=x64compatible
 AppName=Medley
 AppVersion={#version}
 AppPublisher=Interlisp.org
 AppPublisherURL=https://interlisp.org/
-AppCopyright=Copyright (C) 2023 Interlisp.org
-DefaultDirName={%USERPROFILE}\il
+AppCopyright=Copyright (C) 2023-2024 Interlisp.org
+DefaultDirName="{%USERPROFILE}\il"
 DefaultGroupName=Medley
 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
 OutputDir="."
 OutputBaseFilename={#OUTFILE}
 SetupIconFile="Medley.ico"
@@ -48,7 +44,7 @@ WizardImageFile=medley_logo.bmp
 WizardSmallImageFile=medley_logo_small.bmp
 WizardImageStretch=no
 UninstallDisplayIcon="{app}\Medley.ico"
-UninstallFilesDir={app}\uninstall
+UninstallFilesDir="{app}\uninstall"
 UsePreviousAppDir=no
 
 [Dirs]
@@ -68,18 +64,21 @@ 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 https://mirrors.kernel.org/sourceware/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 ..."
-Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\maiko-cygwin.x86_64.tgz"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
+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 ..."
+Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\maiko-cygwin.x86_64.tgz"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
 ; Recreate medley symbolic links (lost in tars)
 Filename: "{app}\bin\bash"; Parameters: "-login -c 'cd /medley/scripts/medley && ln -s medley.command medley.sh && cd ../.. && ln -s /medley/scripts/medley/medley.sh medley'"; Flags: runhidden
 ; Create medley.bat
-Filename: "powershell"; Parameters: "write-output \""{app}\bin\bash -login -c '/medley/scripts/medley/medley.sh %*'\""  | out-file medley.bat -Encoding ascii"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
-Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden; StatusMsg: "Adding to PATH ..."
-Filename: "powershell"; Parameters: "remove-item -recurse -force {app}\install"; Flags: runhidden; StatusMsg: "Cleaning up ..."
+Filename: "powershell"; Parameters: "write-output '""""""""{app}\bin\bash"""""""" -login -c """"""""/medley/scripts/medley/medley.sh %*""""""""'  | out-file medley.bat -Encoding ascii -NoNewline"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
+Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add ""{app}"""; Flags: runhidden; StatusMsg: "Adding to PATH ..."
+Filename: "powershell"; Parameters: "remove-item -recurse -force """"""""{app}\install"""""""""; Flags: runhidden; StatusMsg: "Cleaning up ..."
+
+[UninstallDelete]
+Type: filesandordirs; Name: "{app}"
 
 [UninstallRun]
-Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden 
+Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove ""{app}"""; Flags: runhidden 
 

installers/cygwin/prep-for-local-testing.ps1

@@ -0,0 +1,9 @@
+#
+#  Prep the installer/cygwin directory to locally test the medley.iss installer
+#  Normally these downloads are done by the github workflow
+#
+#  fgh 2024-11-15
+#
+wget https://cygwin.com/setup-x86_64.exe -OutFile setup-x86_64.exe
+gh release download --repo interlisp/maiko --pattern *-cygwin.x86_64.tgz --output maiko-cygwin.x86_64.tgz --clobber
+gh release download --repo interlisp/medley --pattern medley-full-linux-x86_64-*.tgz --output medley.tgz --clobber

internal/MEDLEY-UTILS

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2024 12:51:12" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;16
 30093  
+
(FILECREATED "28-Mar-2025 08:53:43" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;2
 30243  
 
-      :CHANGES-TO (FNS MAKE-INDEX-HTMLS)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14)
+      :CHANGES-TO (FNS MAKE-FULLER-DB)
+
+      :PREVIOUS-DATE "14-Jul-2024 12:51:12" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;1)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -108,12 +110,14 @@
         (HELP])
 
 (MAKE-FULLER-DB

-  [LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE)
                  (* ; "Edited  3-Aug-2023 18:12 by frank")


+  [LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE)
                    (* ; "Edited 28-Mar-2025 08:53 by lmm")


+                                                           (* ; "Edited  3-Aug-2023 18:12 by frank")


                                                            (* ; "Edited 16-Jul-2022 22:07 by larry")


                                                            (* ; "Edited 20-Jun-2022 17:23 by larry")

     (FILESLOAD (SOURCE)
            FILESETS)
     (DRIBBLE (OR DRIBBLEFILE "fuller.dribble"))
+    (FILESLOAD LAFITE)
     (DOFILESLOAD (SUBSET (APPEND OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
                         'FINDFILE))
     (GATHER-INFO
 'ALL)
@@ -528,9 +532,9 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1086 12345 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS 
-7259 . 11714) (MEDLEY-FIX-LINKS 11716 . 12109) (MEDLEY-FIX-DATES 12111 . 12343)) (13524 16312 (
-MAKE-EXPORTS-ALL 13534 . 14593) (MAKE-WHEREIS-HASH 14595 . 15784) (MAKE-WHEREIS-LOOPS 15786 . 16310)) 
-(16313 25045 (HCFILES 16323 . 20586) (MAKE-INDEX-HTMLS 20588 . 25043)) (25295 29907 (RECOMPILE-ONE 
-25305 . 27202) (RECMPL 27204 . 27807) (COMPILE-SETUP 27809 . 28433) (REMAKEFILES 28435 . 29905)))))
+  (FILEMAP (NIL (1104 12495 (GATHER-INFO 1114 . 6496) (MAKE-FULLER-DB 6498 . 7407) (MAKE-INDEX-HTMLS 
+7409 . 11864) (MEDLEY-FIX-LINKS 11866 . 12259) (MEDLEY-FIX-DATES 12261 . 12493)) (13674 16462 (
+MAKE-EXPORTS-ALL 13684 . 14743) (MAKE-WHEREIS-HASH 14745 . 15934) (MAKE-WHEREIS-LOOPS 15936 . 16460)) 
+(16463 25195 (HCFILES 16473 . 20736) (MAKE-INDEX-HTMLS 20738 . 25193)) (25445 30057 (RECOMPILE-ONE 
+25455 . 27352) (RECMPL 27354 . 27957) (COMPILE-SETUP 27959 . 28583) (REMAKEFILES 28585 . 30055)))))
 STOP

internal/loadups/LOADUP-APPS

@@ -1,43 +1,86 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Jan-2023 20:34:02" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;3
 2095   
+
(FILECREATED " 9-Mar-2025 20:03:27" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;10
 3274   
 
-      :CHANGES-TO (FNS Apps.RemoveBackgroundMenuItem)
+      :EDIT-BY "frank"
 
-      :PREVIOUS-DATE "17-Jan-2023 20:29:39" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;2
+      :CHANGES-TO (FNS LOADUP-APPS)
+
+      :PREVIOUS-DATE " 9-Mar-2025 19:42:36" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;8
 )
 
 
 (PRETTYCOMPRINT LOADUP-APPSCOMS)
 
 (RPAQQ LOADUP-APPSCOMS
 ((GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
-                        (FNS Apps.LOADUP Apps.RemoveBackgroundMenuItem)))
+                        (FNS LOADUP-APPS Apps.RemoveBackgroundMenuItem)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
 )
 (DEFINEQ
 
-(Apps.LOADUP

-  [LAMBDA NIL
                                                (* ; "Edited 12-Nov-2022 14:03 by FGH")

-    (PROGN 
-           (* ;; " Delete button(s) that are created when lispusers/BUTTONS is loaded")

+(LOADUP-APPS

+  [LAMBDA NIL
                                              (* ; "Edited  9-Mar-2025 20:02 by frank")


+                                                             (* ; "Edited  2-Jan-2025 20:38 by lmm")


+                                                           (* ; "Edited  2-Jan-2025 06:30 by larry")

 
-           (for
 B in
 *ALL-BUTTONS* do
 (DELETE-BUTTON B))
+    (* ;; "= = = = = = = = = = = = = = = = = =")

 
-           (* ;; " Remove the BUTTONS BackgroundMenu item")

+    (* ;; " Load ROOMS")

 
-           (Apps.RemoveBackgroundMenuItem
 "Button Control")
+    (* ;; "")

 
-           (* ;; " Remove the NoteCards Background Menu Item")

+    (DOFILESLOAD `((SYSLOAD SOURCE)
+                   (FROM
 ,(MEDLEYDIR "ROOMS"))
+                   ROOMS))
 
-           (Apps.RemoveBackgroundMenuItem
 'NoteCards)
+    (* ;; "======================")

 
-           (* ;; " Remove the CLOS Background Menu Item")

+    (* ;; " Load Notecards and %"fix up%"")

 
-           (Apps.RemoveBackgroundMenuItem
 'BrowseClass)
-           (RPLACA [CAR (LIST '(A B C]
-                  NIL])
+    (* ;; "")

+
+    (DOFILESLOAD `((SYSLOAD)
+                   (FROM
 ,(CONCAT (UNIX-GETENV "NOTECARDSDIR")
+                                 "/system"))
+                   NOTECARDS))
+    (Apps.RemoveBackgroundMenuItem
 'NoteCards)               (* ; "")

+    (PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS_COMMIT_ID))
+           SYSOUTCOMMITS)
+
+    (* ;; "======================")

+
+    (* ;; " Load CLOS and %"fix up%"")

+
+    (* ;; " Assumes that clos/DEFSYS.DFASL has already been loaded (so CLOS: package is defined)")

+
+    (* ;; "")

+
+    (LOADUP-CLOS)
+    (CLOS::LOAD-CLOS)                                        (* ; "")

+    (Apps.RemoveBackgroundMenuItem
 'BrowseClass)
+
+    (* ;; "= = = = = = = = = = =  = = == = = = ")

+
+    (* ;; " Load lispusers/BUTTONS and %"fix up%"")

+
+    (* ;; "")

+
+    (DOFILESLOAD '((SYSLOAD)
+                   BUTTONS))
+    (Apps.RemoveBackgroundMenuItem
 "Button Control")
+    (for
 B in
 *ALL-BUTTONS* do
 (DELETE-BUTTON B))
+
+    (* ;; "= = = = = = = = = = =  = = == = = = ")

+
+    (* ;; " Do misc")

+
+    (* ;; "")

+
+    (PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP_COMMIT_ID))
+           SYSOUTCOMMITS)
+    (PRINTOUT T "commits-- " SYSOUTCOMMITS T])
 
 (Apps.RemoveBackgroundMenuItem

   [LAMBDA (ItemStringOrAtom)
@@ -52,5 +95,5 @@
                                Apps.SBG])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (647 2072 (Apps.LOADUP 657 . 1400) (Apps.RemoveBackgroundMenuItem 1402 . 2070)))))
+  (FILEMAP (NIL (656 3251 (LOADUP-APPS 666 . 2579) (Apps.RemoveBackgroundMenuItem 2581 . 3249)))))
 STOP

internal/loadups/LOADUP-CLOS

@@ -0,0 +1,23 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED " 9-Mar-2025 19:04:34" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-CLOS.;1
 600    
+
+      :EDIT-BY "frank"
+
+      :CHANGES-TO (VARS LOADUP-CLOSCOMS))
+
+
+(PRETTYCOMPRINT LOADUP-CLOSCOMS)
+
+(RPAQQ LOADUP-CLOSCOMS
 ((FNS LOADUP-CLOS)))
+(DEFINEQ
+
+(LOADUP-CLOS

+  [LAMBDA NIL
                                              (* ; "Edited  9-Mar-2025 18:53 by frank")

+    (DOFILESLOAD `((SYSLOAD)
+                   (FROM
 ,(MEDLEYDIR "CLOS"))
+                   DEFSYS])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (333 577 (LOADUP-CLOS 343 . 575)))))
+STOP

internal/loadups/LOADUP-FULL

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Jul-2023 18:28:53" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;4
 4521   
+
(FILECREATED "23-Apr-2025 05:14:27" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;2
 4662   
 
-      :CHANGES-TO (FNS LOADUP-FULL)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "18-Jan-2023 16:23:36" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;3
+      :CHANGES-TO (FNS LOADFULLFONTS)
+
+      :PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;1
 )
 
 
@@ -15,7 +17,8 @@
 (DEFINEQ
 
 (LOADFULLFONTS

-  [LAMBDA NIL
                                              (* ; "Edited 13-Feb-2021 22:51 by larry")

+  [LAMBDA NIL
                                                (* ; "Edited 23-Apr-2025 05:13 by lmm")


+                                                           (* ; "Edited 13-Feb-2021 22:51 by larry")

 
     (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")

 
@@ -35,7 +38,7 @@
                      (PRINTOUT T T))
                (PRINTOUT T "  Loading postscript fonts" T)
                (for
 F in
 (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
-                                        ">c0>*.*")) do
 (PSCFONT.READFONT F))
+                                        ">c0>*.PSCFONT")) do
 (PSCFONT.READFONT F))
                (PRINTOUT T "FULL fonts loaded" T])
 
 (LOADUP-FULL

@@ -86,5 +89,5 @@
 
 (FIXMETA
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (467 4483 (LOADFULLFONTS 477 . 1918) (LOADUP-FULL 1920 . 4233) (FIXMETA 4235 . 4481)))))
+  (FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622)))))
 STOP

internal/loadups/man-page/loadup.1

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

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

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

internal/loadups/man-page/man2html.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+pandoc --from man --to html < loadup.1 > man_loadup.html

internal/loadups/man-page/man_loadup.html

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

internal/loadups/man-page/md2man.sh

@@ -0,0 +1,3 @@
+#!/bin/bash
+pandoc loadup.1.md -s -t man -o loadup.1
+gzip --stdout loadup.1 >loadup.1.gz

internal/loadups/man-page/publish.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+./md2man.sh
+./man2html.sh
+

internal/loadups/man-page/showmd.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+pandoc loadup.1.md -s -t man | /usr/bin/man -l -

library/IMAGEOBJ

@@ -1,137 +1,69 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Dec-95 13:21:56" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1
 35602  
+
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4
 34381  
 
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS GET.OBJ.FROM.USER)
 
-      changes to%:  (FNS BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN)
-
-
-
-      previous date%: " 6-Dec-95 15:18:32" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1)
-
-
-
-
-
-(* ; "
-
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation.  All rights reserved.
-
-")
-
+      :PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
 
 
 (PRETTYCOMPRINT IMAGEOBJCOMS)
 
-
-
 (RPAQQ IMAGEOBJCOMS

-
        ((COMS 
-
-              (* ;; "Bit-map image objects")

-
-
+              (* ;; "Bit-map image objects")

 
               (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
-
                    )
-
               
-
-              (* ;; "fns for the bitmap tedit object.")

-
-
+              (* ;; "fns for the bitmap tedit object.")

 
               (FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN BMOBJ.PUTFN 
-
                    BMOBJ.INIT BMOBJ.GETFN5 BMOBJ.CREATE.MENU)
-
               (INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700))
-
                      (*SMALLSCREENFACTOR* 0.5))
-
               (FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2 BMOBJ.GETFN3 BMOBJ.GETFN4)
-
-                                                             (* ; 
-
-
                                            "GETFNs for backward compatibility with older objects.")

-
+                                                             (* ; 
+
                                              "GETFNs for backward compatibility with older objects.")

               (RECORDS BITMAPOBJ)
-
               [INITVARS (DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1]
-
               
-
-              (* ;; "make ^O be a character that inserts an object read from the user.")

-
-
+              (* ;; "make ^O be a character that inserts an object read from the user.")

 
               (GLOBALVARS (BITMAP.OBJ.MENU))
-
               (ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
-
                                                          
-
                                                        "prompts for an area of the screen to insert."
-
                                                          )
-
                               ("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
-
                                      
-
                                   "prompts for an area of the screen to insert, scaled down by 50%%."
-
                                      )
-
                               ("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
-
                                      
-
                    "prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50."
-
                                      )
-
                               ("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
-
                                      "Inserts *INSERT-BITMAP* in a document"))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN2))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN3))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN4))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN5))
-
                      (IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)))
-
               (VARS (BackgroundCopyMenu))
-
               (FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED)
-
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT)))
-
               (FILES EDITBITMAP))))
 
 
 
-
-
-
-
 (* ;; "Bit-map image objects")

 
-
-
 (DEFINEQ
 
-
-
 (BITMAPTEDITOBJ

   [LAMBDA (BITMAP SCALEFACTOR ROTATION DESCENT)
          (* ; "Edited 13-Aug-93 17:17 by rmk:")

                                                              (* ; "Edited  6-Jan-89 16:34 by jds")

@@ -146,8 +78,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                            BMOBJDESCENT _ (OR DESCENT 0))
            BITMAPIMAGEFNS])
 
-
-
 (COERCETOBITMAP

   [LAMBDA (BMSPEC)
                                      (* ; "Edited 11-Jun-90 16:28 by mitani")

                                                              (* tries to interpret X as a spec 
@@ -182,16 +112,12 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                              (fetch
 (REGION HEIGHT) of
 CR))
                       BM])
 
-
-
 (WINDOWTITLEFONT

   (LAMBDA (FONT)
                                             (* rrb " 1-Feb-84 15:26")

                                                              (* reset type of function that changes 
 
                                                             the title font)

     (DSPFONT FONT WindowTitleDisplayStream)))
 
-
-
 (\PRINTBINARYBITMAP

   (LAMBDA (BITMAP STREAM)
                                    (* rrb "23-Jul-84 15:16")

           
@@ -211,8 +137,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                         BMH BYTESPERWORD))
           (RETURN BITMAP))))
 
-
-
 (\READBINARYBITMAP

   (LAMBDA (STREAM)
                                           (* rrb "23-Jul-84 15:17")

           
@@ -229,23 +153,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                  (ITIMES (fetch
 (BITMAP BITMAPRASTERWIDTH) of
 BITMAP)
                         BMH BYTESPERWORD))
           (RETURN BITMAP))))
-
 )
 
 
 
-
-
-
-
 (* ;; "fns for the bitmap tedit object.")

 
-
-
 (DEFINEQ
 
-
-
 (BMOBJ.BUTTONEVENTINFN

   [LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)

                                                              (* ; "Edited 14-Aug-93 19:44 by rmk:")

@@ -315,8 +230,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
                             "And clear any cached shrunk bitmaps so the display looks reasonable.")

            (RETURN 'CHANGED])
 
-
-
 (BMOBJ.COPYFN

   [LAMBDA (IMAGEOBJ)
                                     (* ; "Edited 13-Aug-93 17:13 by rmk:")

                                                              (* ; "Edited  6-Jan-89 16:19 by jds")

@@ -329,8 +242,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                 (FETCH
 (BITMAPOBJ BMOBJROTATION) OF
 BMOBJ)
                 (FETCH
 (BITMAPOBJ BMOBJDESCENT) OF
 BMOBJ])
 
-
-
 (BMOBJ.DISPLAYFN

 
   [LAMBDA (IMAGEOBJ IMAGE.STREAM)                            (* ; "Edited  7-Dec-95 13:20 by ")

@@ -449,8 +360,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
                             'REPLACE NIL NIL FACTOR])
 
-
-
 (BMOBJ.IMAGEBOXFN

 
   [LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN)     (* ; "Edited  7-Dec-95 13:20 by ")

@@ -537,8 +446,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
                  XKERN _ 0])
 
-
-
 (BMOBJ.PUTFN

   [LAMBDA (BMOBJ STREAM)
                                 (* ; "Edited 13-Aug-93 15:41 by rmk:")

                                                              (* ; "Edited 11-Jan-89 17:00 by jds")

@@ -558,8 +465,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                  STREAM FILERDTBL)
           (SPACES 1 STREAM])
 
-
-
 (BMOBJ.INIT

   [LAMBDA NIL
                                            (* ; "Edited 13-Aug-93 14:27 by rmk:")

                                                              (* ; "Edited 11-Jan-89 17:01 by jds")

@@ -581,8 +486,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                                 (FUNCTION NILL)
                                 (FUNCTION NILL])
 
-
-
 (BMOBJ.GETFN5

   [LAMBDA (INPUT.STREAM TEXTSTREAM)
                      (* ; "Edited 13-Aug-93 15:40 by rmk:")

                                                              (* jds "30-Oct-85 11:29")

@@ -592,8 +495,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
            (READ INPUT.STREAM FILERDTBL)
            (READ INPUT.STREAM FILERDTBL])
 
-
-
 (BMOBJ.CREATE.MENU

   [LAMBDA NIL
                                                (* ; "Edited 30-Jul-87 19:19 by jds")

           
@@ -628,21 +529,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
            MENUOFFSET _ (create
 POSITION
                                XCOORD _ -1
                                YCOORD _ 0])
-
 )
 
-
-
 (RPAQ? *SMALLSCREEN*
 (ILESSP SCREENWIDTH 700))
 
-
-
 (RPAQ? *SMALLSCREENFACTOR*
 0.5)
-
 (DEFINEQ
 
-
-
 (SCALED.BITMAP.GETFN

   (LAMBDA (INPUT.STREAM TEXTSTREAM)
                          (* jds "30-Oct-85 11:29")

           
@@ -654,8 +547,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
           (RETURN (BITMAPTEDITOBJ
 BITMAP (FQUOTIENT 1.0 FACTOR)
                          0)))))
 
-
-
 (BMOBJ.GETFN

   (LAMBDA (STREAM)
                                           (* rrb "17-Jul-84 11:46")

           
@@ -669,8 +560,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                  (RETURN (BITMAPTEDITOBJ
 BITMAP (CAR FIELDS)
                                 (CADR FIELDS)))))))
 
-
-
 (BMOBJ.GETFN2

   (LAMBDA (STREAM)
                                           (* rrb "17-Jul-84 11:29")

           
@@ -683,8 +572,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
           (RETURN (BITMAPTEDITOBJ
 (\READBINARYBITMAP
 STREAM)
                          SCALE ROT)))))
 
-
-
 (BMOBJ.GETFN3

   [LAMBDA (STREAM)
                                       (* ; "Edited 11-Jan-89 17:03 by jds")

 
@@ -702,8 +589,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
           (RETURN (BITMAPTEDITOBJ
 (\READBINARYBITMAP
 STREAM)
                          SCALE 0 DESC])
 
-
-
 (BMOBJ.GETFN4

   [LAMBDA (STREAM)
                                       (* ; "Edited  6-Jan-89 16:33 by jds")

 
@@ -731,162 +616,91 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
          (BITMAPTEDITOBJ
 (\READBINARYBITMAP
 STREAM)
                 SCALE ROT DESCENT])
-
 )
 
 
 
-
-
-
-
 (* ; "GETFNs for backward compatibility with older objects.")

 
-
-
 (DECLARE%: EVAL@COMPILE
 
-
-
 (RECORD BITMAPOBJ
 (
+                   (* ;; "Describes a bitmap imageobj")

 
-                       (* ;; "Describes a bitmap imageobj")

-
-
-
-                       BITMAP                                (* ; "The bitmap itself")

-
-                       BMOBJSCALEFACTOR                      (* ; 
-
-
                                                        "The factor to scale it by when displaying")

-
-                       BMOBJROTATION                         (* ; 
-
-
                                                           "A rotation to apply when displaying")

-
-                       BMOBJDESCENT                          (* ; 
-
-
                                            "How far below the base line to display it.  NIL => 0.")

-
-                       ))
-
+                   BITMAP                                    (* ; "The bitmap itself")

+                   BMOBJSCALEFACTOR                          (* ; 
+
                                                          "The factor to scale it by when displaying")

+                   BMOBJROTATION                             (* ; 
+
                                                             "A rotation to apply when displaying")

+                   BMOBJDESCENT                              (* ; 
+
                                              "How far below the base line to display it.  NIL => 0.")

+                   ))
 )
 
-
-
 (RPAQ? DEFAULT.BITMAP.SCALE
 '(0.75 (DISPLAY 1)))
 
 
 
-
-
-
-
 (* ;; "make ^O be a character that inserts an object read from the user.")

 
-
-
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-
-
 (GLOBALVARS (BITMAP.OBJ.MENU))
-
 )
 
-
-
 (ADDTOVAR BackgroundCopyMenuCommands

-
           (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
-
                 "prompts for an area of the screen to insert.")
-
           ("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
-
                  "prompts for an area of the screen to insert, scaled down by 50%%.")
-
           ("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
-
                  "prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50.")
-
           ("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
-
                  "Inserts *INSERT-BITMAP* in a document"))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN2))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN3))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN4))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN5))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (SCALED.BITMAP.GETFN))
 
-
-
 (RPAQQ BackgroundCopyMenu
 NIL)
-
 (DEFINEQ
 
-
-
 (GET.OBJ.FROM.USER

-  [LAMBDA (TEXTSTREAM TEXTOBJ)
                           (* ; "Edited 26-Apr-91 10:54 by jds")

+  [LAMBDA (TEXTSTREAM TEXTOBJ)
                               (* ; "Edited  7-Dec-2024 19:44 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 21:04 by rmk")


+                                                             (* ; "Edited 26-Apr-91 10:54 by jds")

 
-    (* ;; "reads an expression from the user and puts the result into the textstream.")

+    (* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")

 
-    (ERSETQ (PROG ((VAL (PROMPTFOREVALED
 "Form to eval:"))
-                   (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-                   BM)
-                  (CL:TYPECASE VAL
-                      (STRINGP                               (* ; 
-
                                                          "Atoms and strings get inserted as text.")

-                         (AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL)))
-                      (LITATOM                               (* ; 
-
                                                          "Atoms and strings get inserted as text.")

-                         (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
-                                         SEL)))
-                      (IMAGEOBJ                              (* ; "IMAGEOBJs get inserted as is")

-                         (TEDIT.INSERT.OBJECT VAL TEXTSTREAM (SELECTQ (fetch
 POINT of
 SEL)
-                                                                 (LEFT (fetch
 (SELECTION CH#)
-                                                                          of
 SEL))
-                                                                 (RIGHT (fetch
 (SELECTION CHLIM)
-                                                                           of
 SEL))
-                                                                 NIL)))
-                      (T (COND
-                            ((SETQ BM (COERCETOBITMAP
 VAL))
+    (ERSETQ (LET ((VAL (PROMPTFOREVALED
 "Form to eval:"))
+                  BM)
+                 (CL:WHEN VAL
+                     (CL:TYPECASE VAL
+                         (STRINGP                            (* ; 
+
                                                            "Atoms and strings get inserted as text.")

+                            (TEDIT.INSERT TEXTSTREAM VAL))
+                         (LITATOM                            (* ; 
+
                                                            "Atoms and strings get inserted as text.")

+                            (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))))
+                         (IMAGEOBJ                           (* ; "IMAGEOBJs get inserted as is")

+                            (TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
+                         (T [COND
+                               ((SETQ BM (COERCETOBITMAP
 VAL))
                                                              (* ; 
-
                    "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")

-                             (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ
 BM 1 0)
-                                    TEXTSTREAM
-                                    (SELECTQ (fetch
 POINT of
 SEL)
-                                        (LEFT (fetch
 (SELECTION CH#) of
 SEL))
-                                        (RIGHT (fetch
 (SELECTION CHLIM) of
 SEL))
-                                        NIL)))
-                            (T                               (* ; 
-
                                      "Not a bitmap, nor one of the special cases above;  complain")

-                               (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
-                                               SEL))         (* ; 
-
       "(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT 'Not implemented to have ' VAL ' in documents yet.') T)")

-                               ))))])
-
-
+
                      "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")

+                                (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ
 BM 1 0)
+                                       TEXTSTREAM))
+                               (T                            (* ; 
+
                                "Not a bitmap, nor one of the special cases above;  see what happens")

+                                  (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T])))])
 
 (BITMAPOBJ.SNAPW

   [LAMBDA (SCALE SAVE)
                                   (* ; "Edited 14-Aug-93 19:54 by rmk:")

@@ -911,8 +725,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                                    0]
           (RETURN])
 
-
-
 (PROMPTFOREVALED

   (LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT)
                (* jds "26-Sep-85 16:46")

           
@@ -950,42 +762,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                                                     '>)))))
           (CLOSEW WIN)
           (RETURN NEWVALUE))))
-
 )
-
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-
-
 (BMOBJ.INIT
)
-
 )
 
-
-
 (FILESLOAD EDITBITMAP)
-
-(PUTPROPS IMAGEOBJ COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993
-
- 1995))
-
 (DECLARE%: DONTCOPY
-
-  (FILEMAP (NIL (3164 7671 (BITMAPTEDITOBJ 3176 . 3819) (COERCETOBITMAP 3823 . 5867) (WINDOWTITLEFONT 
-
-5871 . 6218) (\PRINTBINARYBITMAP 6222 . 7013) (\READBINARYBITMAP 7017 . 7668)) (7728 23863 (
-
-BMOBJ.BUTTONEVENTINFN 7740 . 12286) (BMOBJ.COPYFN 12290 . 12916) (BMOBJ.DISPLAYFN 12920 . 16649) (
-
-BMOBJ.IMAGEBOXFN 16653 . 19068) (BMOBJ.PUTFN 19072 . 20004) (BMOBJ.INIT 20008 . 21047) (BMOBJ.GETFN5 
-
-21051 . 21641) (BMOBJ.CREATE.MENU 21645 . 23860)) (23958 27253 (SCALED.BITMAP.GETFN 23970 . 24396) (
-
-BMOBJ.GETFN 24400 . 24935) (BMOBJ.GETFN2 24939 . 25424) (BMOBJ.GETFN3 25428 . 26216) (BMOBJ.GETFN4 
-
-26220 . 27250)) (29245 35381 (GET.OBJ.FROM.USER 29257 . 32020) (BITMAPOBJ.SNAPW 32024 . 33150) (
-
-PROMPTFOREVALED 33154 . 35378)))))
-
+  (FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT 
+5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
+BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
+BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5 
+20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
+BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4 
+25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
+PROMPTFOREVALED 32055 . 34279)))))
 STOP
-

library/MASTERSCOPE

@@ -1,22 +1,19 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "13-Jun-2021 09:05:17" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6
 196680 
 
-      changes to%:  (FNS MSINTERPRETSET)
+
(FILECREATED " 5-Apr-2025 11:49:04" {WMEDLEY}<library>MASTERSCOPE.;29
 197994 
 
-      previous date%: " 9-Jun-2021 23:55:26" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS MSOUTPUT)
+
+      :PREVIOUS-DATE "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28)
 
-(* ; "
-Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT MASTERSCOPECOMS)
 
 (RPAQQ MASTERSCOPECOMS

        [
-        (* ;; "Main file for MASTERSCOPE.")

+        (* ;; "Main file for MASTERSCOPE.")

 
         (FILES MSPARSE MSANALYZE)
         (PROP FILETYPE MASTERSCOPE)
@@ -28,13 +25,13 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
         [COMS (FNS MSFIND MSEDITF MSEDITE EDITGETDEF)
               (VARS MSBLIP)
               
-              (* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze.  LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")

+              (* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze.  LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")

 
               [INITVARS (MSFNTYPES '((FNS FNS GETDEF]
-              (COMS                                          (* ; "SCRATCHASH")

+              (COMS                                          (* ; "SCRATCHASH")

                     (INITVARS (MSCRATCHASH))
                     (DECLARE%: DONTCOPY (MACROS SCRATCHASH]
-        (COMS                                                (* ; "marking changed")

+        (COMS                                                (* ; "marking changed")

               (FNS MSMARKCHANGED CHANGEMACRO CHANGEVAR CHANGEI.S. CHANGERECORD MSNEEDUNSAVE UNSAVEFNS
                    )
               (ADDVARS (COMPILE.TIME.CONSTANTS))
@@ -42,11 +39,11 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
               (INITVARS (CHECKUNSAVEFLG T)
                      (MSNEEDUNSAVE)))
         (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETWORDTYPE))
-        (COMS                                                (* ; "interactive routines")

+        (COMS                                                (* ; "interactive routines")

               [VARS * (LIST (LIST 'MASTERSCOPEDATE (DATE (DATEFORMAT NO.TIME]
               (ADDVARS (HISTORYCOMS %.))
               (FNS %. MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC)
-                                                             (* ; "Interpreting commands")

+                                                             (* ; "Interpreting commands")

               (FNS MSINTERPRETSET MSINTERPA MSGETBLOCKDEC LISTHARD MSMEMBSET MSLISTSET MSHASHLIST 
                    MSHASHLIST1 CHECKPATHS ONFILE)
               (FNS MSINTERPRET VERBNOTICELIST MSOUTPUT MSCHECKEMPTY CHECKFORCHANGED MSSOLVE)
@@ -186,9 +183,9 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
                                                  MSFILELST])
 
 (MSSHOWUSE

-  [LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)

-                                                  (* ; 
-
                                                "Edited 23-Jun-93 09:40 by sybalsky:mv:envos")

+  [LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
 (* ; "Edited  4-Jul-2024 15:06 by rmk")

+                                                             (* ; 
+
                                                        "Edited 23-Jun-93 09:40 by sybalsky:mv:envos")

 
     (* ;; "Show/Edit where SHOWFN uses/etc. a pattern.")

 
@@ -196,7 +193,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
           (COND
              ([OR [CL:MULTIPLE-VALUE-SETQ (DEF REALDEF)
                          (MSGETDEF
 SHOWFN (AND (fetch
 (MSSETPHRASE KNOWN) of
 SHOWSET)
-                                                   (fetch
 (MSSETPHRASE TYPE) of
 SHOWSET))
+                                               (fetch
 (MSSETPHRASE TYPE) of
 SHOWSET))
                                 (COND
                                    ((EQ SHOWEDIT 'SHOW)
                                     '?)
@@ -208,43 +205,45 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
                                          (FILE (LOADFNS SHOWFN FILE 'PROP)
                                                (GETPROP SHOWFN 'EXPR]
                                                              (* ; 
-
                                          "was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")

+
                                            "was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")

                                                              (* ; 
-
                                                           "The SHOW command does not need to save")

-              (MSUPDATEFN1
 SHOWFN DEF
-                     (LIST SHOWTYPE [FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
-                                                (COND
-                                                   ((MSMEMBSET
 ITEM SS)
-                                                    (COND
-                                                       ((NOT ANYFOUND)
-                                                        (TAB 0 0 T)
-                                                        (PRIN2 SHOWFN)
-                                                        (PRIN1 " :
+
                                                             "The SHOW command does not need to save")

+              (MSUPDATEFN1
 SHOWFN DEF (LIST SHOWTYPE
+                                            [FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
+                                                        (COND
+                                                           ((MSMEMBSET
 ITEM SS)
+                                                            (COND
+                                                               ((NOT ANYFOUND)
+                                                                (TAB 0 0 T)
+                                                                (DSPFONT (PROG1 (DSPFONT BOLDFONT)
+                                                                                (PRIN2 SHOWFN)))
+                                                                (PRIN1 " :
 ")))
-                                                    (SETQ ANYFOUND
-                                                     (CONS (CONS PRNT (AND INCLISP
-                                                                           (NOT (MSFIND
 INCLISP 
-                                                                                       PRNT))
-                                                                           INCLISP))
-                                                           ANYFOUND))
-                                                    (COND
-                                                       ([AND (EQ SE 'SHOW)
-                                                             (NOT (FASSOC PRNT (CDR ANYFOUND]
+                                                            (SETQ ANYFOUND
+                                                             (CONS (CONS PRNT
+                                                                         (AND INCLISP
+                                                                              (NOT (MSFIND
 INCLISP 
+                                                                                          PRNT))
+                                                                              INCLISP))
+                                                                   ANYFOUND))
+                                                            (COND
+                                                               ([AND (EQ SE 'SHOW)
+                                                                     (NOT (FASSOC PRNT (CDR ANYFOUND]
 
                                  (* ;; "The EDIT command works by collecting a list of the expressions, and then doing a (*ORF* (=  . lst1) (=  . lst2)) --- if within a CLISP translation (determined by the binding of the INCLISP variable) then want to point at the CLISP if the expression is not actually embedded in the expression")

 
-                                                        (SPACES 3)
-                                                        (LVLPRINT PRNT (OUTPUT)
-                                                               2)
-                                                        (COND
-                                                           ((CDAR ANYFOUND)
+                                                                (SPACES 3)
+                                                                (LVLPRINT PRNT (OUTPUT)
+                                                                       2)
+                                                                (COND
+                                                                   ((CDAR ANYFOUND)
                                                              (* ; "This is under a clisp")

-                                                            (PRIN1 "   {under ")
-                                                            (LVLPRIN2 INCLISP (OUTPUT)
-                                                                   2)
-                                                            (PRIN1 "}
+                                                                    (PRIN1 "   {under ")
+                                                                    (LVLPRIN2 INCLISP (OUTPUT)
+                                                                           2)
+                                                                    (PRIN1 "}
 "]
-                           SHOWSET SHOWEDIT)))
+                                            SHOWSET SHOWEDIT)))
              (T (printout T "Can't find a definition for " SHOWFN "!" T)
                 (RETURN)))
           (COND
@@ -2403,14 +2402,14 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS SCRATCHASH
 MACRO
 [(ARRAYNAME . FORMS)
-                                    ([LAMBDA (ARRAYNAME)
-                                       (SETQ MSCRATCHASH)
-                                       (PROG1 (PROGN . FORMS)
-                                              (SETQ MSCRATCHASH ARRAYNAME]
-                                     (COND
-                                        (MSCRATCHASH (CLRHASH MSCRATCHASH)
-                                               MSCRATCHASH)
-                                        (T (HASHARRAY 20 (FUNCTION MSREHASH])
+                            ([LAMBDA (ARRAYNAME)
+                               (SETQ MSCRATCHASH)
+                               (PROG1 (PROGN . FORMS)
+                                      (SETQ MSCRATCHASH ARRAYNAME]
+                             (COND
+                                (MSCRATCHASH (CLRHASH MSCRATCHASH)
+                                       MSCRATCHASH)
+                                (T (HASHARRAY 20 (FUNCTION MSREHASH])
 )
 )
 
@@ -2569,7 +2568,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS GETWORDTYPE
 MACRO
 [(WORD TYPE)
-                                     (CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
+                             (CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
 )
 )
 
@@ -2578,7 +2577,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
 (* ; "interactive routines")

 
 
-(RPAQ MASTERSCOPEDATE
 "13-Jun-2021")
+(RPAQ MASTERSCOPEDATE
 " 5-Apr-2025")
 
 (ADDTOVAR HISTORYCOMS
 %.)
 (DEFINEQ
@@ -3527,8 +3526,34 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
                      (ERROR!])
 
 (MSOUTPUT

-(LAMBDA (FILE) (* ; "Edited 12-Jun-90 20:43 by teruuchi") (* ;; "OUTPUT is already RESETSAVE'd") (COND ((OPENP FILE (QUOTE OUTPUT)) (OUTPUT FILE)) (T (OUTFILE FILE) (SETQ FILE (OUTPUT)) (RESETSAVE NIL (LIST (QUOTE CLOSEF) FILE)))) (* ;; "output to file, reset LINELENGTH") (LINELENGTH FILELINELENGTH))
-)
+  [LAMBDA (FILE)
                                             (* ; "Edited  5-Apr-2025 11:48 by rmk")


+                                                             (* ; "Edited 14-Jul-2024 08:41 by rmk")


+                                                             (* ; "Edited  5-Jul-2024 11:54 by rmk")


+                                                          (* ; "Edited 12-Jun-90 20:43 by teruuchi")

+    (LET ((LLENGTH FILELINELENGTH))
+         [COND
+            ((AND (LITATOM FILE)
+                  (MEMB (U-CASE FILE)
+                        '(TEDIT :TEDIT))
+                  (GETD (FUNCTION TEDIT)))
+
+             (* ;; 
+
      "If no TEDIT, leave the current OUTPUT.  The readtable for seprs etc is the current readtable.")

+
+             [SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
+                                                                        ,DEFAULTFONT BOUNDTABLE
+                                                                        ,(TEDIT.ATOMBOUND.READTABLE]
+             (SETQ LLENGTH T)
+             (TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
+             (RESETSAVE NIL (LIST 'CLOSEF FILE)))
+            ((OPENP FILE 'OUTPUT))
+            (T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
+               (RESETSAVE NIL (LIST 'CLOSEF FILE]
+
+         (* ;; "Reset LINELENGTH, output to file.  OUTPUT is already RESETSAVE'd.")

+
+         (LINELENGTH LLENGTH FILE)
+         (OUTPUT FILE])
 
 (MSCHECKEMPTY

   [LAMBDA NIL
                                            (* lmm "20-JAN-79 14:08")

@@ -3621,15 +3646,15 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
 (DECLARE%: EVAL@COMPILE
 
 (RECORD GETHASH
 (ID HTABLE . BADMARKS)
-                    ID _ 'GETHASH)
+                ID _ 'GETHASH)
 
 (RECORD INRELATION
 (ID (INVERTED . HTABLES) . OSET)
-                       ID _ 'INRELATION)
+                   ID _ 'INRELATION)
 
-(ASSOCRECORD PATHOPTIONS
 (TO
 FROM
 AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH 
-                                           MARKING)          (* CHECKPATHS assumes that this is 
-
                                                           an ASSOCRECORD)

-                             )
+(ASSOCRECORD PATHOPTIONS
 (TO
 FROM
 AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH MARKING)
+                                                             (* CHECKPATHS assumes that this is an 
+
                                                             ASSOCRECORD)

+                         )
 
 (RECORD MSANALYZABLE
 (FILEPKGNAME SETNAME GETDEF-FN MARKCHANGED-FN))
 )
@@ -3726,39 +3751,37 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
 
 (ADDTOVAR LAMA
 MSEDITE MSEDITF)
 )
-(PUTPROPS MASTERSCOPE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993 
-1994 2018 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3419 19188 (UPDATEFN 3429 . 5046) (MSGETDEF 5048 . 6454) (MSNOTICEFILE 6456 . 8849) (
-MSSHOWUSE 8851 . 14354) (MSUPDATEFN1 14356 . 15044) (MSUPDATE 15046 . 17472) (MSNLAMBDACHECK 17474 . 
-18356) (MSCOLLECTDATA 18358 . 19186)) (19189 20088 (UPDATECHANGED 19199 . 19562) (UPDATECHANGED1 19564
- . 20086)) (20662 21085 (MSCLOSEFILES 20672 . 21083)) (21766 26198 (MSDESCRIBE 21776 . 24564) (
-MSDESCRIBE1 24566 . 25629) (FMAPRINT 25631 . 26196)) (26291 26731 (MSPRINTHELPFILE 26301 . 26729)) (
-26781 29919 (TEMPLATE 26791 . 28212) (GETTEMPLATE 28214 . 28349) (SETTEMPLATE 28351 . 29917)) (30789 
-35713 (ADDTEMPLATEWORD 30799 . 31471) (MSADDANALYZE 31473 . 32971) (MSADDMODIFIER 32973 . 34054) (
-MSADDRELATION 34056 . 34803) (MSADDTYPE 34805 . 35711)) (37214 42435 (MSMARKCHANGE1 37224 . 38018) (
-MSINIT 38020 . 39201) (GETVERBTABLES 39203 . 39756) (MSSTOREDATA 39758 . 41437) (STORETABLE 41439 . 
-42433)) (43836 48906 (PARSERELATION 43846 . 44446) (PARSERELATION1 44448 . 45903) (GETRELATION 45905
- . 46934) (MAPRELATION 46936 . 48070) (TESTRELATION 48072 . 48904)) (48907 50547 (ADDHASH 48917 . 
-49395) (SUBHASH 49397 . 49625) (MAKEHASH 49627 . 49771) (MSREHASH 49773 . 50226) (EQMEMBHASH 50228 . 
-50545)) (50886 57101 (MSVBTABLES 50896 . 56675) (MSUSERVBTABLES 56677 . 57099)) (57184 59395 (
-BUILDGETRELQ 57194 . 58300) (BUILDTESTRELQ 58302 . 59393)) (59566 59954 (MSERASE 59576 . 59952)) (
-59955 64415 (DUMPDATABASE 59965 . 62530) (DUMPDATABASE1 62532 . 62877) (READATABASE 62879 . 64413)) (
-65497 94556 (MSCHECKBLOCKS 65507 . 69327) (MSCHECKBLOCK 69329 . 77949) (MSCHECKFNINBLOCK 77951 . 80951
-) (MSCHECKBLOCKBASIC 80953 . 83373) (MSCHECKBOUNDFREE 83375 . 85274) (GLOBALVARP 85276 . 85443) (
-PRINTERROR 85445 . 88661) (MSCHECKVARS1 88663 . 91616) (UNECCSPEC 91618 . 91896) (NECCSPEC 91898 . 
-92245) (SPECVARP 92247 . 92774) (SHORTLST 92776 . 93232) (DOERROR 93234 . 93944) (MSMSGPRINT 93946 . 
-94554)) (95700 110528 (MSPATHS 95710 . 99112) (MSPATHS1 99114 . 103349) (MSPATHS2 103351 . 106761) (
-MSONPATH 106763 . 107991) (MSPATHS4 107993 . 109075) (DASHES 109077 . 109603) (DOTABS 109605 . 109846)
- (BELOWMARKER 109848 . 110311) (MSPATHSPRINTFN 110313 . 110526)) (110914 114338 (MSFIND 110924 . 
-111199) (MSEDITF 111201 . 112201) (MSEDITE 112203 . 113240) (EDITGETDEF 113242 . 114336)) (115344 
-123945 (MSMARKCHANGED 115354 . 117078) (CHANGEMACRO 117080 . 117785) (CHANGEVAR 117787 . 118103) (
-CHANGEI.S. 118105 . 119438) (CHANGERECORD 119440 . 120311) (MSNEEDUNSAVE 120313 . 121305) (UNSAVEFNS 
-121307 . 123943)) (124386 127876 (%. 124396 . 124536) (MASTERSCOPE 124538 . 125064) (MASTERSCOPE1 
-125066 . 125934) (MASTERSCOPEXEC 125936 . 127874)) (127915 167565 (MSINTERPRETSET 127925 . 156459) (
-MSINTERPA 156461 . 156995) (MSGETBLOCKDEC 156997 . 159510) (LISTHARD 159512 . 160730) (MSMEMBSET 
-160732 . 160877) (MSLISTSET 160879 . 161244) (MSHASHLIST 161246 . 161413) (MSHASHLIST1 161415 . 161741
-) (CHECKPATHS 161743 . 162383) (ONFILE 162385 . 167563)) (167566 190732 (MSINTERPRET 167576 . 184429) 
-(VERBNOTICELIST 184431 . 185541) (MSOUTPUT 185543 . 185860) (MSCHECKEMPTY 185862 . 187066) (
-CHECKFORCHANGED 187068 . 187588) (MSSOLVE 187590 . 190730)))))
+  (FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
+MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 . 
+18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
+ . 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
+MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
+27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108 
+36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
+MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42754 (MSMARKCHANGE1 37543 . 38337) (
+MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41756) (STORETABLE 41758 . 
+42752)) (44155 49225 (PARSERELATION 44165 . 44765) (PARSERELATION1 44767 . 46222) (GETRELATION 46224
+ . 47253) (MAPRELATION 47255 . 48389) (TESTRELATION 48391 . 49223)) (49226 50866 (ADDHASH 49236 . 
+49714) (SUBHASH 49716 . 49944) (MAKEHASH 49946 . 50090) (MSREHASH 50092 . 50545) (EQMEMBHASH 50547 . 
+50864)) (51205 57420 (MSVBTABLES 51215 . 56994) (MSUSERVBTABLES 56996 . 57418)) (57503 59714 (
+BUILDGETRELQ 57513 . 58619) (BUILDTESTRELQ 58621 . 59712)) (59885 60273 (MSERASE 59895 . 60271)) (
+60274 64734 (DUMPDATABASE 60284 . 62849) (DUMPDATABASE1 62851 . 63196) (READATABASE 63198 . 64732)) (
+65816 94875 (MSCHECKBLOCKS 65826 . 69646) (MSCHECKBLOCK 69648 . 78268) (MSCHECKFNINBLOCK 78270 . 81270
+) (MSCHECKBLOCKBASIC 81272 . 83692) (MSCHECKBOUNDFREE 83694 . 85593) (GLOBALVARP 85595 . 85762) (
+PRINTERROR 85764 . 88980) (MSCHECKVARS1 88982 . 91935) (UNECCSPEC 91937 . 92215) (NECCSPEC 92217 . 
+92564) (SPECVARP 92566 . 93093) (SHORTLST 93095 . 93551) (DOERROR 93553 . 94263) (MSMSGPRINT 94265 . 
+94873)) (96019 110847 (MSPATHS 96029 . 99431) (MSPATHS1 99433 . 103668) (MSPATHS2 103670 . 107080) (
+MSONPATH 107082 . 108310) (MSPATHS4 108312 . 109394) (DASHES 109396 . 109922) (DOTABS 109924 . 110165)
+ (BELOWMARKER 110167 . 110630) (MSPATHSPRINTFN 110632 . 110845)) (111233 114657 (MSFIND 111243 . 
+111518) (MSEDITF 111520 . 112520) (MSEDITE 112522 . 113559) (EDITGETDEF 113561 . 114655)) (115599 
+124200 (MSMARKCHANGED 115609 . 117333) (CHANGEMACRO 117335 . 118040) (CHANGEVAR 118042 . 118358) (
+CHANGEI.S. 118360 . 119693) (CHANGERECORD 119695 . 120566) (MSNEEDUNSAVE 120568 . 121560) (UNSAVEFNS 
+121562 . 124198)) (124633 128123 (%. 124643 . 124783) (MASTERSCOPE 124785 . 125311) (MASTERSCOPE1 
+125313 . 126181) (MASTERSCOPEXEC 126183 . 128121)) (128162 167812 (MSINTERPRETSET 128172 . 156706) (
+MSINTERPA 156708 . 157242) (MSGETBLOCKDEC 157244 . 159757) (LISTHARD 159759 . 160977) (MSMEMBSET 
+160979 . 161124) (MSLISTSET 161126 . 161491) (MSHASHLIST 161493 . 161660) (MSHASHLIST1 161662 . 161988
+) (CHECKPATHS 161990 . 162630) (ONFILE 162632 . 167810)) (167813 192172 (MSINTERPRET 167823 . 184676) 
+(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187300) (MSCHECKEMPTY 187302 . 188506) (
+CHECKFORCHANGED 188508 . 189028) (MSSOLVE 189030 . 192170)))))
 STOP

library/PDFSTREAM

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56
 14033  
+
(FILECREATED "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62
 14729  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS PDFSTREAMCOMS)
+      :CHANGES-TO (FNS OPEN-PDF-STREAM)
 
-      :PREVIOUS-DATE " 9-Oct-2023 00:42:25" {WMEDLEY}<library>PDFSTREAM.;55)
+      :PREVIOUS-DATE "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60)
 
 
 (PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -30,6 +30,7 @@
                                             (FONTCREATE POSTSCRIPT.FONTCREATE)
                                             (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
                                             (CREATECHARSET \CREATECHARSET.PSC]
+              (ALISTS (DEFAULTFILETYPELIST PDF))
               (VARS (DEFAULTPRINTERTYPE 'PDF))
               (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
               (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
@@ -73,6 +74,8 @@
                                 (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
                                 (CREATECHARSET \CREATECHARSET.PSC)))
 
+(ADDTOVAR DEFAULTFILETYPELIST
 (PDF . BINARY))
+
 (RPAQQ DEFAULTPRINTERTYPE
 PDF)
 (DEFINEQ
 
@@ -150,7 +153,8 @@
 (DEFINEQ
 
 (OPEN-PDF-STREAM

-  [LAMBDA (FILE OPTIONS)
                                     (* ; "Edited 23-Sep-2023 15:38 by rmk")


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


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


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


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

 
@@ -168,20 +172,26 @@
              (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting.  But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")

 
              (OPENPOSTSCRIPTSTREAM FILE OPTIONS)
-      else
 (CL:UNLESS (ASSOC (PDFCONVERTER
)
-                             PDF-CONVERTER-TEMPLATES)
-                  (ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
-           (SETQ FILE (OR (AND (NEQ FILE T)
-                               (OUTFILEP FILE))
-                          (ERROR "PDF target file not found" FILE)))
-           (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
-                                                        "-"
-                                                        (RAND)
-                                                        ".ps")
-                                  OPTIONS)))
-                (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
-                (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
-                PSSTREAM])
+      elseif
 (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE)
+                              'HOST))
+        then
 
+             (* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index.  Nothing to convert")

+
+             (OPENPOSTSCRIPTSTREAM FILE OPTIONS)
+      elseif
 (SETQ FILE (OR (AND (NEQ FILE T)
+                                 (OUTFILEP FILE))
+                            (ERROR "PDF target file not found" FILE)))
+        then
 (CL:UNLESS (ASSOC (PDFCONVERTER
)
+                               PDF-CONVERTER-TEMPLATES)
+                    (ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
+             (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
+                                                          "-"
+                                                          (RAND)
+                                                          ".ps")
+                                    OPTIONS)))
+                  (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
+                  (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
+                  PSSTREAM])
 
 (CLOSE-PDF-STREAM

   [LAMBDA (PSSTREAM)
                                         (* ; "Edited 22-Sep-2023 11:18 by rmk")


@@ -262,12 +272,14 @@
 (DEFINEQ
 
 (SEE-PDF

-  [LAMBDA (PDFFILE)
                                          (* ; "Edited  1-Oct-2023 20:47 by rmk")


+  [LAMBDA (PDFFILE)
                                          (* ; "Edited 25-Dec-2024 14:25 by rmk")


+                                                             (* ; "Edited  1-Oct-2023 20:47 by rmk")


                                                              (* ; "Edited 26-Sep-2023 16:52 by rmk")

 
     (* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")

 
-    (ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
+    (ShellOpen (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
+                   (ERROR "FILE NOT FOUND" PDFFILE])
 )
 
 (ADDTOVAR FB.SEE.METHODS
 (PDFFILEP SEE-PDF))
@@ -280,8 +292,8 @@
                                    thereis
 (ShellWhich (CAR TEMPLATE])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3162 5776 (PDFFILEP 3172 . 4086) (PDF.HARDCOPYW 4088 . 4686) (PDF.TEXT 4688 . 5405) (
-PDF.TEDIT 5407 . 5774)) (6216 13276 (OPEN-PDF-STREAM 6226 . 8362) (CLOSE-PDF-STREAM 8364 . 9651) (
-PS-TO-PDF 9653 . 13274)) (13277 13675 (SEE-PDF 13287 . 13673)) (13726 14010 (PDFCONVERTER 13736 . 
-14008)))))
+  (FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
+PDF.TEDIT 5508 . 5875)) (6317 13806 (OPEN-PDF-STREAM 6327 . 8892) (CLOSE-PDF-STREAM 8894 . 10181) (
+PS-TO-PDF 10183 . 13804)) (13807 14371 (SEE-PDF 13817 . 14369)) (14422 14706 (PDFCONVERTER 14432 . 
+14704)))))
 STOP

library/PSEUDOHOSTS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 2-Nov-2023 10:53:30" {WMEDLEY}<lispusers>PSEUDOHOSTS.;160
 26843  
+
(FILECREATED "31-Dec-2024 11:45:23" {WMEDLEY}<library>PSEUDOHOSTS.;177
 29713  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS PSEUDOHOST)
+      :CHANGES-TO (FNS TRUEDEVICE)
 
-      :PREVIOUS-DATE " 1-Oct-2023 20:16:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;159)
+      :PREVIOUS-DATE "25-Dec-2024 07:38:10" {WMEDLEY}<library>PSEUDOHOSTS.;176)
 
 
 (PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -15,16 +15,17 @@
        (
         (* ;; "Public entries")

 
-        (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME)
+        (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME)
         
         (* ;; "Internals")

 
         (FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH)
+        (FNS CDPSEUDO)
         (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH 
              OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH 
              SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
-        (P (PSEUDOHOST 'LI LOGINHOST/DIR)
-           (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (PSEUDOHOST 'LI LOGINHOST/DIR)))
+        (P (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
            (MOVD 'GETHOSTINFO.PH 'GETHOSTINFO))
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
                (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
@@ -136,9 +137,14 @@
     HOST])
 
 (PSEUDOHOSTP

-  [LAMBDA (HOST)
                                             (* ; "Edited 24-Feb-2022 23:51 by rmk")


+  [LAMBDA (HOST)
                                             (* ; "Edited 16-Dec-2024 21:15 by rmk")


+                                                             (* ; "Edited 24-Feb-2022 23:51 by rmk")


                                                              (* ; "Edited 18-Jan-2022 11:29 by rmk")

-    (LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
+    (LET [(DEV (if
 (type?
 FDEV HOST)
+                   then
 HOST
+                 elseif
 (type?
 STREAM HOST)
+                   then
 (fetch
 (STREAM DEVICE) of
 HOST)
+                 else
 (\GETDEVICEFROMNAME HOST T T]
          (CL:WHEN (AND DEV (type?
 FDEV (fetch
 (PHDEVICE TARGETDEV) OF
 DEV)))
              (LIST (FETCH
 (FDEV DEVICENAME) OF
 DEV)
                    (FETCH
 (PHDEVICE PREFIX)
@@ -151,9 +157,30 @@
                      (FETCH
 (PHDEVICE PREFIX) OF
 DEV])
 
 (TARGETHOST

-  [LAMBDA (HOST)
                                             (* ; "Edited 22-Jan-2022 09:00 by rmk")

-    (CL:WHEN (PSEUDOHOSTP
 HOST)
-        (FETCH
 (FDEV DEVICENAME) OF
 (FETCH
 (PHDEVICE TARGETDEV) OF
 (\GETDEVICEFROMNAME HOST))))])
+  [LAMBDA (HOST)
                                             (* ; "Edited 14-Dec-2024 15:26 by rmk")


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


+                                                             (* ; "Edited 22-Jan-2022 09:00 by rmk")

+    (if
 (STREAMP HOST)
+        then
 (CL:WHEN (type?
 FDEV (fetch
 (PHDEVICE TARGETDEV) of
 (fetch
 (STREAM DEVICE) of
 HOST)))
+                 (fetch
 (FDEV DEVICENAME) of
 (fetch
 (PHDEVICE TARGETDEV) of
 (fetch
 (STREAM DEVICE)
+                                                                               of
 HOST))))
+      elseif
 (PSEUDOHOSTP
 HOST)
+        then
 (fetch
 (FDEV DEVICENAME) of
 (fetch
 (PHDEVICE TARGETDEV) of
 (\GETDEVICEFROMNAME HOST T T])
+
+(TRUEDEVICE

+  [LAMBDA (X)
                                                (* ; "Edited 31-Dec-2024 11:44 by rmk")


+                                                             (* ; "Edited 25-Dec-2024 07:37 by rmk")


+                                                             (* ; "Edited 23-Dec-2024 22:56 by rmk")


+                                                             (* ; "Edited 16-Dec-2024 17:36 by rmk")


+                                                             (* ; "Edited 12-Dec-2024 14:34 by rmk")

+    (LET [(DEV (if
 (type?
 FDEV X)
+                   then
 X
+                 elseif
 (STREAMP X)
+                   then
 (fetch
 (STREAM DEVICE) of
 X)
+                 else
 (\GETDEVICEFROMNAME X]
+         (if
 (type?
 FDEV (fetch
 (PHDEVICE TARGETDEV) of
 DEV))
+             then
 (fetch
 (PHDEVICE TARGETDEV) of
 DEV)
+           else
 DEV])
 
 (TRUEFILENAME

   [LAMBDA (FILE)
                                             (* ; "Edited  1-Oct-2023 20:16 by rmk")


@@ -301,6 +328,24 @@
 )
 (DEFINEQ
 
+(CDPSEUDO

+  [LAMBDA (PHOST CDSUFFIX FILEPKG)
                           (* ; "Edited 21-Dec-2024 13:48 by rmk")


+                                                             (* ; "Edited  6-Feb-2024 15:50 by rmk")

+
+    (* ;; "Makes a cd command for PHOST. The command name is %"cd%" followed by the lower-case letters of CDSUFFIX (e.g. cdf for PHOST FOO and CDSUFFIX %"f%".")

+
+    (CL:WHEN (AND (SETQ PHOST (CAR (PSEUDOHOSTP
 PHOST)))
+                  CDSUFFIX)
+        [LET ((C (PACK* "cd" (L-CASE CDSUFFIX)))
+              (FILEPKGFLG FILEPKG))
+             (DECLARE
 (SPECVARS FILEPKGFLG))
+             (SETQ PHOST (CONCAT "{" PHOST "}"))
+             (EVAL `(DEFCOMMAND ,C (SUBDIR) (/CNDIR (CL:IF SUBDIR
+                                                        (CONCAT ,PHOST "/" SUBDIR)
+                                                        ,PHOST)))])])
+)
+(DEFINEQ
+
 (OPENFILE.PH

   [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
 
@@ -453,8 +498,10 @@
              (SETQ RESULT (CONTRACT.PH
 RESULT NEW-DEVICE)))
          RESULT])
 )
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (PSEUDOHOST
 'LI LOGINHOST/DIR)
+)
 
 (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
 
@@ -515,12 +562,13 @@
        EXPORTS.ALL)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1254 10126 (PSEUDOHOST 1264 . 6972) (PSEUDOHOSTP 6974 . 7487) (PSEUDOHOSTS 7489 . 7850)
- (TARGETHOST 7852 . 8126) (TRUEFILENAME 8128 . 9253) (PSEUDOFILENAME 9255 . 10124)) (10154 16169 (
-EXPAND.PH 10164 . 11417) (CONTRACT.PH 11419 . 14130) (UNSLASHIT 14132 . 15878) (GETHOSTINFO.PH 15880
- . 16167)) (16170 24190 (OPENFILE.PH 16180 . 17253) (GETFILENAME.PH 17255 . 17544) (DIRECTORYNAMEP.PH 
-17546 . 18170) (CLOSEFILE.PH 18172 . 18639) (REOPENFILE.PH 18641 . 19206) (DELETEFILE.PH 19208 . 19492
-) (OPENP.PH 19494 . 19789) (UNREGISTERFILE.PH 19791 . 20333) (REGISTERFILE.PH 20335 . 20869) (
-GENERATEFILES.PH 20871 . 21915) (GETFILEINFO.PH 21917 . 22219) (SETFILEINFO.PH 22221 . 22420) (
-NEXTFILEFN.PH 22422 . 22968) (FILEINFOFN.PH 22970 . 23245) (RENAMEFILE.PH 23247 . 24188)))))
+  (FILEMAP (NIL (1318 12059 (PSEUDOHOST 1328 . 7036) (PSEUDOHOSTP 7038 . 7867) (PSEUDOHOSTS 7869 . 8230)
+ (TARGETHOST 8232 . 9101) (TRUEDEVICE 9103 . 10059) (TRUEFILENAME 10061 . 11186) (PSEUDOFILENAME 11188
+ . 12057)) (12087 18102 (EXPAND.PH 12097 . 13350) (CONTRACT.PH 13352 . 16063) (UNSLASHIT 16065 . 17811
+) (GETHOSTINFO.PH 17813 . 18100)) (18103 19004 (CDPSEUDO 18113 . 19002)) (19005 27025 (OPENFILE.PH 
+19015 . 20088) (GETFILENAME.PH 20090 . 20379) (DIRECTORYNAMEP.PH 20381 . 21005) (CLOSEFILE.PH 21007 . 
+21474) (REOPENFILE.PH 21476 . 22041) (DELETEFILE.PH 22043 . 22327) (OPENP.PH 22329 . 22624) (
+UNREGISTERFILE.PH 22626 . 23168) (REGISTERFILE.PH 23170 . 23704) (GENERATEFILES.PH 23706 . 24750) (
+GETFILEINFO.PH 24752 . 25054) (SETFILEINFO.PH 25056 . 25255) (NEXTFILEFN.PH 25257 . 25803) (
+FILEINFOFN.PH 25805 . 26080) (RENAMEFILE.PH 26082 . 27023)))))
 STOP

library/lafite/LAFITE-COMMANDS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2
 164484 
+
(FILECREATED "15-Feb-2025 13:05:52" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;3
 164570 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
+      :CHANGES-TO (FNS LAFITE.SET.LOOKS LAFITE.SUBSTITUTE.VP.EOL)
 
-      :PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
+      :PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2)
 
 
 (PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
@@ -560,7 +560,7 @@
     (LAFITE.SET.LOOKS
 TEXTSTREAM LAFITEFIXEDWIDTHFONT])
 
 (LAFITE.SET.LOOKS

-  [LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN)

+  [LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN)
  (* ; "Edited 15-Feb-2025 13:02 by rmk")


                                                              (* ; "Edited  3-Nov-89 14:50 by bvm")

 
     (* ;; "Called from Looks (sub)commands of Lafite display window.  Change the looks of the current selection (if there is an interesting one) or the whole message to be NEWLOOKS.  If NEWLOOKS is T, we use TEdit's menu interface.  PARALOOKS is for paragraph formatting.  USERFN is arbitrary function called with arg textstream & selection set appropriately.  Any of NEWLOOKS, PARALOOKS, USERFN can be NIL.  If OMITHEADER is true, the header is left out of the modification if user has not selected a region of text already.")

@@ -571,57 +571,56 @@
         (LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
               START LEN WIDTH FIXEDLOOKS)
              [if
 (AND (NOT PARALOOKS)
-                          (FONTP NEWLOOKS)
-                          (EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
-                                                 NEWLOOKS))
-                              (CHARWIDTH (CHARCODE "W")
-                                     NEWLOOKS)))
-                 then
                                    (* ; "If font is fixed-width, let's make the tab the right width.  Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")

-                       (SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
-             (if
 (> (SETQ LEN (fetch
 (SELECTION DCH) of
 SEL))
-                        1)
-                 then
                                    (* ; "User has already selected something.  Assume any selection greater than a single character is not accidental.")

-                       (if
 (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM
-                                                                            'LAFITEFIXEDLOOKS))
-                                                    T))
-                           then
 
+                      (FONTP NEWLOOKS)
+                      (EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
+                                             NEWLOOKS))
+                          (CHARWIDTH (CHARCODE "W")
+                                 NEWLOOKS)))
+                 then
                                        (* ; "If font is fixed-width, let's make the tab the right width.  Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")

+                      (SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
+             (if
 (> (SETQ LEN (TEDIT.SELPROP SEL 'LENGTH))
+                    1)
+                 then
                                        (* ; "User has already selected something.  Assume any selection greater than a single character is not accidental.")

+                      (if
 (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM 
+                                                                       'LAFITEFIXEDLOOKS))
+                                               T))
+                          then
 
+                               (* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything.  If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")

 
-                                 (* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything.  If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")

-
-                                 (TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
-                                        (CONS (CONS (fetch
 (SELECTION CH#) of
 SEL)
-                                                    LEN)
-                                              FIXEDLOOKS)))
+                               (TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
+                                      (CONS (CONS (TEDIT.SELPROP SEL 'CH#)
+                                                  LEN)
+                                            FIXEDLOOKS)))
                else
 (SETQ START (if
 OMITHEADER
-                                        then
             (* ; 
-
                                                  "Start after the blank line following the header")

-                                              (\LAFITE.HEADER.EOF TEXTSTREAM)
-                                      else
 0))
-                     (SETQ LEN (- (GETEOFPTR TEXTSTREAM)
-                                  (if
 LAFITEENDOFMESSAGESTR
-                                      then
 (NCHARS LAFITEENDOFMESSAGESTR)
-                                    else
 0)
-                                  START))
-                     (TEDIT.SETSEL TEXTSTREAM (ADD1 START)
-                            LEN
-                            'RIGHT)
-                     (if
 FIXEDLOOKS
-                         then
                            (* ; "The whole thing is fixed now")

-                               (TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
+                                    then
                     (* ; 
+
                                                    "Start after the blank line following the header")

+                                         (\LAFITE.HEADER.EOF TEXTSTREAM)
+                                  else
 0))
+                    (SETQ LEN (- (GETEOFPTR TEXTSTREAM)
+                                 (if
 LAFITEENDOFMESSAGESTR
+                                     then
 (NCHARS LAFITEENDOFMESSAGESTR)
+                                   else
 0)
+                                 START))
+                    (TEDIT.SETSEL TEXTSTREAM (ADD1 START)
+                           LEN
+                           'RIGHT)
+                    (if
 FIXEDLOOKS
+                        then
                                 (* ; "The whole thing is fixed now")

+                             (TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
 
              (* ;; "Now do the modification")

 
              (if
 (EQ NEWLOOKS T)
-                 then
                                    (* ; "Use menu")

-                       (\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
+                 then
                                        (* ; "Use menu")

+                      (\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
                elseif
 NEWLOOKS
                  then
 (TEDIT.LOOKS TEXTSTREAM NEWLOOKS))
              (if
 PARALOOKS
-                 then
                                    (* ; "Paragraph looks")

-                       (TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
+                 then
                                        (* ; "Paragraph looks")

+                      (TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
              (if
 USERFN
-                 then
                                    (* ; "Arbitrary user manipulation.")

-                       (CL:FUNCALL USERFN TEXTSTREAM))
+                 then
                                        (* ; "Arbitrary user manipulation.")

+                      (CL:FUNCALL USERFN TEXTSTREAM))
 
              (* ;; "Finally, set selection back to where it was.")

 
@@ -657,31 +656,31 @@
                                                                                           STR])
 
 (LAFITE.SUBSTITUTE.VP.EOL

-  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited  4-Aug-89 16:55 by bvm")

+  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited 15-Feb-2025 13:03 by rmk")


+                                                             (* ; "Edited  4-Aug-89 16:55 by bvm")

 
-    (* ;; 
-
  "Called from Looks (sub)commands of Lafite display window.  Replace VP eol (29) with ours.")

+    (* ;; "Called from Looks (sub)commands of Lafite display window.  Replace VP eol (29) with ours.")

 
     (RESETLST
         (RESETSAVE NIL (LIST 'TEXTPROP TEXTSTREAM 'READONLY T))
         (TEXTPROP TEXTSTREAM 'READONLY NIL)
-        (LET* ((SEL (TEDIT.GETSEL TEXTSTREAM))
-               (LEN (fetch
 (SELECTION DCH) of
 SEL))
-               POS)
-              (if
 (<= LEN 1)
-                  then
                                   (* ; 
-
 "If user has already selected something (more than a single character), assume is not accidental.")

-                        (SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
-                        (TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
-                                                        (if
 LAFITEENDOFMESSAGESTR
-                                                            then
 (NCHARS LAFITEENDOFMESSAGESTR)
-                                                          else
 0)
-                                                        POS)))
-              (TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
-                     (ALLOCSTRING 1 (CHARCODE EOL)))
-              (if
 POS
-                  then
                                   (* ; "Undo the selection")

-                        (TEDIT.SETSEL TEXTSTREAM 1 0))))])
+        (LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
+              POS)
+             (if
 (<= (TEDIT.SELPROP SEL 'LENGTH)
+                     1)
+                 then
                                        (* ; 
+
   "If user has already selected something (more than a single character), assume is not accidental.")

+                      (SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
+                      (TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
+                                                      (if
 LAFITEENDOFMESSAGESTR
+                                                          then
 (NCHARS LAFITEENDOFMESSAGESTR)
+                                                        else
 0)
+                                                      POS)))
+             (TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
+                    (ALLOCSTRING 1 (CHARCODE EOL)))
+             (if
 POS
+                 then
                                        (* ; "Undo the selection")

+                      (TEDIT.SETSEL TEXTSTREAM 1 0))))])
 )
 
 (RPAQ? \LAFITE.DISPLAY.COMMANDS
 NIL)
@@ -2546,37 +2545,37 @@
 (ADDTOVAR LAMA
 LAFITE.HARDCOPY.MESSAGES)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) (
-SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 . 
-24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548 
-36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) (
-\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV 
-31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138)
-) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) (
-\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 . 
-41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) (
-LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) (
-\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) (
-\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST 
-55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC 
-60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU 
-69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) (
-\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 (
-\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175)
- (\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) (
-LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877
- . 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) (
-\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) (
-LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1 
-105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) (
-\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387
- . 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) (
-\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY 
-138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288 
-163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) (
-\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) (
-\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) (
-\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) (
-\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) (
-\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261)))))
+  (FILEMAP (NIL (7764 27568 (\LAFITE.DISPLAY 7774 . 9479) (\LAFITE.DO.DISPLAY 9481 . 13646) (
+SELECTMESSAGETODISPLAY 13648 . 16016) (MESSAGEDISPLAYER 16018 . 23570) (LA.COPY.MESSAGE.TEXT 23572 . 
+24326) (\LAFITE.CLOSE.DISPLAYWINDOWS 24328 . 25922) (\LAFITE.CLOSE.DISPLAYER 25924 . 27566)) (27569 
+36161 (\LAFITE.UNHIDE.HEADERS 27579 . 28669) (\LAFITE.HIDE.HEADERS 28671 . 29324) (
+\LAFITE.REHIDE.HEADERS 29326 . 30362) (LAFITE.EAT.UNDESIRABLE.FIELD 30364 . 31123) (LAFITE.EAT.GVGV 
+31125 . 32286) (\LAFITE.HARDCOPY.FROM.DISPLAY 32288 . 35807) (LAFITE.HARDCOPY.TAB.WIDTH 35809 . 36159)
+) (36162 44530 (\LAFITE.SET.LOOKS.FROM.MENU 36172 . 36349) (\LAFITE.SET.DEFAULT.LOOKS 36351 . 36542) (
+\LAFITE.SET.FIXED.LOOKS 36544 . 36736) (LAFITE.SET.LOOKS 36738 . 41179) (LAFITE.SET.TAB.LOOKS 41181 . 
+41892) (LAFITE.SET.PARA.SEPARATION 41894 . 42102) (LAFITE.SET.LOWER.CASE 42104 . 42955) (
+LAFITE.SUBSTITUTE.VP.EOL 42957 . 44528)) (46447 54775 (LAFITE.DELETE.MESSAGES 46457 . 47507) (
+\LAFITE.DELETE 47509 . 48696) (DISPLAYAFTERDELETE 48698 . 53424) (\LAFITE.SELECT.NEXT 53426 . 54064) (
+\LAFITE.UNDELETE 54066 . 54773)) (54797 69292 (LAFITE.MOVE.MESSAGES 54807 . 55454) (\COERCE.TO.MSGLST 
+55456 . 56214) (\LAFITE.MOVETO 56216 . 60160) (\LAFITE.COPYTO 60162 . 60578) (\LAFITE.MOVETO.PROC 
+60580 . 61850) (\LAFITE.MOVE.MESSAGES.INTERNAL 61852 . 69290)) (69318 77870 (\LAFITE.ENABLE.MOVE.MENU 
+69328 . 70370) (\LAFITE.ADD.TO.MOVE.MENU 70372 . 71388) (\LAFITE.UPDATE.MOVE.MENU 71390 . 76030) (
+\LAFITE.RESTORE.MOVE.MENU 76032 . 76708) (\LAFITE.HANDLE.AUTO.MOVE 76710 . 77868)) (78726 96210 (
+\LAFITE.UPDATE 78736 . 84369) (\LAFITE.EXPUNGE.PROC 84371 . 85176) (\LAFITE.UPDATE.PROC 85178 . 86261)
+ (\LAFITE.HARDCOPYONLY.PROC 86263 . 86705) (LAB.CHOOSE.UPDATE.MENU 86707 . 87488) (
+LAB.CREATE.UPDATE.MENU 87490 . 89389) (LAB.UPDATE.NEEDED? 89391 . 90961) (\LAFITE.START.UPDATE 90963
+ . 91995) (LAB.START.COMMAND 91997 . 92847) (\LAFITE.FINISH.UPDATE 92849 . 95102) (
+\LAFITE.CLOSE.OTHER.FOLDERS 95104 . 96208)) (96211 131005 (LAB.FLUSHWINDOW 96221 . 97900) (
+LAB.APPENDMESSAGES 97902 . 101064) (\LAFITE.COMPACT.FOLDER 101066 . 105230) (\LAFITE.COMPACT.FOLDER1 
+105232 . 121271) (\LAFITE.COMPACT.FOLDER2 121273 . 125987) (\LAFITE.COMPACT.EXTRA 125989 . 128304) (
+\LAFITE.INVALIDATE.TOC 128306 . 128999) (\LAFITE.RENAMEFILE 129001 . 129471) (SMART-RENAMEFILEP 129473
+ . 130033) (LA.OPENTEMPFILE 130035 . 131003)) (131006 144348 (\LAFITE.UPDATE.FOLDER 131016 . 132993) (
+\LAFITE.UPDATE.CONTENTS 132995 . 133712) (\LAFITE.UPDATE.CONTENTS1 133714 . 138568) (WRITETOCENTRY 
+138570 . 141688) (WRITETOCMARKBYTES 141690 . 141932) (WRITEFOLDERMARKBYTES 141934 . 144346)) (144374 
+163349 (LAFITE.HARDCOPY.MESSAGES 144384 . 144844) (\LAFITE.HARDCOPY 144846 . 145181) (
+\LAFITE.HARDCOPY.PROC 145183 . 148661) (\LAFITE.HARDCOPY.HEADERS 148663 . 153992) (
+\LAFITE.MARK.HARDCOPIED 153994 . 155704) (\LAFITE.TRANSMIT.HARDCOPY 155706 . 157296) (
+\LAFITE.HARDCOPY.BODIES 157298 . 158540) (\LAFITE.APPEND.MESSAGE.BODY 158542 . 160650) (
+\LAFITE.DO.PENDING.HARDCOPY 160652 . 161727) (\LAFITE.CANCEL.HARDCOPY 161729 . 162445) (
+\LAFITE.CLEAR.HARDCOPY.STATE 162447 . 163347)))))
 STOP

library/lafite/LAFITE-INDENT

@@ -1,16 +1,18 @@
-(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
-
(FILECREATED "22-Jan-87 01:34:36" {ERIS}<LISPUSERS>LISPCORE>LAFITE-INDENT.;1
 25845  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      previous date%: "21-Jan-87 16:06:01" {ERIS}<LISPUSERS>KOTO>LAFITE-INDENT.;5)
+
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4
 26926  
 
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE 
+                       TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
+
+      :PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
 
-(* "
-Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT LAFITE-INDENTCOMS)
 
-(RPAQQ LAFITE-INDENTCOMS
 
+(RPAQQ LAFITE-INDENTCOMS

        [(* * LAFITE-INDENT defines a function that will indent the current selection.)
         (FNS TEDIT-INDENT-ADD-INDENTATION TEDIT-INDENT-BREAK-LINE TEDIT-INDENT-BREAK-LONG-LINES 
              TEDIT-INDENT-FIND-BREAKPOINT TEDIT-INDENT-REPLACE-SELECTION TEDIT-INDENT-SELECTION 
@@ -31,12 +33,14 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
                                                           (SUBITEMS (Indent 'TEDIT-INDENT-SELECTION 
                                                                        "Indent the current selection"
                                                                            )
-                                                                 ("Indent & keep lines" '
-                                                            TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 
+                                                                 ("Indent & keep lines" 
+                                                                        '
+                                                            TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
+                                                                        
                                          "Indent the current selection, keeping existing line breaks"
                                                                         )
-                                                                 ("Set indent" '
-                                                                        TEDIT-INDENT-SET-INDENT 
+                                                                 ("Set indent" 
+                                                                        'TEDIT-INDENT-SET-INDENT 
                                                                "Set the indent string to a new value"
                                                                         )
                                                                  (Unindent 'TEDIT-REMOVE-INDENT 
@@ -45,12 +49,14 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
                                                                  ("Open line" 'TEDIT-OPEN-LINE 
                                                           "Open a blank line at the current position"
                                                                         )
-                                                                 ("Insert <RETURN>s" '
-                                                                        TEDIT-MAKE-LINES-EXPLICIT 
+                                                                 ("Insert <RETURN>s" 
+                                                                        'TEDIT-MAKE-LINES-EXPLICIT 
                              "Insert real <RETURN>s at the end of each line in the current selection"
                                                                         )
-                                                                 ("Break long lines" '
-                                                                        TEDIT-INDENT-BREAK-LONG-LINES 
+                                                                 ("Break long lines" 
+                                                                        '
+                                                                        TEDIT-INDENT-BREAK-LONG-LINES
+                                                                        
                                                   "Break long lines by inserting explicit <RETURN>'s"
                                                                         ])
 (* * LAFITE-INDENT defines a function that will indent the current selection.)

@@ -127,14 +133,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
                                          max-length max-length])
 
 (TEDIT-INDENT-BREAK-LONG-LINES

-  [LAMBDA (text-stream explicit-paragraph-breaks?)
           (* smL "21-Jan-87 16:03")

-          
-          (* * Break the current selection into explicit lines, each having no more than 
-
          *TEDIT-INDENT-LINE-LENGTH* characters. -
-
          If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in 
-
          the current selection are removed. -
-
          This is intended to be used in Lafite, where one wants to indent a piece of a 
-
          forwarded document, but can be used in any TEdit document)

+  [LAMBDA (text-stream explicit-paragraph-breaks?)
           (* ; "Edited 15-Feb-2025 14:07 by rmk")

+                                                             (* smL "21-Jan-87 16:03")

+
+(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters.  --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed.  --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")

 
     (LET ((selection (TEDIT.GETSEL text-stream)))
          (TEDIT-INDENT-REPLACE-SELECTION

@@ -142,11 +144,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
           (CONCATLIST (for
 string on
 (TEDIT-INDENT-SEPERATE-PARAGRAPHS
 (TEDIT.SEL.AS.STRING 
                                                                               text-stream selection)
                                             explicit-paragraph-breaks?)
-                         bind
 [hanging-indent _
-                                     (AND (NOT (EQP (fetch
 CHAR1 of
 (CAR (fetch
 L1 of
 selection)))
-                                                    (fetch
 CH# of
 selection)))
-                                          (DIFFERENCE (fetch
 CH# of
 selection)
-                                                 (fetch
 CHAR1 of
 (CAR (fetch
 L1 of
 selection]
+                         bind
 [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
+                                                                      LCHAR1)
+                                                               (TEDIT.SELPROP selection 'CH#]
+                                                     (DIFFERENCE (TEDIT.SELPROP selection
+                                                                        'CH#)
+                                                            (GETLD (CAR (GETSEL selection L1))
+                                                                   LCHAR1]
                          join
 (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION
 (CAR string)
                                                   "" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
                                            *eol-string*)
@@ -181,15 +185,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
                 'RIGHT])
 
 (TEDIT-INDENT-SELECTION

-  [LAMBDA (text-stream explicit-paragraph-breaks?)
           (* smL "21-Jan-87 16:00")

-          
-          (* * Indent the current selection by prefacing each line with the value of 
-
          *TEDIT-INDENT-STRING*, and inserting line breaks after each 
-
          *TEDIT-INDENT-LINE-LENGTH* characters. -
-
          If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in 
-
          the current selection are removed. -
-
          This is intended to be used in Lafite, where one wants to indent a piece of a 
-
          forwarded document, but can be used in any TEdit document)

+  [LAMBDA (text-stream explicit-paragraph-breaks?)
           (* ; "Edited 15-Feb-2025 14:07 by rmk")

+                                                             (* smL "21-Jan-87 16:00")

+
+(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters.  --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed.  --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")

 
     (LET ((selection (TEDIT.GETSEL text-stream)))
          (TEDIT-INDENT-REPLACE-SELECTION

@@ -197,11 +196,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
           (CONCATLIST (for
 string on
 (TEDIT-INDENT-SEPERATE-PARAGRAPHS
 (TEDIT.SEL.AS.STRING 
                                                                               text-stream selection)
                                             explicit-paragraph-breaks?)
-                         bind
 [hanging-indent _
-                                     (AND (NOT (EQP (fetch
 CHAR1 of
 (CAR (fetch
 L1 of
 selection)))
-                                                    (fetch
 CH# of
 selection)))
-                                          (DIFFERENCE (fetch
 CH# of
 selection)
-                                                 (fetch
 CHAR1 of
 (CAR (fetch
 L1 of
 selection]
+                         bind
 [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
+                                                                      LCHAR1)
+                                                               (TEDIT.SELPROP selection 'CH#]
+                                                     (DIFFERENCE (TEDIT.SELPROP selection
+                                                                        'CH#)
+                                                            (GETLD (CAR (GETSEL selection L1))
+                                                                   LCHAR1]
                          join
 (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION
 (CAR string)
                                                   *TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH* 
                                                   hanging-indent)
@@ -231,18 +232,19 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
       else
 (\TEDIT-INDENT-SEPERATE-PARAGRAPHS
 string NIL])
 
 (TEDIT-INDENT-SET-INDENT

-  [LAMBDA (text-stream)
                                      (* smL "12-Sep-86 17:09")

-          
-          (* * Prompt the user for a new indentation string)

+  [LAMBDA (text-stream)
                                      (* ; "Edited 15-Feb-2025 09:21 by rmk")

+                                                             (* smL "12-Sep-86 17:09")

 
-    (LET* ((window (fetch
 \WINDOW of
 (TEXTOBJ text-stream)))
+(* ;;; "Prompt the user for a new indentation string")

+
+    (LET* ((window (\TEDIT.PRIMARYPANE text-stream))
            (pwindow (if
 window
                         then
 (GETPROMPTWINDOW (if
 (LISTP window)
                                                   then
 (CAR window)
                                                 else
 window))
                       else
 PROMPTWINDOW)))
           (CLEARW pwindow)
-          (SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL 
+          (SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
                                              pwindow NIL NIL (LIST (CHARCODE EOL])
 
 (TEDIT-INDENT-STRIP-INDENTATION

@@ -267,36 +269,34 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
                          else
 string])
 
 (TEDIT-MAKE-LINES-EXPLICIT

-  [LAMBDA (text-stream)
                                      (* smL " 8-Sep-86 18:20")

-          
-          (* * Take the current selection and replace all TEdit end-of-lines with 
-
          explicit line breaks. -
-
          This is intended to be used in Lafite, where it is sometimes nice to know that 
-
          anyone receiving the msg will see the same line breaks that you see.
-
          see, but can be used in any TEdit document)

+  [LAMBDA (text-stream)
                                      (* ; "Edited 15-Feb-2025 09:20 by rmk")

+                                                             (* smL " 8-Sep-86 18:20")

+
+(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks.  --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see.  see, but can be used in any TEdit document")

 
     (LET ((selection (TEDIT.GETSEL text-stream)))
-         [for
 i in
 (bind
 (this-line _ (CAR (fetch
 L1 of
 selection)))
-                         [last-line _ (CAR (LAST (fetch
 LN of
 selection]
-                      repeatuntil
 (PROGN (SETQ this-line (fetch
 NEXTLINE of
 this-line))
-                                         (EQ this-line last-line)) collect
 (fetch
 CHARLIM
-                                                                              of
 this-line))
-            do
 (TEDIT.SETSEL text-stream i 1 'LEFT T)
-               (TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
+         [for
 i in
 (bind
 (this-line _ (CAR (GETSEL selection L1)))
+                         [last-line _ (CAR (LAST (GETSEL selection LN]
+                      repeatuntil
 (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
+                                         (EQ this-line last-line)) collect
 (GETLD this-line LCHARLIM)
+                         ) do
 (TEDIT.SETSEL text-stream i 1 'LEFT T)
+                              (TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
          (TEDIT.SETSEL text-stream selection NIL 'RIGHT])
 
 (TEDIT-OPEN-LINE

-  [LAMBDA (text-stream)
                                      (* smL "17-Sep-86 11:13")

-          
-          (* * Open a new line at the current position.)

+  [LAMBDA (text-stream)
                                      (* ; "Edited 15-Feb-2025 14:09 by rmk")

+                                                             (* smL "17-Sep-86 11:13")

+
+(* ;;; "Open a new line at the current position.")

 
     (LET ((selection (TEDIT.GETSEL text-stream)))
-         (TEDIT.INSERT text-stream (CONCAT *eol-string*
-                                          (ALLOCSTRING [DIFFERENCE (fetch
 CH# of
 selection)
-                                                              (fetch
 CHAR1
-                                                                 of
 (CAR (fetch
 L1 of
 selection]
-                                                 " ")))
-         (if
 (ZEROP (fetch
 DCH of
 selection))
+         (TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
+                                                         (DIFFERENCE (TEDIT.SELPROP selection
+                                                                            'CH#)
+                                                                (GETLD (CAR (GETSEL selection L1))
+                                                                       LCHAR1))
+                                                         " ")))
+         (if
 (ZEROP (TEDIT.SELPROP selection 'LENGTH))
              then
 (TEDIT.SETSEL text-stream selection])
 
 (TEDIT-REMOVE-INDENT

@@ -393,21 +393,27 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
 
 (RPAQ *eol-string*
 (CHARACTER (CHARCODE EOL)))
 
+
 [CONSTANTS (*eol-string* (CHARACTER (CHARCODE EOL]
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS *TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*)
 )
+
 (OR (GETD 'TEDIT)
     (FILESLOAD TEDIT))
+
 (TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU 'Indent)
+
 [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Indent 'TEDIT-INDENT-SELECTION 
                                                "Indent the current selection"
                                                (SUBITEMS (Indent 'TEDIT-INDENT-SELECTION 
                                                                 "Indent the current selection")
-                                                      ("Indent & keep lines" '
-                                                            TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 
+                                                      ("Indent & keep lines" 
+                                                             '
+                                                            TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
+                                                             
                                          "Indent the current selection, keeping existing line breaks"
                                                              )
                                                       ("Set indent" 'TEDIT-INDENT-SET-INDENT 
@@ -418,21 +424,21 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
                                                       ("Open line" 'TEDIT-OPEN-LINE 
                                                           "Open a blank line at the current position"
                                                              )
-                                                      ("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT 
+                                                      ("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT
+                                                             
                              "Insert real <RETURN>s at the end of each line in the current selection"
                                                              )
-                                                      ("Break long lines" '
-                                                             TEDIT-INDENT-BREAK-LONG-LINES 
+                                                      ("Break long lines" 
+                                                             'TEDIT-INDENT-BREAK-LONG-LINES 
                                                   "Break long lines by inserting explicit <RETURN>'s"
                                                              ]
-(PUTPROPS LAFITE-INDENT COPYRIGHT ("Xerox Corporation" 1986 1987))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3949 23354 (TEDIT-INDENT-ADD-INDENTATION 3959 . 6527) (TEDIT-INDENT-BREAK-LINE 6529 . 
-8462) (TEDIT-INDENT-BREAK-LONG-LINES 8464 . 10231) (TEDIT-INDENT-FIND-BREAKPOINT 10233 . 11056) (
-TEDIT-INDENT-REPLACE-SELECTION 11058 . 11615) (TEDIT-INDENT-SELECTION 11617 . 13518) (
-TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13520 . 13799) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 13801 . 
-14530) (TEDIT-INDENT-SET-INDENT 14532 . 15306) (TEDIT-INDENT-STRIP-INDENTATION 15308 . 16528) (
-TEDIT-MAKE-LINES-EXPLICIT 16530 . 17735) (TEDIT-OPEN-LINE 17737 . 18493) (TEDIT-REMOVE-INDENT 18495 . 
-19265) (\TEDIT-INDENT-COUNT-SPACES 19267 . 19868) (\TEDIT-INDENT-FIND-PARAGRAPH-END 19870 . 20841) (
-\TEDIT-INDENT-SEPERATE-LINES 20843 . 21641) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21643 . 23352)))))
+  (FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 . 
+8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
+TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
+TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 . 
+15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
+TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 . 
+20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
+\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
 STOP

library/lafite/LAFITE-SEND

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2
 100561 
+
(FILECREATED "15-Feb-2025 13:05:38" {WMEDLEY}<library>lafite>LAFITE-SEND.;4
 100003 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LAFITE-SENDCOMS)
+      :CHANGES-TO (FNS \SENDMSG.CHANGE.MODE)
 
-      :PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
+      :PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2)
 
 
 (PRETTYCOMPRINT LAFITE-SENDCOMS)
@@ -222,14 +222,14 @@
     (ERROR!])
 
 (\SENDMSG.CHANGE.MODE

-  [LAMBDA (WINDOW TEXTSTREAM MENU ITEM)
                  (* ; "Edited  5-Jan-90 18:06 by bvm")

+  [LAMBDA (WINDOW TEXTSTREAM MENU ITEM)
                      (* ; "Edited 15-Feb-2025 13:05 by rmk")


+                                                             (* ; "Edited  5-Jan-90 18:06 by bvm")

     (LET*
      [(OLDMODE (TEXTPROP TEXTSTREAM 'LAFITEMODE))
-      (OTHERMODES (for
 MODE in
 LAFITEMODELST unless
 (OR (EQ (fetch
 (LAFITEOPS 
-                                                                                          LAFITEMODE)
-                                                                           of
 MODE)
-                                                                        OLDMODE)
-                                                                    (NLISTP (CDR MODE)))
+      (OTHERMODES (for
 MODE in
 LAFITEMODELST unless
 (OR (EQ (fetch
 (LAFITEOPS LAFITEMODE)
+                                                               of
 MODE)
+                                                            OLDMODE)
+                                                        (NLISTP (CDR MODE)))
                      collect
 (fetch
 (LAFITEOPS LAFITEMODE) of
 MODE)))
       (NEWMODE (if
 (NULL OTHERMODES)
                    then
 (\SENDMESSAGE.PROMPT
 WINDOW "There are no other modes")
@@ -244,58 +244,51 @@
                 N N2)
                (if
 (NULL NEWMODEDATA)
                    then
 (\SENDMESSAGE.PROMPT
 WINDOW (CL:FORMAT NIL 
-                                                                 "Can't authenticate user in ~A mode"
-                                                                   NEWMODE))
-                 else
 (LET ((OLDNAME (fetch
 (LAFITEMODEDATA FULLUSERNAME) of
 OLDMODEDATA)
-                                       )
-                                (END (TEDIT.FIND TEXTSTREAM "
+                                                           "Can't authenticate user in ~A mode" 
+                                                           NEWMODE))
+                 else
 (LET ((OLDNAME (fetch
 (LAFITEMODEDATA FULLUSERNAME) of
 OLDMODEDATA))
+                            (END (TEDIT.FIND TEXTSTREAM "
 
 " 1))
-                                START N LEN NEW OLDSEL)
-                               (if
 END
-                                   then
 (add
 END 1)) (* ; 
-
                                   "Don't search past end of header.  END now points at second cr.")

-                               [for
 FIELD in
 '("cc" "Reply-to")
-                                  when
 [AND (SETQ N (\SENDMSG.FIND.FIELD
 TEXTSTREAM FIELD END
-                                                               ))
-                                                (PROGN (SETQ LEN (CADR N))
-                                                       (SETQ N (CAR N))
-                                                       (SETQ START
-                                                        (STRPOS OLDNAME
-                                                               (SETQ OLDSEL
-                                                                (TEDIT.SEL.AS.STRING TEXTSTREAM
-                                                                       (create
 SELECTION
-                                                                              CH# _ N
-                                                                              DCH _ LEN)))
-                                                               NIL NIL NIL NIL UPPERCASEARRAY]
-                                  do
                     (* ; "Change field containing old user name to new.  This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")

-                                        (TEDIT.DELETE TEXTSTREAM N LEN)
-                                        (TEDIT.INSERT TEXTSTREAM
-                                               (SETQ NEW (CONCAT (OR (SUBSTRING OLDSEL 1 (SUB1 START)
-                                                                            )
-                                                                     "")
-                                                                (fetch
 (LAFITEMODEDATA 
-                                                                                  FULLUSERNAME)
-                                                                   of
 NEWMODEDATA)
-                                                                (OR (SUBSTRING OLDSEL
-                                                                           (+ START (NCHARS OLDNAME))
-                                                                           )
-                                                                    "")))
-                                               N)
-                                        (AND END (add
 END (- (NCHARS NEW)
-                                                                 LEN]
-                               (if
 (SETQ N (\SENDMSG.FIND.FIELD
 TEXTSTREAM "To" END))
-                                   then
                  (* ; 
-
                                             "Leave the To field selected for address modification")

-                                         (TEDIT.SETSEL TEXTSTREAM (CAR N)
-                                                (CADR N)
-                                                'RIGHT T))
-                               (TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
-                               (if
 (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
-                                                      TITLE))
-                                   then
 (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
-                                                                             NEWMODE ")")))
-                               (\SENDMESSAGE.PROMPT
 WINDOW "Message mode is now " NEWMODE]
+                            START N LEN NEW OLDSEL)
+                           (if
 END
+                               then
 (add
 END 1))             (* ; 
+
                                     "Don't search past end of header.  END now points at second cr.")

+                           [for
 FIELD in
 '("cc" "Reply-to")
+                              when
 [AND (SETQ N (\SENDMSG.FIND.FIELD
 TEXTSTREAM FIELD END))
+                                        (PROGN (SETQ LEN (CADR N))
+                                               (SETQ N (CAR N))
+                                               (SETQ START (STRPOS OLDNAME (SETQ OLDSEL
+                                                                            (TEDIT.SEL.AS.STRING
+                                                                             TEXTSTREAM N LEN))
+                                                                  NIL NIL NIL NIL UPPERCASEARRAY]
+                              do
                             (* ; "Change field containing old user name to new.  This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")

+                                 (TEDIT.DELETE TEXTSTREAM N LEN)
+                                 (TEDIT.INSERT TEXTSTREAM (SETQ NEW
+                                                           (CONCAT (OR (SUBSTRING OLDSEL 1
+                                                                              (SUB1 START))
+                                                                       "")
+                                                                  (fetch
 (LAFITEMODEDATA FULLUSERNAME
+                                                                                ) of
 NEWMODEDATA)
+                                                                  (OR (SUBSTRING OLDSEL
+                                                                             (+ START (NCHARS OLDNAME
+                                                                                             )))
+                                                                      "")))
+                                        N)
+                                 (AND END (add
 END (- (NCHARS NEW)
+                                                      LEN]
+                           (if
 (SETQ N (\SENDMSG.FIND.FIELD
 TEXTSTREAM "To" END))
+                               then
                          (* ; 
+
                                               "Leave the To field selected for address modification")

+                                    (TEDIT.SETSEL TEXTSTREAM (CAR N)
+                                           (CADR N)
+                                           'RIGHT T))
+                           (TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
+                           (if
 (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
+                                              TITLE))
+                               then
 (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
+                                                                     NEWMODE ")")))
+                           (\SENDMESSAGE.PROMPT
 WINDOW "Message mode is now " NEWMODE]
 
      (* ;; "Exit with error so that the window is restored to previous state")

 
@@ -1761,29 +1754,29 @@ cc: ~A
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) (
-\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) (
-\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 . 
-12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE 
-18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) (
-\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) (
-\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 . 
-28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) (
-\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU 
-41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) (
-\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 . 
-47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508
- . 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799 
-(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) (
-\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) (
-\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797)) 
-(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) (
-MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 . 
-72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) (
-\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) (
-\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE 
-78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) (
-MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 . 
-87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) (
-MAKEFORWARDFORM 89694 . 93477)))))
+  (FILEMAP (NIL (5218 27633 (DOLAFITESENDINGCOMMAND 5228 . 5718) (\SENDMESSAGE.INITIATE 5720 . 7659) (
+\SENDMSG.DELIVER 7661 . 8269) (\SENDMSG.EXIT.TEDIT 8271 . 8642) (\SENDMSG.SAVE.FORM 8644 . 10631) (
+\LAFITE.HEADER.EOF 10633 . 10926) (\LAFITE.INSERT.REPLYTO 10928 . 11536) (\SENDMSG.REPLYTO 11538 . 
+12097) (\SENDMSG.CHANGE.MODE 12099 . 17113) (\SENDMSG.FIND.FIELD 17115 . 17625) (\SENDMESSAGE.PARSE 
+17627 . 18423) (\LAFITE.PREPARE.SEND 18425 . 21258) (\LAFITE.PREPARE.ERROR 21260 . 22442) (
+\LAFITE.CHOOSE.MSG.FORMAT 22444 . 25085) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25087 . 26012) (
+\SENDMESSAGE.MENUPROMPT 26014 . 26877) (\SENDMESSAGE.PROMPT 26879 . 27415) (\SENDMESSAGEFAIL 27417 . 
+27631)) (27634 52296 (\SENDMESSAGE 27644 . 28996) (\SENDMESSAGE.RESTARTABLE 28998 . 34199) (
+\SENDMESSAGE.CLEANUP 34201 . 34417) (\SENDMESSAGE.MAKEWINDOW 34419 . 40592) (MAKELAFITEDELIVERMENU 
+40594 . 40901) (\LAFITE.CLOSEMSG? 40903 . 41853) (\LAFITE.AFTER.DELIVER 41855 . 45174) (
+\LAFITE.UNSENT.ICON 45176 . 45486) (\LAFITE.FETCH.SUBJECT 45488 . 46288) (LAFITE.SENDMESSAGE 46290 . 
+47183) (\SENDMESSAGE0 47185 . 50049) (LA.ASSURE.PROMPT.WINDOW 50051 . 50948) (\LAFITE.SEND.FAIL 50950
+ . 51421) (\LAFITE.INVALID.RECIPIENTS 51423 . 51881) (\SENDMESSAGE.ABORT 51883 . 52294)) (52328 62241 
+(\OUTBOX.CREATE 52338 . 53801) (\OUTBOX.RESET 53803 . 54296) (\OUTBOX.CLOSEFN 54298 . 54438) (
+\OUTBOX.REPAINTFN 54440 . 55103) (\OUTBOX.RESHAPEFN 55105 . 56388) (\OUTBOX.SHADEITEM 56390 . 57063) (
+\OUTBOX.BUTTONFN 57065 . 59913) (\OUTBOX.DISPLAYLINE 59915 . 60409) (\OUTBOX.ADD.ITEM 60411 . 62239)) 
+(62537 78945 (\LAFITE.MESSAGEFORM 62547 . 66890) (MAKELAFITESUPPORTFORM 66892 . 67081) (
+MAKELISPSUPPORTFORM 67083 . 67249) (MAKEXXXSUPPORTFORM 67251 . 71300) (MAKENEWMESSAGEFORM 71302 . 
+72258) (MAKELAFITEPRIVATEFORMSITEMS 72260 . 72688) (\LAFITE.UNCACHE.MESSAGEFORM 72690 . 73143) (
+\LAFITE.DELETE.MESSAGEFORM 73145 . 73746) (\LAFITE.SELECT.FORM 73748 . 74103) (
+\LAFITE.DELETE.FORM.INTERNAL 74105 . 75249) (\LAFITE.READ.FORM 75251 . 77988) (\LAFITE.FIND.TEMPLATE 
+77990 . 78943)) (78969 86700 (\LAFITE.ANSWER 78979 . 79384) (\LAFITE.ANSWER.PROC 79386 . 81280) (
+MAKEANSWERFORM 81282 . 83812) (LA.PRINT.COMMA.LIST 83814 . 84300) (LAFITE.FILL.IN.ANSWER.FORM 84302 . 
+86698)) (86725 92921 (\LAFITE.FORWARD 86735 . 87143) (\LAFITE.FORWARD.PROC 87145 . 89134) (
+MAKEFORWARDFORM 89136 . 92919)))))
 STOP

library/lafite/LAFITE-TEDIT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2
 6592   
+
(FILECREATED "15-Feb-2025 14:03:21" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;4
 6618   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LAFITE-TEDITCOMS)
+      :CHANGES-TO (FNS TEDIT.ASSURE.NO.BACKING.FILE)
 
-      :PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
+      :PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2)
 
 
 (PRETTYCOMPRINT LAFITE-TEDITCOMS)
@@ -74,7 +74,8 @@
     (TEXTPROP TEXTSTREAM '\WINDOW NIL])
 
 (TEDIT.ASSURE.NO.BACKING.FILE

-  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited 13-Jan-2024 18:08 by rmk")


+  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited 15-Feb-2025 14:03 by rmk")


+                                                             (* ; "Edited 13-Jan-2024 18:08 by rmk")


                                                              (* ; "Edited 18-Jun-2023 09:31 by rmk")


                                                              (* ; "Edited 29-Oct-2022 22:34 by rmk")


                                                              (* ; "Edited 20-May-92 11:25 by rmk:")

@@ -82,18 +83,17 @@
     (* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session.  Essentially eliminates the file-system backing store.")

 
     (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
-           (OFILE (GETTOBJ TEXTOBJ TXTFILE))
+           (OFILE (GETTEXTPROP TEXTSTREAM 'FILESTREAM))
            NEWFILE)
-          (CL:WHEN [AND (TYPE?
 STREAM OFILE)
-                        (NEQ 'NODIRCORE (FETCH
 (FDEV DEVICENAME) OF
 (FETCH
 (STREAM DEVICE)
-                                                                       OF
 (TRUEFILENAME OFILE]
+          (CL:WHEN [AND OFILE (NEQ 'NODIRCORE (FILENAMEFIELD (TRUEFILENAME OFILE)
+                                                     'HOST]
               (SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
 
               (* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE.  But the file PCONTENTS do not yet point to the new stream.  ")

 
               (CLOSEF? OFILE)
               (\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T))
-              (FSETTOBJ TEXTOBJ TXTFILE NIL)
+              (PUTTEXTPROP TEXTOBJ 'TXTFILE NIL)
               (PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE)
               TEXTSTREAM)])
 
@@ -118,6 +118,6 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) (
-TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359)))))
+  (FILEMAP (NIL (998 6387 (LA.ADJUST.FORMATTING 1008 . 4054) (LA.DETACH.TEDIT 4056 . 4422) (
+TEDIT.ASSURE.NO.BACKING.FILE 4424 . 6105) (LA.WINDOW.FROM.TEXTSTREAM 6107 . 6385)))))
 STOP

library/tedit/TEDIT-ABBREV

@@ -1,20 +1,18 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Mar-2024 18:15:40" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8
 9500   
+
(FILECREATED "28-Mar-2025 10:13:36" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;21
 15982  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
+      :CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
 
-      :PREVIOUS-DATE "17-Mar-2024 12:06:12" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7)
+      :PREVIOUS-DATE "23-Mar-2025 17:09:00" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;20)
 
 
 (PRETTYCOMPRINT TEDIT-ABBREVCOMS)
 
 (RPAQQ TEDIT-ABBREVCOMS

-       [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
+       [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
         (GLOBALVARS TEDIT.ABBREVS)
         (INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
                                    ("n" . "357,44")
@@ -65,36 +63,147 @@
 (DEFINEQ
 
 (\TEDIT.ABBREV.EXPAND

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 17-Mar-2024 12:06 by rmk")


-                                                             (* ; "Edited 17-May-2023 13:31 by rmk")


-                                                             (* ; "Edited  8-Sep-2022 23:53 by rmk")


-                                                             (* ; "Edited  1-Aug-2022 12:04 by rmk")


+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 20-Mar-2025 21:52 by rmk")


                                                              (* ; "Edited 30-May-91 19:27 by jds")

                                                              (* ; "Expand an abbvreviation")

-    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM))
-           SEL CH# CH OLDLOOKS EXPANSION)
-          (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-          (SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL)))
-          [COND
-             ((ZEROP (GETSEL SEL DCH))                       (* ; 
-
                                                  "Point Selection, so use the character to the left")

-              (CL:WHEN (ZEROP CH#)                           (* ; 
-
                                       "If we're off the front of the document, don't bother trying.")

-                  (RETURN))
-              (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)
-                     CH#)
-              [SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM]
-              (TEDIT.SETSEL TSTREAM CH# 1 'RIGHT))
-             (T                                              (* ; 
-
                                              "We have a selection that isn't just a caret.  Use it.")

-                (SETQ CH (TEDIT.SEL.AS.STRING TSTREAM]
-          (SETQ EXPANSION (\TEDIT.TRY.ABBREV
 CH TSTREAM))    (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")

-          (CL:WHEN EXPANSION                                 (* ; 
-
                                                "It exists, so insert it where the abbrev used to be")

-              (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
-              (TEDIT.DELETE TEXTOBJ SEL)                     (* ; 
-
                                                            "First, delete the thing being expanded.")

-              (TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))])
+    (LET ((CANDIDATES (\TEDIT.ABBREV.PARSE
 TSTREAM SEL))
+          CAND EXPANSION)
+
+         (* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.")

+
+         (* ;; "Try literal match first, then fiddle the case.")

+
+         (* ;; "If we don't find it in abbrevs, try for a character code.")

+
+         [SETQ CAND (OR (find
 C in
 CANDIDATES suchthat
 (SETQ EXPANSION (\TEDIT.TRY.ABBREV

+                                                                        (CAR C)
+                                                                        TSTREAM)))
+                        (for
 C in
 CANDIDATES suchthat
 (SETQ EXPANSION (\TEDIT.TRY.ABBREV

+                                                                       (U-CASE (CAR C))
+                                                                       TSTREAM)))
+                        (for
 C in
 CANDIDATES suchthat
 (SETQ EXPANSION (\TEDIT.TRY.ABBREV

+                                                                       (L-CASE (CAR C))
+                                                                       TSTREAM]
+         (if
 EXPANSION
+             then
 (\TEDIT.UPDATE.SEL SEL (CADR CAND)
+                         (CADDR CAND)
+                         'RIGHT
+                         'NORMAL)                            (* ; "Set the target")

+                  (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
+                                                   (PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
+                                                                      TEXTOBJ)))
+                         TEXTOBJ SEL)
+           else
 (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
+
+(\TEDIT.ABBREV.PARSE

+  [LAMBDA (TSTREAM SEL)
                                      (* ; "Edited 28-Mar-2025 10:11 by rmk")


+                                                             (* ; "Edited 23-Mar-2025 17:08 by rmk")


+                                                             (* ; "Edited 20-Mar-2025 22:21 by rmk")

+
+    (* ;; "This produces candidate abbreviation-strings by parsing the characters around the point.  Each candidate is returned as a list (KEY STARTCH# LEN).")

+
+    (* ;; 
+
    "It first backs up  over any spaces to find the anchor position.  The candidates then include")

+
+    (* ;; "     The immediately preceding singleton character, if a point selection")

+
+    (* ;; "     The remaining (after backing up) characters of the selection.")

+
+    (* ;; "     The word that contains the caret (backwards and forwards)")

+
+    (* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \)  is extracted, and W,C is is added to the list (a possible charname).")

+
+    (* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)")

+
+    (* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.")

+
+    (* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.")

+
+    (PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
+           FIRST# LAST# LEN CANDIDATES KEY NSPACES)
+
+     (* ;; "The abbreviation is taken from the CH# of the current selection.  It is either the character just before a point selection, the entire selection, or the word containing the selection.")

+
+     (* ;; "    The character at CH#, if it is a point selection")

+
+     (* ;; "     Otherwise either the current selection up to and including CH# or the full word that includes the selection.  What works is determined by what it finds in the abbreviations list.")

+
+     (* ;; "Back up over spaces")

+
+          (SETQ NSPACES (for
 I from
 PT# by
 -1 while
 (EQ (CHARCODE SPACE)
+                                                        (\TEDIT.NTHCHARCODE TSTREAM I)) sum
 1))
+          (add
 PT# (IMINUS NSPACES))
+          (CL:WHEN (ZEROP PT#)                               (* ; "Beginning of document")

+              (RETURN))
+
+     (* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..")

+
+          (push
 CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#))
+                                 PT# 1))
+          (SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH)
+                                   NSPACES)))                (* ; "Last singleton predecessor")

+          (CL:WHEN (IGEQ LEN 2)                              (* ; "At least one more character")

+              (push
 CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#)
+                                            LEN)
+                                     (FGETSEL SEL CH#)
+                                     LEN)))
+          (SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#))
+          (SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#)))
+          (CL:UNLESS (EQ LEN 1)                              (* ; "Already there")

+              (push
 CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
+                                     FIRST# LEN)))
+          (SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#))
+          (SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#)))
+          (CL:UNLESS (EQ LEN 1)                              (* ; "Already there")

+              (push
 CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
+                                     FIRST# LEN)))           (* ; "Extend if a ,")

+          [for
 C KEY END in
 CANDIDATES
+             do
 
+                (* ;; "Comma for XCCS character names, - and / - for internal punctuation (3/4 EM-DASH). Adjacent character must be text")

+
+                (if
 [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
+                               (CHARCODE (%, / -
)))
+                         (EQ (\TEDIT.TTC TEXT)
+                             (TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C)
+                                                                               2]
+                    then
 (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C)
+                                                                     2))) 
+                                                             (* ; "Comma before, maybe a charname")

+                         (SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C)
+                                                                                   END))
+                                          (CAR C)))
+                         (push
 CANDIDATES (LIST KEY END (NCHARS KEY)))
+                  elseif
 [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C)
+                                                                       (CADDR C)))
+                                    (CHARCODE (%, / -
)))
+                              (EQ (\TEDIT.TTC TEXT)
+                                  (TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C)
+                                                                                    (CADDR C]
+                    then
 [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C)
+                                                                          (CADDR C] 
+                                                             (* ; "Comma after")

+                         [SETQ KEY (CONCAT (CAR C)
+                                          (TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C)
+                                                                              (CADDR C))
+                                                 (ADD1 (IDIFFERENCE END (IPLUS (CADR C)
+                                                                               (CADDR C]
+                         (push
 CANDIDATES (LIST KEY (CADR C)
+                                                (NCHARS KEY] (* ; 
+
           "If preceded by \, include it optionally in the key, always include it in the replacement")

+          (for
 C in
 CANDIDATES when
 [EQ (CHARCODE \)
+                                        (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C]
+             do
                                              (* ; "Match and replace \KEY")

+                [push
 CANDIDATES (LIST (CONCAT "\" (CAR C))
+                                       (SUB1 (CADR C))
+                                       (ADD1 (CADDR C]
+                (change
 (CADR C)
+                       (SUB1 DATUM))                         (* ; "Match KEY but also replace the \")

+                (change
 (CADDR C)
+                       (ADD1 DATUM)))
+          [SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2)
+                                       (IGEQ (CADDR C1)
+                                             (CADDR C2]      (* ; "Look for longest first")

+          (RETURN CANDIDATES])
 
 (\TEDIT.EXPAND.DATE

   [LAMBDA (STREAM CH)
                                        (* ; "Edited 23-Feb-88 10:41 by jds")

@@ -111,47 +220,38 @@
                           " " DAY ", " YEAR])
 
 (\TEDIT.TRY.ABBREV

-  [LAMBDA (ABBREV STREAM)
                                   (* ; "Edited  6-Aug-2020 14:41 by rmk:")

+  [LAMBDA (KEY TSTREAM)
                                      (* ; "Edited 20-Mar-2025 21:52 by rmk")


+                                                            (* ; "Edited  6-Aug-2020 14:41 by rmk:")

                                                              (* jds "11-Jul-85 12:46")

 
-    (* ;; 
-
    "Try expanding ABBREV as an abbreviation.  Return the expansion;  NIL = no such abbreviation.")

+    (* ;; "Decode the expansion. A string may be a character name, otherwise itself.  A litatom is a function to be applied, anything else is evaled. ")

 
-    (* ;; "RMK:  Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.")

+    (LET ((ABBREV (SASSOC KEY TEDIT.ABBREVS)))
+         (if
 (NULL ABBREV)
+             then
 (CL:WHEN (CHARCODE.DECODE KEY T)
+                      (CHARACTER (CHARCODE.DECODE KEY T)))
+           elseif
 (STRINGP (CDR ABBREV))
+             then
 
+                  (* ;; "Could be a character code")

 
-    (PROG (SEL CH# (CH NIL)
-               EXPANSION)
-          (SETQ EXPANSION (OR (SASSOC ABBREV TEDIT.ABBREVS)
-                              (SASSOC (U-CASE ABBREV)
-                                     TEDIT.ABBREVS)))
+                  (LET ((CH (CHARCODE.DECODE (CDR ABBREV)
+                                   T)))
+                       (CL:IF CH
+                           (CHARACTER CH)
+                           (CDR ABBREV)))
+           elseif
 (SMALLP (CDR ABBREV))
+             then
 
+                  (* ;; "Treat a number as a character code.")

 
-         (* Find the abbreviation's expansion --first try it as-is, then try the 
-
         upper-case version to be safe.)

-
-          (RETURN (COND
-                     (EXPANSION                              (* There's an expansion.
-
                                                             Turn it into an insertable string.)

-                            (COND
-                               [(STRINGP (CDR EXPANSION))
-
-                                (* ;; "Could be a character code")

-
-                                (COND
-                                   ((SETQ CH (CHARCODE.DECODE (CDR EXPANSION)
-                                                    T))
-                                    (CHARACTER CH))
-                                   (T (CDR EXPANSION]
-                               ((SMALLP (CDR EXPANSION))
-
-                                (* ;; "Treat a number as a character code.")

-
-                                (CHARACTER (CDR EXPANSION)))
-                               ((AND (LITATOM (CDR EXPANSION))
-                                     (GETD (CDR EXPANSION))) (* It's a function to be called.)

-                                (APPLY* (CDR EXPANSION)
-                                       STREAM CH))
-                               (T                            (* Anything else is a form to EVAL.)

-                                  (EVAL (CDR EXPANSION])
+                  (CHARACTER (CDR ABBREV))
+           elseif
 (AND (LITATOM (CDR ABBREV))
+                       (GETD (CDR ABBREV)))
+             then
                                            (* ; "It's a function to be called.")

+                  (APPLY* (CDR ABBREV)
+                         TSTREAM
+                         (CAR ABBREV))
+           else
                                              (* ; "Anything else is a form to EVAL.")

+                (EVAL (CDR ABBREV])
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -206,6 +306,6 @@
          ("DATE" . \TEDIT.EXPAND.DATE)
          (">>DATE<<" . \TEDIT.EXPAND.DATE)))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
-\TEDIT.TRY.ABBREV 6008 . 8154)))))
+  (FILEMAP (NIL (2933 14638 (\TEDIT.ABBREV.EXPAND 2943 . 5054) (\TEDIT.ABBREV.PARSE 5056 . 12340) (
+\TEDIT.EXPAND.DATE 12342 . 12975) (\TEDIT.TRY.ABBREV 12977 . 14636)))))
 STOP

library/tedit/TEDIT-CHAT

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14
 12223  
+
(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17
 12449  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-CHATCOMS)
-                  (FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN)
+      :CHANGES-TO (FNS TEDITCHAT.CHARFN)
 
-      :PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}<library>tedit>TEDIT-CHAT.;9)
+      :PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16)
 
 
 (PRETTYCOMPRINT TEDIT-CHATCOMS)
@@ -71,16 +70,19 @@
           (replace
 (CHAT.STATE HELD) of
 STATE with
 NIL])
 
 (TEDITCHAT.CHARFN

-  [LAMBDA (CH CHAT.STATE)
                                    (* ; "Edited 22-Dec-2023 23:57 by rmk")


+  [LAMBDA (CH CHAT.STATE)
                                    (* ; "Edited 11-Mar-2025 15:40 by rmk")


+                                                             (* ; "Edited 24-Jun-2024 00:04 by rmk")


+                                                             (* ; "Edited  2-May-2024 18:09 by rmk")


+                                                             (* ; "Edited 22-Dec-2023 23:57 by rmk")


                                                              (* ; "Edited 18-Mar-2023 20:08 by rmk")


                                                             (* ; "Edited 12-Jun-90 18:00 by mitani")

-    (LET [(TEXTOBJ (TEXTOBJ (fetch
 (CHAT.STATE TEXTSTREAM) of
 CHAT.STATE]
-         (\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
-         (SELCHARQ CH
-              (BS (\TEDIT.CHARDELETE TEXTOBJ (FGETTOBJ TEXTOBJ SEL)))
-              (LF NIL)
-              (BOUT (FGETTOBJ TEXTOBJ STREAMHINT)
-                    CH])
+    (LET* ((TSTREAM (fetch
 (CHAT.STATE TEXTSTREAM) of
 CHAT.STATE))
+           (TEXTOBJ (TEXTOBJ TSTREAM)))
+          (\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
+          (SELCHARQ CH
+               (BS (\TEDIT.CHARDELETE TSTREAM))
+               (LF NIL)
+               (BOUT TSTREAM CH])
 )
 
 
@@ -212,6 +214,6 @@
        CHATDECLS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN
- 3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333)))))
+  (FILEMAP (NIL (886 4630 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
+ 3663 . 4628)) (4677 11561 (TEDIT.DISPLAYTEXT 4687 . 11559)))))
 STOP

library/tedit/TEDIT-HCPY

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Apr-2024 09:12:32" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;153
 33754  
+
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170
 33842  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
+      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS 
+                       \TEDIT.HCPYFMTSPEC)
 
-      :PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;152)
+      :PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
 
 
 (PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -87,9 +88,11 @@
                  "Can't HARDCOPY:  No print server specified." T])
 
 (\TEDIT.PRINT.MENU

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 25-Jun-2023 13:16 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 28-Jun-2024 22:09 by rmk")


+                                                             (* ; "Edited 25-Jun-2023 13:16 by rmk")


                                                              (* ; "Edited  6-Jun-2023 17:48 by rmk")

-    (LET [(W (CAR (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TSTREAM]
+    (LET ((W (GETTOBJ (TEXTOBJ TSTREAM)
+                    PRIMARYPANE)))
          (SELECTQ [MENU (create
 MENU
                                ITEMS _ '(("Print to a file" 'FILE 
                                               "Puts image on a file; prompts for filename and format"
@@ -101,7 +104,8 @@
              NIL])
 
 (TEDIT.HCPYFILE

-  [LAMBDA (TSTREAM FILE BREAKPAGETITLE)
                      (* ; "Edited  4-Oct-2022 09:23 by rmk")


+  [LAMBDA (TSTREAM FILE BREAKPAGETITLE)
                      (* ; "Edited 29-Jun-2024 16:33 by rmk")


+                                                             (* ; "Edited  4-Oct-2022 09:23 by rmk")


                                                              (* ; "Edited  1-Oct-2022 22:12 by rmk")


                                                             (* ; "Edited 12-Jun-90 18:36 by mitani")

 
@@ -125,10 +129,16 @@
                                                                'HCPY)
                                                            'BODY
                                                            (fetch
 (STREAM FULLFILENAME) of
 TXTFILE]
-                (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
+             (if
 FILENM
+                 then
 (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
+               else
 (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
 
 (\TEDIT.HARDCOPY.DISPLAYLINE

-  [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE)
     (* ; "Edited 19-Apr-2024 09:09 by rmk")


+  [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE)
     (* ; "Edited 19-Feb-2025 13:34 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 23:39 by rmk")


+                                                             (* ; "Edited 13-Dec-2024 23:49 by rmk")


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


+                                                             (* ; "Edited 19-Apr-2024 09:09 by rmk")


                                                              (* ; "Edited 20-Mar-2024 11:04 by rmk")


                                                              (* ; "Edited 15-Mar-2024 19:23 by rmk")


                                                              (* ; "Edited 24-Dec-2023 22:07 by rmk")


@@ -151,16 +161,16 @@
                       (FGETTOBJ TEXTOBJ TEXTLEN))
         [LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
              (CL:UNLESS (EQ LINE (fetch
 DESC of
 THISLINE))
-                 (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
+                 (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
+                        (FGETLD LINE LCHAR1)
                         LINE REGION PRSTREAM FORMATTINGSTATE))
 
              (* ;; "Use the characters cached in THISLINE.")

 
-             (for
 CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch
 (THISLINE
-                                                                                          
+             (for
 CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch
 (THISLINE 
                                                                                         TLSPACEFACTOR
-                                                                                          )
-                                                                                     of
 THISLINE))
+                                                                                           )
+                                                                                of
 THISLINE))
                   (FIRST-SCALEDSPACE-SLOT _ (ffetch
 (THISLINE TLFIRSTSPACE) of
 THISLINE))
                   (SCALE _ (DSPSCALE NIL PRSTREAM))
                   (TX _ (FGETLD LINE LX1)) incharslots
 THISLINE first
 (DSPSPACEFACTOR 1 PRSTREAM)
@@ -225,11 +235,7 @@
                                                                                          )
                                                                               of
 CLOOKS]
                                                     (T (FGETLD LINE YBASE]
-                                      (DSPYPOSITION CURY PRSTREAM)
-                                      (CL:WHEN (SETQ KERN (LISTGET (fetch
 (CHARLOOKS CLUSERINFO)
-                                                                      of
 CLOOKS)
-                                                                 'KERN))
-                                          (SETQ KERN (HCSCALE SCALE KERN))) 
+                                      (DSPYPOSITION CURY PRSTREAM) 
 
                                       (* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")

 
@@ -253,6 +259,8 @@
 
                                         (SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC
 CHARSLOT THISLINE 
                                                            PRSTREAM))
+                                 elseif
 (EQ 'KERN CHAR)
+                                   then
 (RELMOVETO 0 CHARW PRSTREAM)
                                  else
 (\OUTCHAR PRSTREAM CHAR))
                                (add
 TX CHARW))) finally
 
 
@@ -262,36 +270,39 @@
                                                           (\TEDIT.HARDCOPY.MODIFYLOOKS
 LINE 
                                                                  LOOKSTARTX TX (FGETLD LINE YBASE)
                                                                  CLOOKS PRSTREAM))
-                                                      (CL:WHEN (fetch
 (FMTSPEC FMTREVISED)
-                                                                  of
 (FGETLD LINE LFMTSPEC))
+                                                      (CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
+                                                                      FMTREVISED)
                                                              (* ; 
 
                                                       "This paragraph has been revised, so mark it.")

                                                           (\TEDIT.MARK.REVISION TEXTOBJ
-                                                                 (FGETLD LINE LFMTSPEC)
+                                                                 (FGETLD LINE LPARALOOKS)
                                                                  PRSTREAM LINE))])])
 
 (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS

-  [LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)

+  [LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)

+                                                             (* ; "Edited 19-Feb-2025 13:34 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 21:13 by rmk")


+                                                             (* ; "Edited 26-Oct-2024 11:04 by rmk")


                                                              (* ; "Edited 17-Mar-2024 17:22 by rmk")


                                                              (* ; "Edited 19-Jan-2024 23:19 by rmk")


                                                              (* ; "Edited  3-Oct-2022 13:05 by rmk")

 
     (* ;; "Return setup LINE to skip a sequence of heading pieces STATE")

 
-    (SELECTQ (fetch
 (FMTSPEC FMTPARATYPE) of
 FMTSPEC)
+    (SELECTQ (GETPLOOKS PARALOOKS FMTPARATYPE)
         (PAGEHEADING 
                      (* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")

 
-                     (\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM 
+                     (\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM 
                             FORMATTINGSTATE)
                      T)
         (EVEN                                                (* ; "Skip an odd page.")

               (CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
-                  (TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
+                  (\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
                   T))
         (ODD                                                 (* ; "Skip an even page")

              (CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
-                 (TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
+                 (\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
                  T))
         NIL])
 
@@ -337,53 +348,44 @@
     (MOVETO CURX CURY PRSTREAM])
 
 (\TEDIT.HCPYFMTSPEC

-  [LAMBDA (SPEC IMAGESTREAM)
                                 (* ; "Edited 15-Mar-2024 19:34 by rmk")


+  [LAMBDA (DISPLAYFMT IMAGESTREAM)
                           (* ; "Edited 19-Feb-2025 13:34 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 22:36 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 22:25 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 19:34 by rmk")


                                                              (* ; "Edited  7-Mar-2023 21:03 by rmk")


                                                              (* ; "Edited  6-Mar-2023 15:14 by rmk")


                                                              (* ; "Edited 20-Oct-2022 22:35 by rmk")


                                                              (* ; "Edited 29-Sep-2022 23:32 by rmk")


                                                              (* ; "Edited 30-May-91 21:18 by jds")

 
-    (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent.  (Special positions are made paper-relative first.).  ")

+    (* ;; "Given a display-type PARALOOKS, create a hardcopy equivalent.  (Special positions are made paper-relative first.).  ")

 
-    (LET ((SCALE (DSPSCALE NIL IMAGESTREAM))
-          FMTSPEC)
-         [SETQ FMTSPEC (create
 FMTSPEC using
 SPEC FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
-                                             (HCSCALE SCALE (fetch
 (FMTSPEC 1STLEFTMAR) of
 SPEC))
-                                             LEFTMAR _ (HCSCALE SCALE (fetch
 (FMTSPEC LEFTMAR)
-                                                                         of
 SPEC))
-                                             RIGHTMAR _ (HCSCALE SCALE (fetch
 (FMTSPEC RIGHTMAR)
-                                                                          of
 SPEC))
-                                             QUAD _ (fetch
 (FMTSPEC QUAD) of
 SPEC)
-                                             TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE)
-                                             FMTSPECIALX _ (AND (fetch
 (FMTSPEC FMTSPECIALX)
-                                                                   of
 SPEC)
-                                                                (HCSCALE SCALE
-                                                                       (SCALEPAGEUNITS
-                                                                        (fetch
 (FMTSPEC FMTSPECIALX)
-                                                                           of
 SPEC)
-                                                                        1.0 NIL)))
-                                             FMTSPECIALY _ (AND (fetch
 (FMTSPEC FMTSPECIALY)
-                                                                   of
 SPEC)
-                                                                (HCSCALE SCALE
-                                                                       (SCALEPAGEUNITS
-                                                                        (fetch
 (FMTSPEC FMTSPECIALY)
-                                                                           of
 SPEC)
-                                                                        1.0 NIL)))
-                                             LEADBEFORE _ (HCSCALE SCALE (fetch
 (FMTSPEC LEADBEFORE)
-                                                                            of
 SPEC))
-                                             LEADAFTER _ (HCSCALE SCALE (fetch
 (FMTSPEC LEADAFTER)
-                                                                           of
 SPEC))
-                                             LINELEAD _ (HCSCALE SCALE (fetch
 (FMTSPEC LINELEAD)
-                                                                          of
 SPEC))
-                                             FMTBASETOBASE _ (AND (fetch
 (FMTSPEC FMTBASETOBASE)
-                                                                     of
 SPEC)
-                                                                  (HCSCALE SCALE (fetch
 (FMTSPEC
-                                                                                         
-                                                                                        FMTBASETOBASE
-                                                                                         )
-                                                                                    of
 SPEC]
-         FMTSPEC])
+    (LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
+          (create
 PARALOOKS using
 DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
+                                  (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 1STLEFTMAR))
+                                  LEFTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEFTMAR))
+                                  RIGHTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT RIGHTMAR))
+                                  QUAD _ (FGETPLOOKS DISPLAYFMT QUAD DISPLAYFMT)
+                                  FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT FMTDEFAULTTAB
+                                                                        ))
+                                  FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS DISPLAYFMT FMTTABS)
+                                                   SCALE)
+                                  FMTSPECIALX _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALX)
+                                                     (HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
+                                                                                     DISPLAYFMT 
+                                                                                     FMTSPECIALX)
+                                                                           1.0 NIL)))
+                                  FMTSPECIALY _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALY)
+                                                     (HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
+                                                                                     DISPLAYFMT 
+                                                                                     FMTSPECIALY)
+                                                                           1.0 NIL)))
+                                  LEADBEFORE _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADBEFORE))
+                                  LEADAFTER _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADAFTER))
+                                  LINELEAD _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LINELEAD))
+                                  FMTBASETOBASE _ (AND (FGETPLOOKS DISPLAYFMT FMTBASETOBASE)
+                                                       (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 
+                                                                             FMTBASETOBASE])
 
 (\TEDIT.INTEGER.IMAGEBOX

   [LAMBDA (OLDBOX)                                           (* jds "23-Oct-84 13:52")

@@ -451,7 +453,9 @@
 (DEFINEQ
 
 (TEDIT.HARDCOPYFN

-  [LAMBDA (WINDOW IMAGESTREAM)
                               (* ; "Edited 20-Mar-2024 10:49 by rmk")


+  [LAMBDA (WINDOW IMAGESTREAM)
                               (* ; "Edited 13-Dec-2024 22:33 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 14:42 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 10:49 by rmk")


                                                              (* ; "Edited 25-Sep-2023 16:29 by rmk")


                                                              (* ; "Edited  4-Jul-2023 11:16 by rmk")


                                                             (* ; "Edited 21-Sep-2021 15:33 by rmk:")

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

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

 
-         (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
-             (SETQ WINDOW (\TEDIT.MAINW WINDOW))
-             (SETQ TEXTOBJ (fetch
 (TEXTWINDOW WTEXTOBJ) of
 WINDOW)))
-         (RESETLST
-             [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
-                    '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
-             (FSETTOBJ TEXTOBJ EDITOPACTIVE 'Hardcopy)       (* ; "Build the hardcopy")

-             (SETQ WASDIRTY (FGETTOBJ TEXTOBJ \DIRTY))
-             (PROG1 (TEDIT.FORMAT.HARDCOPY WINDOW IMAGESTREAM)
-                    (FSETTOBJ TEXTOBJ \DIRTY WASDIRTY)))])
+         (TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW)
+                                              MENUFLG)
+                                    (\TEDIT.MAINW WINDOW)
+                                    WINDOW)
+                IMAGESTREAM])
 
 (\TEDIT.HARDCOPYFILEFN

   [LAMBDA (W EXT)
                                            (* ; "Edited 25-Sep-2023 16:19 by rmk")

@@ -566,11 +563,11 @@
          (CLOSEF DOC])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3475 26808 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5474) (TEDIT.HCPYFILE
- 5476 . 7416) (\TEDIT.HARDCOPY.DISPLAYLINE 7418 . 17356) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17358 . 
-18765) (\TEDIT.HARDCOPY.MODIFYLOOKS 18767 . 21001) (\TEDIT.HCPYFMTSPEC 21003 . 25137) (
-\TEDIT.INTEGER.IMAGEBOX 25139 . 25810) (\TEDIT.DISPLAY.DIACRITIC 25812 . 26806)) (26883 27713 (
-\TEDIT.SCALEREGION 26893 . 27711)) (27972 31667 (TEDIT.HARDCOPYFN 27982 . 29442) (
-\TEDIT.HARDCOPYFILEFN 29444 . 30005) (\TEDIT.POSTSCRIPT.HARDCOPY 30007 . 30938) (\TEDIT.PRESS.HARDCOPY
- 30940 . 31665)) (32930 33731 (TEDIT-BOOK 32940 . 33729)))))
+  (FILEMAP (NIL (3554 27051 (TEDIT.HARDCOPY 3564 . 4697) (\TEDIT.PRINT.MENU 4699 . 5665) (TEDIT.HCPYFILE
+ 5667 . 7841) (\TEDIT.HARDCOPY.DISPLAYLINE 7843 . 17953) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17955 . 
+19684) (\TEDIT.HARDCOPY.MODIFYLOOKS 19686 . 21920) (\TEDIT.HCPYFMTSPEC 21922 . 25380) (
+\TEDIT.INTEGER.IMAGEBOX 25382 . 26053) (\TEDIT.DISPLAY.DIACRITIC 26055 . 27049)) (27126 27956 (
+\TEDIT.SCALEREGION 27136 . 27954)) (28215 31755 (TEDIT.HARDCOPYFN 28225 . 29530) (
+\TEDIT.HARDCOPYFILEFN 29532 . 30093) (\TEDIT.POSTSCRIPT.HARDCOPY 30095 . 31026) (\TEDIT.PRESS.HARDCOPY
+ 31028 . 31753)) (33018 33819 (TEDIT-BOOK 33028 . 33817)))))
 STOP

library/tedit/TEDIT-HISTORY

@@ -1,21 +1,21 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154
 33348  
+
(FILECREATED "28-Mar-2025 14:23:18" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;227
 53951  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.UNDO)
+      :CHANGES-TO (FNS \TEDIT.UNDO.REPLACECODE \TEDIT.UNDO1)
 
-      :PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
+      :PREVIOUS-DATE "16-Mar-2025 18:50:43" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;225)
 
 
 (PRETTYCOMPRINT TEDIT-HISTORYCOMS)
 
 (RPAQQ TEDIT-HISTORYCOMS

        ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT)
-                                                (MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH)
-                                                ))
+                                                (MACROS \TEDIT.LASTEVENT GETTH SETTH)))
         (FNS \TEDIT.HISTORYEVENT.DEFPRINT)
+        (MACROS \TEDIT.HISTORYADD1)
         (INITRECORDS TEDITHISTORYEVENT)
         (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
         (INITVARS (TEDIT.HISTORY.TYPELST NIL)
@@ -23,13 +23,16 @@
         (COMS 
               (* ;; "History-list maintenance functions")

 
-              (FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
+              (FNS \TEDIT.HISTORYADD \TEDIT.HISTORYADD.COMPOSITE \TEDIT.CUMULATE.EVENTS 
+                   \TEDIT.COMPOSITE.EVENT \TEDIT.HISTORY.PROP \TEDIT.HISTORY.EVENT \TEDIT.POPEVENT))
         (COMS 
               (* ;; "Specialized UNDO & REDO functions.")

 
               (FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
-              (FNS \TEDIT.UNDO.INSERTION \TEDIT.UNDO.DELETION \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE)
-              (FNS \TEDIT.REDO.INSERTION \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE))))
+              (FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE 
+                   \TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS 
+                   \TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE)
+              (FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
@@ -47,16 +50,16 @@
                              NIL                             (* ; 
 
                                  "Was THAUXINFO: Auxiliary info about the event, primarily for redo")

                              THDELETEDPIECES)
-                            [ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (AND (fetch
 (TEDITHISTORYEVENT
-                                                                                THCH#) of
 DATUM)
-                                                                        (IPLUS (fetch
 (
+                            [ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch
 (
                                                                                     TEDITHISTORYEVENT
-                                                                                       THCH#)
-                                                                                  of
 DATUM)
-                                                                               (fetch
 (
+                                                                                      THCH#)
+                                                                                 of
 DATUM)
+                                                                              0)
+                                                                          (OR (fetch
 (
                                                                                     TEDITHISTORYEVENT
-                                                                                       THLEN)
-                                                                                  of
 DATUM]
+                                                                                      THLEN)
+                                                                                 of
 DATUM)
+                                                                              0]
                             (INIT (DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT
                                                                 )))
                             THPOINT _ 'LEFT)
@@ -80,9 +83,6 @@
 (PUTPROPS \TEDIT.LASTEVENT
 MACRO
 ((TOBJ)
                                   (CAR (fetch
 (TEXTOBJ TXTHISTORY) of
 TOBJ))))
 
-(PUTPROPS \TEDIT.POPEVENT
 MACRO
 ((TOBJ)
-                                 (pop
 (fetch
 (TEXTOBJ TXTHISTORY) of
 TOBJ))))
-
 (PUTPROPS GETTH
 MACRO
 ((EVENT FIELD)
                        (fetch
 (TEDITHISTORYEVENT FIELD) of
 EVENT)))
 
@@ -114,6 +114,15 @@
                       (CDR LOC)
                       "}"])
 )
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS \TEDIT.HISTORYADD1
 MACRO
 ((TEXTOBJ EVENT)
+
+                                    (* ;; "This is the primitive, to be upgraded if we go to a ring.")

+
+                                    (push
 (FGETTOBJ TEXTOBJ TXTHISTORY)
+                                          EVENT)))
+)
 
 (/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
                                              POINTER)
@@ -144,7 +153,11 @@
 (DEFINEQ
 
 (\TEDIT.HISTORYADD

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  3-Mar-2024 12:15 by rmk")


+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  8-Dec-2024 17:32 by rmk")


+                                                             (* ; "Edited 29-Aug-2024 12:30 by rmk")


+                                                             (* ; "Edited 11-Aug-2024 21:57 by rmk")


+                                                             (* ; "Edited 30-Apr-2024 22:51 by rmk")


+                                                             (* ; "Edited  3-Mar-2024 12:15 by rmk")


                                                              (* ; "Edited 19-Feb-2024 12:09 by rmk")


                                                              (* ; "Edited 30-Dec-2023 22:19 by rmk")


                                                              (* ; "Edited 11-Aug-2023 14:25 by rmk")


@@ -158,55 +171,75 @@
 
     (* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards.  Old code seemed to treat those as separate events, and  only the second/right one could be undone.")

 
-    (CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY))
-        (if
 (type?
 TEDITHISTORYEVENT EVENT)
-            then
 (CL:WHEN (MEMB (GETTH EVENT THACTION)
-                                (CONSTANT (LIST :Put :Get))) (* ; 
+    (if
 (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
+        then
 
+             (* ;; "Maybe the first event after setting the textprop--now's the time to flush")

+
+             (FSETTOBJ TEXTOBJ TXTHISTORY NIL)
+             (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
+      else
 (if
 (type?
 TEDITHISTORYEVENT EVENT)
+               then
 (CL:WHEN (MEMB (GETTH EVENT THACTION)
+                                   (CONSTANT (LIST :Put :Get)))
+                                                             (* ; 
 
                                                     "Can't back up over Put/Get, flush the history.")

-                     (FSETTOBJ TEXTOBJ TXTHISTORY NIL)) 
+                        (FSETTOBJ TEXTOBJ TXTHISTORY NIL)) 
 
-                 (* ;; "Somebody may have already done there own fixup.")

+                    (* ;; "Somebody may have already done there own fixup.")

 
-                 (LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
-                      (CL:WHEN (AND (type?
 TEDITHISTORYEVENT OLDEVENT)
-                                    (EQ :Delete (GETTH EVENT THACTION))
-                                    (EQ :Delete (GETTH OLDEVENT THACTION)))
+                    (LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
+                         (CL:WHEN (AND (type?
 TEDITHISTORYEVENT OLDEVENT)
+                                       (EQ :Delete (GETTH EVENT THACTION))
+                                       (EQ :Delete (GETTH OLDEVENT THACTION)))
 
-                          (* ;; 
-
                          "Repeated successive deletions, we can combine them if they are adjacent.")

+                             (* ;; 
+
                           "Repeated successive deletions, we can combine them if they are adjacent.")

 
-                          (CL:WHEN (IEQP (GETTH EVENT THCHLIM)
-                                         (GETTH OLDEVENT THCH#))
+                             (CL:WHEN (IEQP (GETTH EVENT THCHLIM)
+                                            (GETTH OLDEVENT THCH#))
                                                              (* ; 
 
                                                           "OLDEVENT is first, EVENT is still delete")

-                              (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 EVENT OLDEVENT TEXTOBJ))
-                              (\TEDIT.POPEVENT TEXTOBJ)      (* ; "Pop OLDEVENT before repushing")

-                              (SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
+                                 (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 EVENT OLDEVENT TEXTOBJ))
+                                 (\TEDIT.POPEVENT
 TEXTOBJ)   (* ; "Pop OLDEVENT before repushing")

+                                 (SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
 
-                          (* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")

+                             (* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")

 
-                          (CL:WHEN [AND OLDEVENT (type?
 TEDITHISTORYEVENT OLDEVENT)
-                                        (EQ :Delete (GETTH OLDEVENT THACTION))
-                                        (IEQP (GETTH OLDEVENT THCHLIM)
-                                              (IPLUS (GETTH EVENT THCH#)
-                                                     (GETTH OLDEVENT THLEN]
+                             (CL:WHEN [AND OLDEVENT (type?
 TEDITHISTORYEVENT OLDEVENT)
+                                           (EQ :Delete (GETTH OLDEVENT THACTION))
+                                           (IEQP (GETTH OLDEVENT THCHLIM)
+                                                 (IPLUS (GETTH EVENT THCH#)
+                                                        (GETTH OLDEVENT THLEN]
 
-                              (* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates.  EVENT came later, with its TCH# in a coordinate system reduced by THLEN.  So we have to add it back.")

+                                 (* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates.  EVENT came later, with its TCH# in a coordinate system reduced by THLEN.  So we have to add it back.")

 
-                              (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 OLDEVENT EVENT))
-                              (\TEDIT.POPEVENT TEXTOBJ)))
-                      (push
 (GETTOBJ TEXTOBJ TXTHISTORY)
-                            EVENT))
-          elseif
 (LISTP EVENT)
-            then
 
-                 (* ;; "A monolithic sequence of undoable events")

+                                 (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 OLDEVENT EVENT))
+                                 (\TEDIT.POPEVENT
 TEXTOBJ)))
+                         (\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
+             elseif
 (LISTP EVENT)
+               then
 
+                    (* ;; "A monolithic sequence of undoable events")

 
-                 (push
 (GETTOBJ TEXTOBJ TXTHISTORY)
-                       EVENT)))
+                    (* ;; "SHOULDNT HAPPEN ?")

+
+                    (\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
     EVENT])
 
+(\TEDIT.HISTORYADD.COMPOSITE

+  [LAMBDA (TEXTOBJ EVENTS)
                                   (* ; "Edited  6-Feb-2025 15:31 by rmk")


+                                                             (* ; "Edited  8-Dec-2024 19:31 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 18:47 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 08:02 by rmk")


+                                                             (* ; "Edited  8-May-2024 12:34 by rmk")

+    (SETQ EVENTS (REMOVE NIL EVENTS))
+    (CL:WHEN EVENTS
+        (\TEDIT.HISTORYADD
 TEXTOBJ (CL:IF (CDR EVENTS)
+                                       (\TEDIT.HISTORY.EVENT
 TEXTOBJ :Composite NIL NIL NIL NIL 
+                                              EVENTS)
+                                       (CAR EVENTS))))])
+
 (\TEDIT.CUMULATE.EVENTS

-  [LAMBDA (EVENT1 EVENT2 TEXTOBJ)
                            (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (EVENT1 EVENT2 TEXTOBJ)
                            (* ; "Edited  8-Dec-2024 17:35 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited  3-Mar-2024 12:15 by rmk")


                                                              (* ; "Edited  3-Jun-2023 17:09 by rmk")


                                                              (* ; "Edited 27-May-2023 00:54 by rmk")


@@ -222,8 +255,68 @@
     (SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
                                          (GETTH EVENT2 THDELETEDPIECES)
                                          TEXTOBJ))
-    (SETTH EVENT1 THLEN (fetch
 (SELPIECES SPLEN) of
 (GETTH EVENT1 THDELETEDPIECES)))
+    (SETTH EVENT1 THLEN (GETSPC (GETTH EVENT1 THDELETEDPIECES)
+                               SPLEN))
     EVENT1])
+
+(\TEDIT.COMPOSITE.EVENT

+  [LAMBDA (TEXTOBJ EVENTS)
                                   (* ; "Edited  8-Dec-2024 15:47 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 18:47 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 08:02 by rmk")


+                                                             (* ; "Edited  8-May-2024 12:34 by rmk")

+    (CL:WHEN EVENTS
+        (\TEDIT.HISTORYADD
 (CL:IF (CDR EVENTS)
+                               (\TEDIT.HISTORY.EVENT
 TEXTOBJ (OR ACTION :Composite)
+                                      NIL NIL NIL NIL NEWEVENTS)
+                               (CAR EVENTS))))])
+
+(\TEDIT.HISTORY.PROP

+  [LAMBDA (TEXTOBJ SETNEWVALUE NEWVALUE)
                     (* ; "Edited 22-Sep-2024 08:42 by rmk")

+
+    (* ;; "Called fromTEDIT.TEXT.PROP to manage the history list.  History is ON by default, and the events always correspond to the current state of the document.  If it's OFF, the next document-changing event will cause HISTORYADD to flush the past and no further events will be recorded until it is turned ON again to start a new epoch.  CLEAR flushes old events but then turns on collection.")

+
+    (PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
+               'OFF
+               'ON)
+        (CL:WHEN SETNEWVALUE
+            (SELECTQ NEWVALUE
+                ((ON T) 
+                     (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
+                ((OFF NIL) 
+                           (* ;; 
+
   "HISTORYADD will wipe out everything the next time it is called event--gives a chance to back out")

+
+                     (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE T))
+                (CLEAR                                       (* ; 
+
                                             "Wipes out current history now, then resumes collection")

+                       (FSETTOBJ TEXTOBJ TXTHISTORY NIL)
+                       (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
+                (\ILLEGAL.ARG NEWVALUE))))])
+
+(\TEDIT.HISTORY.EVENT

+  [LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)

+                                                             (* ; "Edited 26-Sep-2024 15:44 by rmk")


+                                                             (* ; "Edited 23-Sep-2024 16:47 by rmk")

+
+    (* ;; "Don't create if it's inactive")

+
+    (CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
+        (CL:WHEN (AND (NULL LEN)
+                      (type?
 SELPIECES CH#))
+            (SETQ LEN (fetch
 (SELPIECES SPLEN) of
 CH#))
+            (SETQ CH# (fetch
 (SELPIECES SPFIRSTCHAR) of
 CH#)))
+        (create
 TEDITHISTORYEVENT
+               THACTION _ ACTION
+               THCH# _ CH#
+               THLEN _ LEN
+               THPOINT _ (OR POINT 'LEFT)
+               THFIRSTPIECE _ FIRSTPIECE
+               THOLDINFO _ OLDINFO
+               THDELETEDPIECES _ DELETEDPIECES))])
+
+(\TEDIT.POPEVENT

+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  7-Dec-2024 21:24 by rmk")

+    (pop
 (GETTOBJ TEXTOBJ TXTHISTORY])
 )
 
 
@@ -233,7 +326,15 @@
 (DEFINEQ
 
 (TEDIT.UNDO

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 20-Mar-2024 11:04 by rmk")


+  [LAMBDA (TSTREAM NOUNDOUNDO)
                               (* ; "Edited 13-Mar-2025 15:47 by rmk")


+                                                             (* ; "Edited  8-Dec-2024 19:41 by rmk")


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


+                                                             (* ; "Edited 12-Aug-2024 10:49 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 21:21 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:23 by rmk")


+                                                             (* ; "Edited 12-May-2024 21:08 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 11:04 by rmk")


+                                                             (* ; "Edited  8-May-2024 11:16 by rmk")


                                                              (* ; "Edited 15-Mar-2024 13:36 by rmk")


                                                              (* ; "Edited  7-Mar-2024 12:48 by rmk")


                                                              (* ; "Edited  3-Mar-2024 20:02 by rmk")


@@ -246,95 +347,128 @@
 
     (* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.")

 
-    (TEXTOBJ! TEXTOBJ)
-    (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY)
-
-        (* ;; "Only undo things if the document is allowed to change.")

-
-        (TEDIT.PROMPTPRINT TEXTOBJ "" T)
-        (PROG ((SEL (TEXTSEL TEXTOBJ))
-               (EVENT (\TEDIT.POPEVENT TEXTOBJ))
-               PREVEVENTS UNDOEVENT)
-              (CL:UNLESS EVENT
-                  (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+            (SEL (TEXTSEL TEXTOBJ))
+            EVENT PREVEVENT UNDOEVENT)
+           (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
                   (RETURN))
+           (SETQ EVENT (\TEDIT.LASTEVENT TEXTOBJ))
+           (CL:UNLESS EVENT
+               (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
+               (RETURN))
+           (CL:WHEN (MEMB (GETTH EVENT THACTION)
+                          '(:Get :Put))
+               (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
+                      T)
+               (RETURN))
+           (SETQ EVENT (\TEDIT.POPEVENT
 TEXTOBJ))
+           (SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))       (* ; 
+
                                                             "So we can test for the undoundo event.")

+           (CL:UNLESS EVENT
+               (TEDIT.PROMPTPRINT TSTREAM "Nothing to undo" T)
+               (RETURN))
 
-         (* ;; "Each main event was popped.  Each subfunction must put back on the history-undo  list one or more new events that would undo its undoing.  ")

+     (* ;; "Each main event was popped.  Each subfunction must put back on the history-undo  list one or more new events that would undo its undoing.  ")

 
-         (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")

+     (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")

 
-              (SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY))
-              (\TEDIT.SHOWSEL SEL NIL)
-              (\TEDIT.UNDO1
 TEXTOBJ EVENT)
+           (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
+           (TEDIT.PROMPTCLEAR TSTREAM)
+           (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+           (\TEDIT.UNDO1
 TSTREAM EVENT)
 
-         (* ;; "Get the event that undid EVENT")

+     (* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")

 
-              (SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))
-              (FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS)
-              (CL:WHEN [OR (NULL PREVEVENTS)
-                           (AND (type?
 TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS)))
-                                (MEMB (GETTH (CAR PREVEVENTS)
-                                             THACTION)
-                                      (CONSTANT (LIST :Get :Put]
-                     (SETTOBJ TEXTOBJ \DIRTY NIL))
+           (CL:UNLESS (EQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))
+               (SETQ UNDOEVENT (\TEDIT.POPEVENT
 TEXTOBJ)))
+           (CL:WHEN [OR (NULL PREVEVENT)
+                        (MEMB (GETTH PREVEVENT THACTION)
+                              (CONSTANT (LIST :Get :Put]
+                  (FSETTOBJ TEXTOBJ \DIRTY NIL))
+           (CL:UNLESS NOUNDOUNDO
 
-         (* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u).  This is so that M-U can undo the undoing.")

+               (* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u).  This is so that M-U can undo the undoing by redoing the original event.")

 
-              (push
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ)
-                    (LIST (CAR PREVEVENTS)
-                          UNDOEVENT EVENT))
-              (\TEDIT.FIXSEL SEL TEXTOBJ)
-              (\TEDIT.SHOWSEL SEL T)))])
+               (push
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
+                     (LIST PREVEVENT UNDOEVENT EVENT)))
+           (\TEDIT.FIXSEL SEL TEXTOBJ)
+           (\TEDIT.SHOWSEL SEL T TEXTOBJ])
 
 (\TEDIT.UNDO1

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  4-Mar-2024 14:55 by rmk")


+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited 28-Mar-2025 14:22 by rmk")


+                                                             (* ; "Edited 16-Mar-2025 18:46 by rmk")


+                                                             (* ; "Edited 25-Nov-2024 13:56 by rmk")


+                                                             (* ; "Edited 29-Sep-2024 13:51 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 21:41 by rmk")


+                                                             (* ; "Edited 19-Aug-2024 00:11 by rmk")


+                                                             (* ; "Edited 12-Aug-2024 23:42 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:10 by rmk")


+                                                             (* ; "Edited  4-Mar-2024 14:55 by rmk")


                                                              (* ; "Edited 16-Jul-2023 11:14 by rmk")


                                                              (* ; "Edited 30-May-2023 23:50 by rmk")


                                                              (* ; "Edited 25-May-2023 00:33 by rmk")

-    (SELECTC (GETTH EVENT THACTION)
-        ((LIST :Insert :Copy) 
-             (\TEDIT.UNDO.INSERTION
 TEXTOBJ EVENT))
-        (:Move (\TEDIT.UNDO.MOVE
 TEXTOBJ EVENT))
-        (:Delete                                             (* ; "Deletion or case-shift")

-                 (\TEDIT.UNDO.DELETION
 TEXTOBJ EVENT))
-        (:Move (\TEDIT.UNDO.MOVE
 TEXTOBJ EVENT))
-        (:Looks                                              (* ; "Character-looks change")

-                (\TEDIT.UNDO.LOOKS TEXTOBJ EVENT))
-        (:ParaLooks                                          (* ; "PARA looks change")

-                    (\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
-        (:PageFormat                                         (* ; "Pageframe change")

-                     [SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (GETTH EVENT THOLDINFO)
-                                                        (SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ 
-                                                                                      TXTPAGEFRAMES)))
-                            ]
-                     (\TEDIT.HISTORYADD
 TEXTOBJ EVENT))
-        ((LIST :Replace :LowerCase :UpperCase) 
-                                               (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")

+    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
+         (CL:WHEN (GETTH EVENT THCH#)
+             (\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
+             (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
+                    EVENT)
+             (\TEDIT.SHOWSEL NIL T TEXTOBJ)
+             (\TEDIT.SCROLL.CARET TSTREAM))
+         (PROG1 (SELECTC (GETTH EVENT THACTION)
+                    ((LIST :Insert :Copy) 
+                         (\TEDIT.UNDO.INSERT
 TEXTOBJ EVENT))
+                    (:Move (\TEDIT.UNDO.MOVE
 TSTREAM EVENT))
+                    (:Delete                                 (* ; "Deletion or case-shift")

+                             (\TEDIT.UNDO.DELETE
 TEXTOBJ EVENT))
+                    (:CharLooks                              (* ; "Character-looks change")

+                                (\TEDIT.UNDO.CHARLOOKS
 TEXTOBJ EVENT))
+                    (:ParaLooks                              (* ; "PARA looks change")

+                                (\TEDIT.UNDO.PARALOOKS
 TEXTOBJ EVENT))
+                    (:PageFormat                             (* ; "Pageframe change")

+                                 (\TEDIT.UNDO.PAGELOOKS
 TEXTOBJ EVENT))
+                    ((LIST :Replace :Transform) 
 
-             (\TEDIT.UNDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
-        (:Closefile                                          (* ; "Closes an included file")

-                    (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
-                        (CLOSEF? (GETTH EVENT THOLDINFO))))
-        ((LIST :Get :Put)                                    (* ; 
+                                               (* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")

+
+                         (\TEDIT.UNDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
+                    (:ReplaceCode (\TEDIT.UNDO.REPLACECODE
 TSTREAM EVENT))
+                    (:Closefile                              (* ; "Closes an included file")

+                                (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
+                                    (CLOSEF? (GETTH EVENT THOLDINFO))))
+                    (:Composite (\TEDIT.UNDO.COMPOSITE
 TSTREAM EVENT))
+                    ((LIST :Get :Put)                        (* ; 
 
                                                             "He did a GET or PUT-- not undoable.")

-             (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
-                    T))
-        (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
-                                    TEDIT.HISTORY.TYPELST]
-             (COND
-                (UNDOFN 
+                         (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION
+                                                                                       ))
+                                T))
+                    (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
+                                                TEDIT.HISTORY.TYPELST]
+                         (COND
+                            (UNDOFN 
 
-                       (* ;; "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

+                                   (* ;; 
+
                                   "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

 
-                       (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
-                              (GETTH EVENT THCH#)
-                              (GETTH EVENT THFIRSTPIECE)))
-                (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT 
-                                                                                         THACTION))
-                          T])
+                                   (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
+                                          (GETTH EVENT THCH#)
+                                          (GETTH EVENT THFIRSTPIECE)))
+                            (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
+                                                                 (GETTH EVENT THACTION))
+                                      T])
 
 (TEDIT.REDO

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 15-Mar-2024 13:36 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 16-Mar-2025 18:48 by rmk")


+                                                             (* ; "Edited  2-Feb-2025 11:28 by rmk")


+                                                             (* ; "Edited  8-Dec-2024 17:53 by rmk")


+                                                             (* ; "Edited 27-Nov-2024 23:11 by rmk")


+                                                             (* ; "Edited 26-Sep-2024 16:49 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 23:58 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 07:41 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:23 by rmk")


+                                                             (* ; "Edited 12-May-2024 21:08 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:36 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:13 by rmk")


                                                              (* ; "Edited  4-Mar-2024 21:33 by rmk")


                                                              (* ; "Edited  2-Mar-2024 09:41 by rmk")


                                                              (* ; "Edited 21-Dec-2023 11:57 by rmk")


@@ -343,71 +477,83 @@
 
     (* ;; "REDO the last thing this guy did.")

 
-    (CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
-        (PROG ((SEL (GETTOBJ TEXTOBJ SEL))
-               (EVENT (\TEDIT.LASTEVENT TEXTOBJ))
-               CH)
-              (CL:UNLESS EVENT
-                  (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
-                  (RETURN))
-              (CL:UNLESS (GETSEL SEL SET)
-                  (TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
-                  (RETURN))
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+            (SEL (GETTOBJ TEXTOBJ SEL))
+            (EVENT (\TEDIT.LASTEVENT TEXTOBJ))
+            CH)
+           (CL:WHEN (\TEDIT.READONLY TEXTOBJ)
+                  (RETURN NIL))
+           (CL:UNLESS EVENT
+               (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
+               (RETURN))
+           (CL:UNLESS (GETSEL SEL SET)
+               (TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
+               (RETURN))
 
-         (* ;; "There really is something to redo and something to do it to.")

+     (* ;; "There really is something to redo and something to do it to.")

 
-              (\TEDIT.SHOWSEL SEL NIL)
-              (SELECTC (GETTH EVENT THACTION)
-                  ((LIST :Insert :Copy :Move)                (* ; "It was an insertion")

-                       (\TEDIT.REDO.INSERTION
 TEXTOBJ EVENT SEL))
-                  (:Delete                                   (* ; "It was a deletion")

-                           (\TEDIT.DELETE TEXTOBJ SEL))
-                  (:Replace                                  (* ; 
+           (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+           (SELECTC (GETTH EVENT THACTION)
+               ((LIST :Insert :Copy :Move)                   (* ; "It was an insertion")

+                    (\TEDIT.REDO.INSERT
 TEXTOBJ EVENT SEL))
+               (:Delete                                      (* ; "It was a deletion")

+                        (\TEDIT.DELETE TEXTOBJ SEL))
+               (:Replace                                     (* ; 
 
                                                          "It was a replacement (a del/insert combo)")

-                            (\TEDIT.REDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
-                  (:LowerCase                                (* ; "He lower-cased something")

-                              (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
-                  (:UpperCase                                (* ; "He upper-cased something")

-                              (\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
-                  (:Looks                                    (* ; "It was a character looks change")

-                          (TEDIT.LOOKS TEXTOBJ (PLOOKS (GETTH EVENT THFIRSTPIECE))
-                                 SEL))
-                  (:ParaLooks                                (* ; "It was a Paragraph looks change")

-                              (TEDIT.PARALOOKS TEXTOBJ (PPARALOOKS (GETTH EVENT THFIRSTPIECE))
-                                     SEL))
-                  (:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
-                  (:Find                                     (* ; "EXACT-MATCH SEARCH COMMAND")

+                         (\TEDIT.REDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
+               (:Transform (\TEDIT.KEY.TRANSFORM TSTREAM (GETTH EVENT THOLDINFO)))
+               (:LowerCase                                   (* ; "He lower-cased something")

+                           (\TEDIT.LCASE.SEL TSTREAM TEXTOBJ SEL))
+               (:UpperCase                                   (* ; "He upper-cased something")

+                           (\TEDIT.UCASE.SEL TSTREAM TEXTOBJ SEL))
+               (:InitialCap (\TEDIT.KEY.INITIALCAP TSTREAM TEXTOBJ SEL))
+               (:CharLooks                                   (* ; "It was a character looks change")

+                           (\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
+                                  SEL))
+               (:ParaLooks                                   (* ; "It was a Paragraph looks change")

+                           (\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
+                                  SEL))
+               (:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
+               (:Find                                        (* ; "EXACT-MATCH SEARCH COMMAND")

                                                              (* (* ;; "RESTLST ?")
 
                                                             (AND NIL (RESETSAVE (CURSOR 
 
                                                             WAITINGCURSOR))) (TEDIT.PROMPTPRINT 
 
                                                             TEXTOBJ "Searching..." T)
 
                                                             (SETQ SEL (fetch (TEXTOBJ SEL) of 
-
                                                             TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL)
-
                                                             (SETQ CH (TEDIT.FIND TEXTOBJ
+
                                                             TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL 
+
                                                             TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
 
                                                             (GETTH EVENT THAUXINFO)))
 
                                                             (COND (CH (TEDIT.PROMPTPRINT TEXTOBJ 
 
                                                             "done.") (\TEDIT.UPDATE.SEL SEL CH
 
                                                             (NCHARS (GETTH EVENT THAUXINFO))
 
                                                             (QUOTE RIGHT)) (\TEDIT.FIXSEL SEL 
 
                                                             TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
-
                                                             (\TEDIT.SHOWSEL SEL T))
+
                                                             (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))
 
                                                             (T (TEDIT.PROMPTPRINT TEXTOBJ 
 
                                                             "[Not found]"))))

-                         )
-                  (:Move                                     (* ; "He moved some text")

-                         (\TEDIT.REDO.MOVE
 TEXTOBJ EVENT (GETTH EVENT THLEN)
-                                (IMAX 1 (TEDIT.GETPOINT NIL SEL))
-                                (GETTH EVENT THFIRSTPIECE)))
-                  ((LIST :Get :Put)                          (* ; "Why can't you redo a get or put ?")

-                       (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
-                              T T))
-                  (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
-                                                    " isn't implemented.")
-                         T))
-              (\TEDIT.SHOWSEL SEL T)))])
+                      )
+               (:Move 
+                      (* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place.  The insert part is probably OK--that maps to the :Insert clause above.")

+
+                      (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
+                             T T))
+               (:Composite (\TEDIT.REDO.COMPOSITE
 TEXTOBJ EVENT SEL))
+               ((LIST :Get :Put NIL)                         (* ; "Why can't you redo a get or put ?")

+                    (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
+                           T T))
+               (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
+                                                 " isn't implemented.")
+                      T))
+           (\TEDIT.SHOWSEL SEL T TEXTOBJ])
 
 (\TEDIT.UNDO.UNDO

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  3-Mar-2024 21:27 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited  8-Dec-2024 18:24 by rmk")


+                                                             (* ; "Edited 26-Sep-2024 22:57 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 11:08 by rmk")


+                                                             (* ; "Edited 12-Aug-2024 23:45 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 09:50 by rmk")


+                                                             (* ; "Edited  3-Mar-2024 21:27 by rmk")


                                                              (* ; "Edited 13-Jun-2023 15:05 by rmk")


                                                              (* ; "Edited  3-Jun-2023 23:04 by rmk")


                                                              (* ; "Edited  1-Jun-2023 23:53 by rmk")

@@ -419,33 +565,34 @@
 
     (* ;; "This makes sense only if the document is now in the state immediately after the undoing--if any other events have intervened, the character positions and the general state of the document are unrelated. So the elements of the undo list also contain the state of the (forward) history list after the undoing was undone.  If we have moved back to the same point in history, we can do the undoing.")

 
-    (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
-    (TEDIT.PROMPTPRINT TEXTOBJ "" T)
-    (LET [(LASTUNDONE (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
-         (if
 (NULL LASTUNDONE)
-             then
 (TEDIT.PROMPTPRINT TEXTOBJ "There is no action whose undoing can be reversed" T)
-           elseif
 (EQ (CAR LASTUNDONE)
-                      (\TEDIT.LASTEVENT TEXTOBJ))
-             then
 
-                  (* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")

+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+           (LASTUNDONE (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
+          (TEDIT.PROMPTCLEAR TSTREAM)
+          (if
 (NULL LASTUNDONE)
+              then
 (TEDIT.PROMPTPRINT TSTREAM "There is no action whose undoing can be reversed")
+            elseif
 (EQ (CAR LASTUNDONE)
+                       (\TEDIT.LASTEVENT TEXTOBJ))
+              then
 
+                   (* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")

 
-                  (push
 (FGETTOBJ TEXTOBJ TXTHISTORY)
-                        (CADR LASTUNDONE))
-                  (TEDIT.UNDO
 TEXTOBJ) 
+                   (\TEDIT.HISTORYADD1 TEXTOBJ (CADR LASTUNDONE))
+                   (TEDIT.UNDO
 TSTREAM)
+                   (TEDIT.PROMPTPRINT TSTREAM "Undo undone" T) 
 
-                  (* ;; "This saved what we just undid, don't want to keep reundoing it.")

+                   (* ;; "This undoing saved what we just undid, don't want to keep reundoing it.")

 
-                  (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
-                  (push
 (FGETTOBJ TEXTOBJ TXTHISTORY)
-                        (CADDR LASTUNDONE))
-           else
 (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)       (* ; 
+                   (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
+                   (\TEDIT.HISTORYADD1 TEXTOBJ (CADDR LASTUNDONE))
+            else
 (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)      (* ; 
 
                                        "If something else has happened, there are no undos to undo.")

-                (TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T])
+                 (TEDIT.PROMPTPRINT TSTREAM "Cannot undo the previous undo" T])
 )
 (DEFINEQ
 
-(\TEDIT.UNDO.INSERTION

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 30-May-2023 22:54 by rmk")


+(\TEDIT.UNDO.INSERT

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  8-Jul-2024 00:07 by rmk")


+                                                             (* ; "Edited 30-May-2023 22:54 by rmk")


                                                              (* ; "Edited 26-May-2023 23:49 by rmk")


                                                              (* ; "Edited 24-May-2023 23:53 by rmk")


                                                              (* ; "Edited  2-May-2023 23:26 by rmk")


@@ -453,11 +600,13 @@
 
     (* ;; "UNDO a prior Insert, Copy, or Include. ")

 
-    (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                                  EVENT])
+    (\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
+                                                 EVENT)
+                                  TEXTOBJ])
 
-(\TEDIT.UNDO.DELETION

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 15-Mar-2024 13:54 by rmk")


+(\TEDIT.UNDO.DELETE

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 29-Sep-2024 00:23 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited 30-May-2023 23:31 by rmk")


                                                              (* ; "Edited 27-May-2023 23:39 by rmk")


                                                              (* ; "Edited 21-Apr-93 12:01 by jds")

@@ -470,65 +619,213 @@
            (GETTH EVENT THCH#])
 
 (\TEDIT.UNDO.MOVE

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited  8-Dec-2024 19:38 by rmk")


+                                                             (* ; "Edited 25-Nov-2024 14:12 by rmk")


+                                                             (* ; "Edited 29-Sep-2024 00:23 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:50 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 10:17 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited  4-Mar-2024 16:08 by rmk")

 
-    (* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense.  The deleted string would reappear in some random place.")

+    (* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)")

 
-    (LET ((DELEVENT (CAR (GETTH EVENT THOLDINFO)))
-          (FOBJ (CDR (GETTH EVENT THOLDINFO)))
-          (SEL (FGETTOBJ TEXTOBJ SEL)))
-         (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL SEL EVENT))
-                                                             (* ; "Undo the insert in this document")

-         (CL:WHEN (GETTH EVENT THDELETEDPIECES)              (* ; 
-
                                                             ":Move must have started as :Replace")

-             (\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
-                                             'INSERT TEXTOBJ)
-                    TEXTOBJ
-                    (GETTH EVENT THCH#)))
-         (if
 FOBJ
-             then
 (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ))
-                                                             (* ; 
-
                                                             "Delete is last event in other document")

-                      (TEDIT.UNDO
 FOBJ))
-           else
 (\TEDIT.UNDO1
 TEXTOBJ DELEVENT))
-
-         (* ;; "Put the point back after the original target. Caller wil fix it.")

-
-         (\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T])
+    (LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+           (SEL (TEXTSEL TEXTOBJ))
+           (REPLACE
 (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
+                                        THACTION]
+          (\TEDIT.UNDO.COMPOSITE
 TSTREAM EVENT)
+          (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL (if
 REPLACE
+                                                   then
 (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
+                                                        'PENDINGDEL
+                                                 else
 'NORMAL))
+          (\TEDIT.FIXSEL SEL TSTREAM)
+          (\TEDIT.SHOWSEL SEL T TSTREAM])
 
 (\TEDIT.UNDO.REPLACE

-  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 15-Mar-2025 22:35 by rmk")


+                                                             (* ; "Edited 13-Sep-2024 23:50 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:59 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited 30-May-2023 23:10 by rmk")


                                                              (* ; "Edited 27-May-2023 16:49 by rmk")


                                                              (* ; "Edited 24-May-2023 22:43 by rmk")

 
-    (* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.")

+    (* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, uppercase, or initialcap.")

 
     (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
                                      NIL TEXTOBJ)
            TEXTOBJ
-           (\TEDIT.UPDATE.SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+           (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
                   EVENT))
     (SETTH (\TEDIT.LASTEVENT TEXTOBJ)
            THACTION ACTION])
+
+(\TEDIT.UNDO.CHARLOOKS

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 25-Nov-2024 21:59 by rmk")


+                                                             (* ; "Edited 28-Sep-2024 22:37 by rmk")


+                                                             (* ; "Edited 26-Sep-2024 16:06 by rmk")


+                                                             (* ; "Edited 11-Aug-2024 22:11 by rmk")


+                                                             (* ; "Edited  5-Jul-2024 22:54 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:21 by rmk")


+                                                             (* ; "Edited 19-Feb-2024 11:32 by rmk")


+                                                             (* ; "Edited 14-Dec-2023 21:01 by rmk")


+                                                             (* ; "Edited 30-May-2023 22:56 by rmk")


+                                                             (* ; "Edited 18-Apr-2023 23:56 by rmk")


+                                                             (* ; "Edited 30-May-91 21:44 by jds")

+
+    (* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed.  We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece")

+
+    (for
 U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
+                                                      TEXTOBJ))
+         (CHNO _ (GETTH EVENT THCH#))
+         (SEL _ (FGETTOBJ TEXTOBJ SEL))
+         (CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in
 (CDR (GETTH EVENT THOLDINFO))
+       do
 
+          (* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")

+
+          (* ;; "Perhaps we should also save the CHNO of the CARETPC")

+
+          (SETQ NEXTCHNO (CAR U))
+          (SETQ OLDLOOKS (CDR U))
+          (CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
+              (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
+          [push
 NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC] 
+
+          (* ;; "U starts at the first piece.  We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...))  But then, what about the last piece.  Maybe we have to do our own popping, or look at UTAIL.  Or end in (NEXTPC-CHNO . NIL ).  Or text for IGEQ THCHLIM")

+
+          (for
 P inpieces
 PC do
 (FSETPC P PLOOKS OLDLOOKS)
+                                (add
 CHNO (PLEN P))
+                                (CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run")

+                                    (SETQ PC P)
+                                    (RETURN))) finally
 
+
+                                                     (* ;; 
+
                     "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")

+
+                                                     (CL:WHEN NEWUNDOLIST
+                                                         (change
 (GETTH EVENT THOLDINFO)
+                                                                (CONS (CAR DATUM)
+                                                                      (DREVERSE NEWUNDOLIST)))
+                                                         (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                                                         (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
+                                                                'NORMAL)
+                                                         (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS
+                                                                (GETTH EVENT THCH#)
+                                                                (GETTH EVENT THLEN))
+                                                         (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                                                         (TEDIT.PROMPTPRINT TEXTOBJ 
+                                                                "Character looks restored" T)) 
+
+                                                     (* ;; 
+
                                        "Save the event for REDO, even if these pieces didn't change")

+
+                                                     (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(\TEDIT.UNDO.PARALOOKS

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 25-Nov-2024 22:00 by rmk")


+                                                             (* ; "Edited 28-Sep-2024 22:38 by rmk")


+                                                             (* ; "Edited 27-Sep-2024 12:23 by rmk")


+                                                             (* ; "Edited 11-Aug-2024 22:10 by rmk")


+                                                             (* ; "Edited  5-Jul-2024 22:54 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:22 by rmk")


+                                                             (* ; "Edited 19-Feb-2024 11:32 by rmk")


+                                                             (* ; "Edited 11-Dec-2023 11:10 by rmk")


+                                                             (* ; "Edited 21-Sep-2023 23:51 by rmk")


+                                                             (* ; "Edited 30-May-2023 22:55 by rmk")


+                                                             (* ; "Edited 18-Apr-2023 23:57 by rmk")


+                                                             (* ; "Edited 30-May-91 21:44 by jds")

+
+    (* ;; "Undo the setting of paragraph looks.")

+
+    (for
 U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
+                                             TEXTOBJ))
+         (CHNO _ (GETTH EVENT THCH#))
+         (SEL _ (FGETTOBJ TEXTOBJ SEL)) in
 (CDR (GETTH EVENT THOLDINFO))
+       do
 
+          (* ;; "Find the first piece of the next changed paragraph")

+
+          (for
 P inpieces
 PC do
 (CL:WHEN (IEQP CHNO (CAR U))
+                                    (SETQ PC P)
+                                    (RETURN))
+                                (add
 CHNO (PLEN P)))
+          (SETQ OLDLOOKS (CDR U))
+          (push
 NEWUNDOLIST (CONS CHNO (PPARALOOKS PC)))     (* ; "Save for UNDO UNDO")

+
+          (* ;; "Change all the pieces in this paragraph")

+
+          (for
 P inpieces
 PC do
 (FSETPC P PPARALOOKS OLDLOOKS)
+                                (CL:WHEN (PPARALAST P)
+                                    (SETQ PC P)
+                                    (RETURN))
+                                (add
 CHNO (PLEN P))) finally
 
+
+                                                           (* ;; 
+
                     "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")

+
+                                                           (CL:WHEN NEWUNDOLIST
+                                                               (change
 (GETTH EVENT THOLDINFO)
+                                                                      (CONS (CAR DATUM)
+                                                                            (DREVERSE NEWUNDOLIST)))
+                                                               (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                                                               (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
+                                                                      'NORMAL)
+                                                               (\TEDIT.UPDATE.LINES TEXTOBJ
+                                                                      'LOOKS
+                                                                      (GETTH EVENT THCH#)
+                                                                      (GETTH EVENT THLEN))
+                                                               (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                                                               (TEDIT.PROMPTPRINT TEXTOBJ 
+                                                                      "Paragraph looks restored" T))
+                                                           
+                                                           (* ;; 
+
                                        "Save the event for REDO, even if these pieces didn't change")

+
+                                                           (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(\TEDIT.UNDO.PAGELOOKS

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 12-Aug-2024 10:28 by rmk")

+    [SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
+                                       (SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
+    (TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T)
+    (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(\TEDIT.UNDO.COMPOSITE

+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited  8-Dec-2024 15:47 by rmk")


+                                                             (* ; "Edited 25-Nov-2024 22:27 by rmk")


+                                                             (* ; "Edited 15-Aug-2024 10:14 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:17 by rmk")

+
+    (* ;; "A composite event is a group of other events that are to be undone at the same time.  Only show the selection of the last undo event.  We want to end up with a single event on history. We don't want to bump the count.  (Presumably EVENT was alread popped)")

+
+    (for
 E EVENTS CUREVENT (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) in
 (GETTH EVENT THOLDINFO)
+       do
 (SETQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))
+          (\TEDIT.UNDO1
 TSTREAM E)
+          (CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")

+              (push
 EVENTS (\TEDIT.POPEVENT
 TEXTOBJ)))
+          (\TEDIT.SHOWSEL NIL NIL TSTREAM) finally
 (\TEDIT.HISTORYADD.COMPOSITE
 TEXTOBJ EVENTS))
+    (\TEDIT.SCROLL.CARET TSTREAM])
+
+(\TEDIT.UNDO.REPLACECODE

+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited 28-Mar-2025 14:22 by rmk")


+                                                             (* ; "Edited 23-Sep-2024 00:45 by rmk")

+    (\TEDIT.RPLCHARCODE TSTREAM (GETTH EVENT THCH#)
+           (GETTH EVENT THOLDINFO])
 )
 (DEFINEQ
 
-(\TEDIT.REDO.INSERTION

-  [LAMBDA (TEXTOBJ EVENT SEL)
                                (* ; "Edited 15-Mar-2024 13:54 by rmk")


+(\TEDIT.REDO.INSERT

+  [LAMBDA (TEXTOBJ EVENT SEL)
                                (* ; "Edited 15-Aug-2024 10:47 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited 31-May-2023 10:26 by rmk")


                                                              (* ; "Edited 18-May-2023 19:24 by rmk")


                                                              (* ; "Edited 21-Apr-93 01:06 by jds")

-
-    (* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret.  We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.")

-
     (\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
                                     'INSERT TEXTOBJ)
            TEXTOBJ SEL])
 
 (\TEDIT.REDO.REPLACE

-  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited  7-Jul-2024 11:59 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited  2-Oct-2023 11:43 by rmk")


                                                              (* ; "Edited 31-May-2023 10:25 by rmk")


                                                              (* ; "Edited 27-May-2023 11:16 by rmk")


@@ -540,31 +837,25 @@
     (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
                                      NIL TEXTOBJ)
            TEXTOBJ
-           (\TEDIT.UPDATE.SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+           (\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
                   EVENT))
     (SETTH (\TEDIT.LASTEVENT TEXTOBJ)
            THACTION ACTION])
 
-(\TEDIT.REDO.MOVE

-  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
                 (* ; "Edited 15-Mar-2024 13:36 by rmk")


-                                                             (* ; "Edited 16-Feb-2024 23:36 by rmk")


-                                                             (* ; "Edited  7-Jun-2023 23:19 by rmk")


-                                                             (* ; "Edited 27-May-2023 11:18 by rmk")


-                                                             (* ; "Edited 23-May-2023 12:54 by rmk")


-                                                             (* ; "Edited 30-May-91 21:28 by jds")

-    (LET ((SCR2 (GETTOBJ TEXTOBJ SCRATCHSEL2)))
-         (\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#)
-                LEN)
-         (SETSEL SCR2 SET T)
-         (\TEDIT.FIXSEL SCR2 TEXTOBJ)
-         (\TEDIT.SET.SEL.LOOKS SCR2 'MOVE)
-         (TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL])
+(\TEDIT.REDO.COMPOSITE

+  [LAMBDA (TEXTOBJ EVENT SEL)
                                (* ; "Edited 21-Oct-2024 00:26 by rmk")


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

+    (\TEDIT.THELP 'Redo-composite])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD 
-6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) (
-\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162 
-(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 . 
-29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) (
-\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323)))))
+  (FILEMAP (NIL (4922 5943 (\TEDIT.HISTORYEVENT.DEFPRINT 4932 . 5941)) (7033 17618 (\TEDIT.HISTORYADD 
+7043 . 11904) (\TEDIT.HISTORYADD.COMPOSITE 11906 . 12812) (\TEDIT.CUMULATE.EVENTS 12814 . 14408) (
+\TEDIT.COMPOSITE.EVENT 14410 . 15146) (\TEDIT.HISTORY.PROP 15148 . 16511) (\TEDIT.HISTORY.EVENT 16513
+ . 17442) (\TEDIT.POPEVENT 17444 . 17616)) (17671 36249 (TEDIT.UNDO 17681 . 22240) (\TEDIT.UNDO1 22242
+ . 26663) (TEDIT.REDO 26665 . 33403) (\TEDIT.UNDO.UNDO 33405 . 36247)) (36250 51567 (
+\TEDIT.UNDO.INSERT 36260 . 37173) (\TEDIT.UNDO.DELETE 37175 . 37969) (\TEDIT.UNDO.MOVE 37971 . 39560) 
+(\TEDIT.UNDO.REPLACE 39562 . 40779) (\TEDIT.UNDO.CHARLOOKS 40781 . 45355) (\TEDIT.UNDO.PARALOOKS 45357
+ . 49589) (\TEDIT.UNDO.PAGELOOKS 49591 . 50000) (\TEDIT.UNDO.COMPOSITE 50002 . 51229) (
+\TEDIT.UNDO.REPLACECODE 51231 . 51565)) (51568 53928 (\TEDIT.REDO.INSERT 51578 . 52311) (
+\TEDIT.REDO.REPLACE 52313 . 53644) (\TEDIT.REDO.COMPOSITE 53646 . 53926)))))
 STOP

library/tedit/TEDIT-PCTREE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239
 66617  
+
(FILECREATED " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248
 68998  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.INSERTPIECES)
+      :CHANGES-TO (FNS \TEDIT.MAKEPCTB)
 
-      :PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
+      :PREVIOUS-DATE " 7-Feb-2025 08:31:28" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;246)
 
 
 (PRETTYCOMPRINT TEDIT-PCTREECOMS)
@@ -25,7 +25,7 @@
                       (RECORDS BTREENODE BTSLOT)
                       (MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT 
                              \FINDSLOT)
-                      (MACROS \LASTPIECEP)
+                      (MACROS \SUFFIXPIECEP)
                       (I.S.OPRS inslots inpieces backpieces))
                (MACROS \INSURE.VACANT.BTREESLOT)
                (ADDVARS (INSPECTDONTSORTFIELDS BTREENODE)))
@@ -138,9 +138,9 @@
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \LASTPIECEP
 MACRO
 (OPENLAMBDA (PC TOBJ)
-                              (AND (EQ PC (ffetch
 (TEXTOBJ LASTPIECE) of
 TOBJ))
-                                   PC)))
+(PUTPROPS \SUFFIXPIECEP
 MACRO
 (OPENLAMBDA (PC TOBJ)
+                                (AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE))
+                                     PC)))
 )
 (DECLARE%: EVAL@COMPILE 
 
@@ -215,7 +215,9 @@
 (DEFINEQ
 
 (\TEDIT.MAKEPCTB

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  7-Dec-2023 12:41 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  8-Feb-2025 20:14 by rmk")


+                                                             (* ; "Edited  7-Feb-2025 08:02 by rmk")


+                                                             (* ; "Edited  7-Dec-2023 12:41 by rmk")


                                                              (* ; "Edited 31-Oct-2023 10:09 by rmk")


                                                              (* ; "Edited  8-Sep-2023 16:30 by rmk")


                                                              (* ; "Edited 26-Apr-2023 14:03 by rmk")


@@ -236,8 +238,8 @@
                         PLEN _ 0
                         PTREENODE _ NODE
                         PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
-                        PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC)))
-         (FSETTOBJ TEXTOBJ LASTPIECE (ffetch
 (BTREENODE DOWN1) of
 NODE))
+                        PPARALOOKS _ (GETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
+         (FSETTOBJ TEXTOBJ SUFFIXPIECE (ffetch
 (BTREENODE DOWN1) of
 NODE))
          (FSETTOBJ TEXTOBJ HINTPC NIL)
          (FSETTOBJ TEXTOBJ TEXTLEN 0)
          (FSETTOBJ TEXTOBJ PCTB (CONS NODE])
@@ -272,19 +274,26 @@
                     DELTA])
 
 (\TEDIT.FIRSTPIECE

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 31-Oct-2023 19:37 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  7-Feb-2025 08:02 by rmk")


+                                                             (* ; "Edited 21-Aug-2024 16:07 by rmk")


+                                                             (* ; "Edited 31-Oct-2023 19:37 by rmk")


                                                              (* ; "Edited 11-Apr-2023 12:54 by rmk")


                                                              (* ; "Edited 24-Aug-2022 12:45 by rmk")

-    (for
 (NODE _ (CAR (GETTOBJ TEXTOBJ PCTB))) by
 (ffetch
 (BTREENODE DOWN1) of
 NODE)
+    (for
 (NODE _ (CAR (GETTOBJ (if
 (type?
 TEXTOBJ TEXTOBJ)
+                                   then
 TEXTOBJ
+                                 elseif
 (type?
 STREAM TEXTOBJ)
+                                   then
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXTOBJ))
+                             PCTB))) by
 (ffetch
 (BTREENODE DOWN1) of
 NODE)
        unless
 (type?
 BTREENODE NODE) do
 
 
                                  (* ;; "If we don't bottom out in a piece, something else is screwed up.  But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")

 
-                                        (RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
+                                        (RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
                                                        NODE])
 
 (\TEDIT.DELETETREE

-  [LAMBDA (OLD
 PCNODE TEXTOBJ)
                               (* ; "Edited 17-Mar-2024 00:22 by rmk")


+  [LAMBDA (OLD
 PCNODE TEXTOBJ)
                               (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:22 by rmk")


                                                              (* ; "Edited 31-Oct-2023 10:23 by rmk")


                                                              (* ; "Edited 26-Oct-2023 12:50 by rmk")


                                                              (* ; "Edited 30-May-2023 08:58 by rmk")


@@ -313,7 +322,7 @@
 
                (bind
 TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE))
                   first
 (SETQ OLDSLOT (\FINDSLOT PCNODE OLD))
-                        (CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE"))
+                        (CL:UNLESS OLDSLOT (\TEDIT.THELP "Piece/node not in PCNODE"))
                         (CL:WHEN (EQ OLDSLOT LAST)           (* ; "Just shrink by one")

                             (\FILLSLOT OLDSLOT NIL 0)
                             (GO $$OUT))
@@ -377,16 +386,16 @@
          NEW])
 
 (\TEDIT.LASTPIECE

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 31-Oct-2023 10:20 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  7-Feb-2025 08:20 by rmk")


+                                                             (* ; "Edited 31-Oct-2023 10:20 by rmk")


                                                              (* ; "Edited 12-Apr-2023 19:23 by rmk")


                                                              (* ; "Edited 21-Aug-2022 17:13 by rmk")


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


                                                              (* ; "Edited 14-Apr-93 16:29 by jds")

 
-    (* ;; "Returns the LASTPIECE by running down the right side of the B-tree.  Should be the same as (fetch LASTPIECE of TEXTOBJ).  Argument can also be a node.")

+    (* ;; "Returns the last real piece of the text, NIL for an empty document.")

 
-    (bind
 [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while
 (type?
 BTREENODE CHILD)
-       do
 (SETQ CHILD (ffetch
 (BTSLOT DOWN) of
 (\LASTSLOT CHILD))) finally
 (RETURN CHILD])
+    (PREVPIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE])
 
 (\TEDIT.PCTOCH

   [LAMBDA (PC TEXTOBJ)
                                       (* ; "Edited 31-Oct-2023 21:05 by rmk")


@@ -415,7 +424,8 @@
                                                                           of
 TOPNODE])
 
 (\TEDIT.CHTOPC

-  [LAMBDA (CH# TEXTOBJ TELL-PC-START?)
                       (* ; "Edited  4-Nov-2023 17:56 by rmk")


+  [LAMBDA (CH# TEXTOBJ TELL-PC-START?)
                       (* ; "Edited  7-Feb-2025 08:29 by rmk")


+                                                             (* ; "Edited  4-Nov-2023 17:56 by rmk")


                                                              (* ; "Edited  1-Nov-2023 23:29 by rmk")


                                                              (* ; "Edited 13-Apr-2023 22:22 by rmk")


                                                              (* ; "Edited 12-Apr-2023 09:49 by rmk")


@@ -429,7 +439,7 @@
 
     (* ;; "There are 2 acceleration cases:")

 
-    (* ;; "     if CH# is after the current text length, the pseudo LASTPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")

+    (* ;; "     if CH# is after the current text length, the pseudo SUFFIXPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")

 
     (* ;; "    If the TEXTOBJ contains a HINTPC and CH# is in the range HINTPCSTARTCH# and HINTPCSTARTCH#+PLEN-1, then HINTPC is returned. Others may cache that, but we cache it here too for repeated sequential calls.")

 
@@ -441,7 +451,7 @@
      (if
 (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))
          then
 (CL:WHEN TELL-PC-START?
                   (SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
-              (FGETTOBJ TEXTOBJ LASTPIECE)
+              (FGETTOBJ TEXTOBJ SUFFIXPIECE)
        elseif
 (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC))
                    (IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)))
                    (ILESSP (IDIFFERENCE CH# STARTCH)
@@ -457,7 +467,7 @@
 
                           (* ;; "When PCTB is a list of top-level BTNODES, we find the sub-tree that contains the global CH# piece, sum the TOTLEN's of all prior top-level nodes, retrieve the piece from the identified subtree after adjusting to its LOCAL#.  START-OF-PIECE, if required, is globally correct.")

 
-                          (* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the LASTPIECE case above. Also look at \INSERTPIECE.")

+                          (* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the SUFFIXPIECE case above. Also look at \INSERTPIECE.")

 
                           (for
 old
 BASE-NODE NEXT in
 (FGETTOBJ TEXTOBJ PCTB)
                              do
 (SETQ NEXT (IPLUS ALLPRIOR (ffetch
 (BTREENODE TOTLEN) of
 BASE-NODE)))
@@ -504,18 +514,20 @@
                             (RETURN NODE])
 
 (\TEDIT.SET-TOTLEN

-  [LAMBDA (PCNODE)
                                           (* ; "Edited 21-Oct-2023 17:22 by rmk")


+  [LAMBDA (PCNODE)
                                           (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 21-Oct-2023 17:22 by rmk")


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


                                                              (* ; "Edited  9-May-93 15:40 by jds")

 
     (* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")

 
-    (HELP 'NOTCALLED)
+    (\TEDIT.THELP 'NOTCALLED)
     (replace
 (BTREENODE TOTLEN) of
 PCNODE with
 (for
 S inslots
 PCNODE sum
 (fetch
 (BTSLOT DLEN)
                                                                             of
 S])
 
 (\TEDIT.MAKE.VACANT.BTREESLOT

-  [LAMBDA (BTNODE TEXTOBJ)
                                   (* ; "Edited 16-Mar-2024 10:23 by rmk")


+  [LAMBDA (BTNODE TEXTOBJ)
                                   (* ; "Edited 21-Oct-2024 00:26 by rmk")


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


                                                              (* ; "Edited  7-Dec-2023 21:08 by rmk")


                                                              (* ; "Edited 31-Oct-2023 10:32 by rmk")


                                                              (* ; "Edited 10-Jun-2023 00:13 by rmk")


@@ -563,7 +575,7 @@
                     (UNINTERRUPTABLY
                         (replace
 (BTREENODE UPWARD) of
 BTNODE with
 PARENT)
                         (RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB))
-                                    (HELP "BTNODE NOT FOUND"))
+                                    (\TEDIT.THELP "BTNODE NOT FOUND"))
                                PARENT)))
 
              (* ;; "Tree is still valid, but PARENT how has a needed empty slot.")

@@ -620,16 +632,17 @@
              (\TEDIT.BTVALIDATE
 '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
 
 (\TEDIT.LINKNEWPIECE

-  [LAMBDA (NEW NEXT TEXTOBJ)
                                 (* ; "Edited 29-May-2023 23:16 by rmk")

+  [LAMBDA (NEW NEXT TEXTOBJ)
                                 (* ; "Edited  7-Feb-2025 08:26 by rmk")


+                                                             (* ; "Edited 29-May-2023 23:16 by rmk")

 
     (* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain.  This doesn't deal with the btree.")

 
-    (* ;; "NEXT=NIL denotes the last piece LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")

+    (* ;; "NEXT=NIL denotes the last piece SUFFIXPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")

 
     (CL:UNLESS NEXT
-        (SETQ NEXT (ffetch
 (TEXTOBJ LASTPIECE) of
 TEXTOBJ)))
+        (SETQ NEXT (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
     (LET ((NEXTPREV (PREVPIECE NEXT)))
-         (freplace
 (PIECE NEXTPIECE) of
 NEW with
 (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ)
+         (freplace
 (PIECE NEXTPIECE) of
 NEW with
 (CL:UNLESS (\SUFFIXPIECEP NEXT TEXTOBJ)
                                                         NEXT))
                                                              (* ; "NIL for last piece")

          (freplace
 (PIECE PREVPIECE) of
 NEW with
 NEXTPREV)   (* ; 
@@ -643,19 +656,22 @@
          NEW])
 
 (\TEDIT.UNLINKPIECE

-  [LAMBDA (PREV PC TEXTOBJ)
                                  (* ; "Edited 21-Oct-2023 17:24 by rmk")


+  [LAMBDA (PREV PC TEXTOBJ)
                                  (* ; "Edited  7-Feb-2025 08:04 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 21-Oct-2023 17:24 by rmk")


                                                              (* ; "Edited 30-May-2023 00:31 by rmk")

 
     (* ;; "Takes PC out of the piece chain, linking prev and next around it.")

 
-    (HELP 'NOTCALLED?)
+    (\TEDIT.THELP 'NOTCALLED?)
     (CL:WHEN PREV
         (freplace
 (PIECE NEXTPIECE) of
 PREV with
 (NEXTPIECE PC)))
     (freplace
 (PIECE PREVPIECE) of
 (OR (NEXTPIECE PC)
-                                       (ffetch
 (TEXTOBJ LASTPIECE) of
 TEXTOBJ)) with
 PREV])
+                                       (FGETTOBJ TEXTOBJ SUFFIXPIECE)) with
 PREV])
 
 (\TEDIT.SPLITPIECE

-  [LAMBDA (PC CHOFFSET TEXTOBJ)
                              (* ; "Edited 17-Mar-2024 00:11 by rmk")


+  [LAMBDA (PC CHOFFSET TEXTOBJ)
                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:11 by rmk")


                                                              (* ; "Edited 28-Dec-2023 22:17 by rmk")


                                                              (* ; "Edited  7-Dec-2023 21:07 by rmk")


                                                              (* ; "Edited 25-Nov-2023 11:50 by rmk")


@@ -687,7 +703,7 @@
                               (CONSTANT (APPEND STRING.PTYPES FILE.PTYPES)))
                                                              (* ; 
 
                  "Dont' want the error under the UNINTERRABPTABLY.  Remove when everything is good.")

-                 (SHOULDNT "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
+                 (\TEDIT.THELP "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
 
              (* ;; "")

 
@@ -722,7 +738,8 @@
     PC])
 
 (\TEDIT.INSERTPIECE

-  [LAMBDA (NEWPC NEXTPC TEXTOBJ)
                             (* ; "Edited 17-Mar-2024 00:11 by rmk")


+  [LAMBDA (NEWPC NEXTPC TEXTOBJ)
                             (* ; "Edited  7-Feb-2025 08:28 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:11 by rmk")


                                                              (* ; "Edited  7-Dec-2023 21:07 by rmk")


                                                              (* ; "Edited 31-Oct-2023 23:05 by rmk")


                                                              (* ; "Edited  9-Jun-2023 22:40 by rmk")


@@ -731,15 +748,15 @@
 
     (* ;; "Insert the piece NEWPC in front of the piece NEXTPC.  At the end, NEWPC appears before NEXTPC in the piece tree, and all counts and lengths are consistent.")

 
-    (* ;; "The last piece LASTPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the lastpiece has its rightful place in the tree.")

+    (* ;; "The last piece SUFFIXPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the  suffix piece has its rightful place in the tree.")

 
     (* ;; "Caller guarantees that the chain links of NEW can be smashed.")

 
     (\TEDIT.BTVALIDATE
 '\TEDIT.INSERTPIECE 'START TEXTOBJ)
     (FSETTOBJ TEXTOBJ HINTPC NIL)
     (CL:UNLESS NEXTPC
-        (SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
-    (CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
+        (SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
+    (CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
                                                              (* ; "Inserting at the very end")

         (LET ((PCTB (FGETTOBJ TEXTOBJ PCTB))
               LASTTREECONS)
@@ -775,7 +792,8 @@
     NEWPC])
 
 (\TEDIT.INSERTPIECES

-  [LAMBDA (PIECES NEXTPC TEXTOBJ)
                            (* ; "Edited 20-Mar-2024 10:55 by rmk")


+  [LAMBDA (PIECES NEXTPC TEXTOBJ)
                            (* ; "Edited  7-Feb-2025 08:04 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 10:55 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:41 by rmk")


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


                                                              (* ; "Edited  7-Dec-2023 21:08 by rmk")


@@ -793,7 +811,7 @@
         (FSETTOBJ TEXTOBJ HINTPC NIL)
         (FSETTOBJ TEXTOBJ \DIRTY T)
         (CL:UNLESS NEXTPC
-            (SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
+            (SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
         (for
 PC (PREVPC _ (PREVPIECE NEXTPC)) inpieces
 PIECES
            do
 
               (* ;; "This is a variant of \INSERTPIECE specialized for filling in an empty TEXTOBJ from a piece chain.  Insertion always happens before NEXTPC,  and the chain-links are not smashed. ")

@@ -809,7 +827,7 @@
 
                                          (* ;; "PC is the final piece of the chain")

 
-                                         (CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))
+                                         (CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
                                                 (FSETPC PC NEXTPIECE NEXTPC))
                                          (FSETPC NEXTPC PREVPIECE PC)
                                          (CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES))
@@ -817,7 +835,9 @@
     PIECES])
 
 (\TEDIT.DELETEPIECES

-  [LAMBDA (SELPIECES TEXTOBJ)
                                (* ; "Edited 16-Mar-2024 10:00 by rmk")


+  [LAMBDA (SELPIECES TEXTOBJ)
                                (* ; "Edited  7-Feb-2025 08:08 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 10:50 by rmk")


+                                                             (* ; "Edited 16-Mar-2024 10:00 by rmk")


                                                              (* ; "Edited 25-Nov-2023 12:12 by rmk")


                                                              (* ; "Edited  4-Nov-2023 23:03 by rmk")


                                                              (* ; "Edited 22-Oct-2023 11:43 by rmk")


@@ -829,7 +849,7 @@
 
     (* ;; "As the PC is deleted from the tree on each iteration, the original previous PREV piece is linked to PC's next, and the next PREVPIECE is linked to PREV so that the tree and the links are uninterruptably consistent.")

 
-    (* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection.  If SPLAST is the final actual piece (its NEXTPIECE is NIL), then LASTPIECE's PREVPIECE will be updated.")

+    (* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection.  If SPLAST is the final actual piece (its NEXTPIECE is NIL), then SUFFIXPIECE's PREVPIECE will be updated.")

 
     (* ;; " Since the pieces are not unlinked on the fly, the tree may be invalid until all the pieces are gone.")

 
@@ -837,10 +857,11 @@
 
     (\TEDIT.BTVALIDATE
 '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
     (for
 PC PREV NEXT first
 (FSETTOBJ TEXTOBJ HINTPC NIL)
-                            (SETQ PREV (PREVPIECE (fetch
 (SELPIECES SPFIRST) of
 SELPIECES))) 
+                            (SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST))) 
                                                              (* ; "For incremental chain-update")

-                            (SETQ NEXT (OR (NEXTPIECE (fetch
 (SELPIECES SPLAST) of
 SELPIECES))
-                                           (FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces
 SELPIECES
+                            (SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
+                                           (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
+                            (FSETTOBJ TEXTOBJ \DIRTY T) inselpieces
 SELPIECES
        do
 (UNINTERRUPTABLY
               (\TEDIT.UPDATEPCNODES
 PC (IMINUS (PLEN PC))
                      TEXTOBJ)
@@ -856,14 +877,15 @@
                                                   (* ;; 
 
           "TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.")

 
-                                                  (FSETPC (fetch
 (SELPIECES SPFIRST) of
 SELPIECES)
+                                                  (FSETPC (GETSPC SELPIECES SPFIRST)
                                                          PREVPIECE NIL)
-                                                  (FSETPC (fetch
 (SELPIECES SPLAST) of
 SELPIECES)
+                                                  (FSETPC (GETSPC SELPIECES SPLAST)
                                                          NEXTPIECE NIL))
     (\TEDIT.BTVALIDATE
 '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
 
 (\TEDIT.ALIGNEDPIECE

-  [LAMBDA (CHNO TEXTOBJ)
                                     (* ; "Edited 17-Mar-2024 00:27 by rmk")


+  [LAMBDA (CHNO TEXTOBJ)
                                     (* ; "Edited  7-Feb-2025 08:05 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:27 by rmk")


                                                              (* ; "Edited 31-Oct-2023 19:37 by rmk")


                                                              (* ; "Edited 29-May-2023 23:48 by rmk")


                                                              (* ; "Edited 20-May-2023 13:53 by rmk")


@@ -878,7 +900,7 @@
         then
 
              (* ;; "Doesn't return NIL in this case, returns the last piece.")

 
-             (FGETTOBJ TEXTOBJ LASTPIECE)
+             (FGETTOBJ TEXTOBJ SUFFIXPIECE)
       elseif
 (ILEQ CHNO 1)
         then
 (\TEDIT.FIRSTPIECE
 TEXTOBJ)
       else
 (LET (PC START-OF-PIECE)
@@ -944,13 +966,14 @@
            T])
 
 (\TEDIT.CHECK-BTREE

-  [LAMBDA (TEXTOBJ EMBEDDED)
                                 (* ; "Edited 17-Mar-2024 00:25 by rmk")


+  [LAMBDA (TEXTOBJ EMBEDDED)
                                 (* ; "Edited  7-Feb-2025 08:07 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:25 by rmk")


                                                              (* ; "Edited 21-Oct-2023 17:33 by rmk")


                                                              (* ; "Edited  7-Sep-2022 09:43 by rmk")


                                                              (* ; "Edited  4-Sep-2022 16:37 by rmk")

     (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
-    (for
 BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside
 (FGETTOBJ TEXTOBJ PCTB)
-       declare
 (SPECVARS LASTPIECE) do
 (\TEDIT.CHECK-BTREE1
 BT 0 NIL))
+    (for
 BT (SUFFIXPIECE _ (FGETTOBJ TEXTOBJ SUFFIXPIECE)) inside
 (FGETTOBJ TEXTOBJ PCTB)
+       declare
 (SPECVARS SUFFIXPIECE) do
 (\TEDIT.CHECK-BTREE1
 BT 0 NIL))
     (for
 PC inpieces
 (\TEDIT.FIRSTPIECE
 TEXTOBJ)
        do
 (SELECTC (PTYPE PC)
               (FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
@@ -977,7 +1000,8 @@
     'VALID])
 
 (\TEDIT.CHECK-BTREE1

-  [LAMBDA (NODE DEPTH PARENT)
                                (* ; "Edited 31-Oct-2023 10:35 by rmk")


+  [LAMBDA (NODE DEPTH PARENT)
                                (* ; "Edited  7-Feb-2025 08:31 by rmk")


+                                                             (* ; "Edited 31-Oct-2023 10:35 by rmk")


                                                              (* ; "Edited 30-May-2023 00:06 by rmk")


                                                              (* ; "Edited 27-May-2023 15:00 by rmk")


                                                              (* ; "Edited  1-Sep-2022 09:49 by rmk")


@@ -987,30 +1011,30 @@
     (* ;; 
 
  "Returns the TOTLEN/PLEN of NODE, after verifying that all of the nodes underneath are consistent.")

 
-    (DECLARE
 (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE))
+    (DECLARE
 (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ SUFFIXPIECE))
     (ADD
 DEPTH 1)
     (if
 (type?
 PIECE NODE)
-        then
 [if
 (EQ NODE LASTPIECE)
-                 then
 (CL:WHEN (AND (PREVPIECE LASTPIECE)
-                                    (NEXTPIECE (PREVPIECE LASTPIECE)))
-                             (\TEDIT.BTFAIL
 "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
+        then
 [if
 (EQ NODE SUFFIXPIECE)
+                 then
 (CL:WHEN (AND (PREVPIECE SUFFIXPIECE)
+                                    (NEXTPIECE (PREVPIECE SUFFIXPIECE)))
+                             (\TEDIT.BTFAIL
 "(NEXT (PPREV of SUFFIXPIECE is not NULL" SUFFIXPIECE))
                else
 (CL:UNLESS (IGEQ (PLEN NODE)
                                      0)
                            (\TEDIT.BTFAIL
 "Negative PLEN" NODE))
                     (CL:UNLESS (OR (NEXTPIECE NODE)
-                                   (EQ NODE (PREVPIECE LASTPIECE)))
-                           (\TEDIT.BTFAIL
 "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
+                                   (EQ NODE (PREVPIECE SUFFIXPIECE)))
+                           (\TEDIT.BTFAIL
 "PIECE with no NEXT is not PREV of SUFFIXPIECE" NODE))
                     (CL:UNLESS (EQ PARENT (fetch
 (PIECE PTREENODE) of
 NODE))
                            (\TEDIT.BTFAIL
 "Piece with wrong PTREENODE" NODE))
                     (CL:WHEN (PREVPIECE NODE)
                         (CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE)))
                                        (AND (NULL (NEXTPIECE (PREVPIECE NODE)))
-                                            (EQ NODE LASTPIECE)))
+                                            (EQ NODE SUFFIXPIECE)))
                                (\TEDIT.BTFAIL
 "PREVPIECE is not consistent" NODE)))
                     (CL:WHEN (OR (NEXTPIECE NODE)
-                                 LASTPIECE)
+                                 SUFFIXPIECE)
                         (CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
-                                                           LASTPIECE)))
+                                                           SUFFIXPIECE)))
                                (\TEDIT.BTFAIL
 "NEXTPIECE is not consistent" NODE)))]
              (add
 NPIECES 1)
              (add
 [CDR (OR (SASSOC DEPTH DEPTHHIST)
@@ -1057,12 +1081,13 @@
 
 (\TEDIT.BTFAIL

   [LAMBDA (STRING VAL)
-    (DECLARE
 (USEDFREE TAG MSG))
                             (* ; "Edited 28-May-2023 08:45 by rmk")

-    (HELP (CONCAT (OR TAG "")
-                 " "
-                 (OR MSG "")
-                 ": " STRING)
-          VAL])
+    (DECLARE
 (USEDFREE TAG MSG))
                             (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 28-May-2023 08:45 by rmk")

+    (\TEDIT.THELP (CONCAT (OR TAG "")
+                         " "
+                         (OR MSG "")
+                         ": " STRING)
+           VAL])
 
 (\TEDIT.MATCHPCS

   [LAMBDA (NODE)
                                             (* ; "Edited 16-Mar-2024 11:07 by rmk")


@@ -1085,13 +1110,13 @@
 (GLOBALVARS BTVALIDATETAGS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
-\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) (
-\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) (
-\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE 
-35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) (
-\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 . 
-52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) (
-\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693
- . 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492)))))
+  (FILEMAP (NIL (8685 56524 (\TEDIT.MAKEPCTB 8695 . 10475) (\TEDIT.UPDATEPCNODES 10477 . 12771) (
+\TEDIT.FIRSTPIECE 12773 . 14180) (\TEDIT.DELETETREE 14182 . 17456) (\TEDIT.INSERTTREE 17458 . 20203) (
+\TEDIT.LASTPIECE 20205 . 21012) (\TEDIT.PCTOCH 21014 . 23111) (\TEDIT.CHTOPC 23113 . 29290) (
+\TEDIT.SET-TOTLEN 29292 . 30080) (\TEDIT.MAKE.VACANT.BTREESLOT 30082 . 36812) (\TEDIT.LINKNEWPIECE 
+36814 . 38403) (\TEDIT.UNLINKPIECE 38405 . 39225) (\TEDIT.SPLITPIECE 39227 . 43883) (
+\TEDIT.INSERTPIECE 43885 . 47157) (\TEDIT.INSERTPIECES 47159 . 50251) (\TEDIT.DELETEPIECES 50253 . 
+54407) (\TEDIT.ALIGNEDPIECE 54409 . 56522)) (56552 68875 (\TEDIT.BTVALIDATE 56562 . 58103) (
+\TEDIT.BTVALIDATE.PRINT 58105 . 59470) (\TEDIT.CHECK-BTREE 59472 . 61799) (\TEDIT.CHECK-BTREE1 61801
+ . 67432) (\TEDIT.BTFAIL 67434 . 67856) (\TEDIT.MATCHPCS 67858 . 68873)))))
 STOP

library/tedit/TEDIT-RENAMES

@@ -0,0 +1,172 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED " 2-Aug-2024 08:48:45" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;5
 7187   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS TEDITSYMBOLMAP)
+
+      :PREVIOUS-DATE "22-Jul-2024 11:31:22" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;4)
+
+
+(PRETTYCOMPRINT TEDIT-RENAMESCOMS)
+
+(RPAQQ TEDIT-RENAMESCOMS
 (
+                          (* ;; "TEDITSYMBOLMAP is a list that maps names for current TEDIT items  (e.g.  \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE).")

+
+                          
+                          (* ;; 
+
                        "FORWARDEDFILES  maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")

+
+                          (VARS TEDITSYMBOLMAP)
+                          (VARS FORWARDEDFILES)))
+
+
+
+(* ;; 
+"TEDITSYMBOLMAP is a list that maps names for current TEDIT items  (e.g.  \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE)."
+)

+
+
+
+
+(* ;; "FORWARDEDFILES  maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")

+
+
+(RPAQQ TEDITSYMBOLMAP

+       ((MB.NB.ARRANGEBUTTONS MB.NB.PACKITEMS)
+        (MB.NWAYBUTTON.BUTTONEVENTINFN MB.NWAYBUTTON.SELFN)
+        (\TEDIT.BTFAIL BTFAIL)
+        (\TEDIT.BTVALIDATE BTVALIDATE)
+        (\TEDIT.BTVALIDATE.PRINT BTVALIDATE.PRINT)
+        (\TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.LOOKS)
+        (\TEDIT.CHECK-BTREE CHECK-BTREE)
+        (\TEDIT.CHECK-BTREE1 CHECK-BTREE1)
+        (\TEDIT.EQCLOOKS EQCLOOKS)
+        (\TEDIT.EQFMTSPEC EQFMTSPEC)
+        (\TEDIT.REOPENTEXTSTREAM REOPENTEXTSTREAM)
+        (\TEDIT.SAMECLOOKS SAMECLOOKS)
+        (\TEDIT.DO.BLUEPENDINGDELETE TEDIT.DO.BLUEPENDINGDELETE)
+        (\TEDIT.FORMATBOX TEDIT.FORMATBOX)
+        (\TEDIT.FORMATFOLIO TEDIT.FORMATFOLIO)
+        (\TEDIT.FORMATHEADING TEDIT.FORMATHEADING)
+        (\TEDIT.FORMATPAGE TEDIT.FORMATPAGE)
+        (\TEDIT.FORMATTEXTBOX TEDIT.FORMATTEXTBOX)
+        (\TEDIT.GET.CHARLOOKS0 TEDIT.GET.CHARLOOKS0)
+        (\TEDIT.GET.OBJECT TEDIT.GET.OBJECT)
+        (\TEDIT.GET.OBJECT0 TEDIT.GET.OBJECT0)
+        (\TEDIT.GET.PARALOOKS0 TEDIT.GET.PARALOOKS0)
+        (\TEDIT.GET.PCTB0 TEDIT.GET.PCTB0)
+        (\TEDIT.PUT.OBJECT TEDIT.PUT.OBJECT)
+        (\TEDIT.RESET.EXTEND.PENDING.DELETE TEDIT.RESET.EXTEND.PENDING.DELETE)
+        (\TEDIT.SELECTED.PIECES TEDIT.SELECTED.PIECES)
+        (\TEDIT.UPDATE.SCREEN TEDIT.UPDATE.SCREEN)
+        (\TEDIT.ALIGNEDPIECE \ALIGNEDPIECE)
+        (\TEDIT.BACKFORMAT \BACKFORMAT)
+        (\TEDIT.CHTOPC \CHTOPC)
+        (\TEDIT.COPYSEL \COPYSEL)
+        (\TEDIT.CREATE.TEDIT.RESTART.MENU \CREATE.TEDIT.RESTART.MENU)
+        (\TEDIT.DELETEPIECES \DELETEPIECES)
+        (\TEDIT.DELETETREE \DELETETREE)
+        (\TEDIT.DISPLAYLINE \DISPLAYLINE)
+        (\TEDIT.DISPLAYLINE.TABS \DISPLAYLINE.TABS)
+        (\TEDIT.FILLPANE \FILLPANE)
+        (\TEDIT.FIRSTPIECE \FIRSTPIECE)
+        (\TEDIT.FIXSEL \FIXSEL)
+        (\TEDIT.FORMATBLOCK \FORMATBLOCK)
+        (\TEDIT.FORMATLINE \FORMATLINE)
+        (\TEDIT.FORMATLINE.EMPTY \FORMATLINE.EMPTY)
+        (\TEDIT.FORMATLINE.JUSTIFY \FORMATLINE.JUSTIFY)
+        (\TEDIT.FORMATLINE.LASTLEGAL \FORMATLINE.LASTLEGAL)
+        (\TEDIT.FORMATLINE.PURGE.SPACES \FORMATLINE.PURGE.SPACES)
+        (\TEDIT.FORMATLINE.SCALETABS \FORMATLINE.SCALETABS)
+        (\TEDIT.FORMATLINE.SETUP \FORMATLINE.SETUP)
+        (\TEDIT.FORMATLINE.TABS \FORMATLINE.TABS)
+        (\TEDIT.FORMATLINE.UPDATELOOKS \FORMATLINE.UPDATELOOKS)
+        (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \HARDCOPY.FORMATLINE.HEADINGS)
+        (\TEDIT.INSERT TEDIT.\INSERT)
+        (\TEDIT.INSERTCH \INSERTCH)
+        (\TEDIT.INSERTCH.EXTEND \INSERTCH.EXTEND)
+        (\TEDIT.INSERTCH.HISTORY \INSERTCH.HISTORY)
+        (\TEDIT.INSERTCH.INSERTION \INSERTCH.INSERTION)
+        (\TEDIT.INSERTEOL \INSERTEOL)
+        (\TEDIT.INSERTPIECE \INSERTPIECE)
+        (\TEDIT.INSERTPIECES \INSERTPIECES)
+        (\TEDIT.INSERTTREE \INSERTTREE)
+        (\TEDIT.LASTPIECE \LASTPIECE)
+        (\TEDIT.LINKNEWPIECE \LINKNEWPIECE)
+        (\TEDIT.MAKE.VACANT.BTREESLOT \MAKE.VACANT.BTREESLOT)
+        (\TEDIT.MAKEPCTB \MAKEPCTB)
+        (\TEDIT.MATCHPCS \MATCHPCS)
+        (\TEDIT.NAMEDTAB.INIT \NAMEDTAB.INIT)
+        (\TEDIT.PCTOCH \PCTOCH)
+        (\TEDIT.PRIMARYPANE \TEDIT.PRIMARYW)
+        (\TEDIT.SELPIECES \SELPIECES)
+        (\TEDIT.SELPIECES.CHARTRANSFORM \SELPIECES.CHARTRANSFORM)
+        (\TEDIT.SELPIECES.CONCAT \SELPIECES.CONCAT)
+        (\TEDIT.SELPIECES.COPY \SELPIECES.COPY)
+        (\TEDIT.SELPIECES.FROM.STRING \SELPIECES.FROM.STRING)
+        (\TEDIT.SELPIECES.TO.STRING \SELPIECES.TO.STRING)
+        (\TEDIT.SHOWSEL \SHOWSEL)
+        (\TEDIT.SPLITPIECE \SPLITPIECE)
+        (\TEDIT.TEDIT.FORMATLINES \TEDIT.FORMATLINES)
+        (\TEDIT.POSTSCRIPT.HARDCOPY \TEDIT.HARDCOPY)
+        (\TEDIT.TEDIT.HARDCOPY \TEDIT.HARDCOPY)
+        (\TEDIT.TEXTBACKFILEPTR \TEXTBACKFILEPTR)
+        (\TEDIT.TEXTBIN \TEXTBIN)
+        (\TEDIT.TEXTBOUT \TEXTBOUT)
+        (\TEDIT.TEXTCLOSEF \TEXTCLOSEF)
+        (\TEDIT.TEXTDSPCHARWIDTH \TEXTDSPCHARWIDTH)
+        (\TEDIT.TEXTDSPFONT \TEXTDSPFONT)
+        (\TEDIT.TEXTDSPLINEFEED \TEXTDSPLINEFEED)
+        (\TEDIT.TEXTDSPSTRINGWIDTH \TEXTDSPSTRINGWIDTH)
+        (\TEDIT.TEXTDSPXPOSITION \TEXTDSPXPOSITION)
+        (\TEDIT.TEXTDSPYPOSITION \TEXTDSPYPOSITION)
+        (\TEDIT.TEXTEOFP \TEXTEOFP)
+        (\TEDIT.TEXTGETEOFPTR \TEXTGETEOFPTR)
+        (\TEDIT.TEXTGETFILEPTR \TEXTGETFILEPTR)
+        (\TEDIT.TEXTINIT \TEXTINIT)
+        (\TEDIT.TEXTLEFTMARGIN \TEXTLEFTMARGIN)
+        (\TEDIT.TEXTOPENF \TEXTOPENF)
+        (\TEDIT.TEXTPEEKBIN \TEXTPEEKBIN)
+        (\TEDIT.TEXTRIGHTMARGIN \TEXTRIGHTMARGIN)
+        (\TEDIT.TEXTSETEOF \TEXTSETEOF)
+        (\TEDIT.TEXTSETFILEPTR \TEXTSETFILEPTR)
+        (\TEDIT.TEXTBACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
+        (\TEDIT.TEXTSTREAM.BACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
+        (\TEDIT.TEXTFORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
+        (\TEDIT.TEXTSTREAM.FORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
+        (\TEDIT.TEXTINCCODEFN \TEXTSTREAM.INCCCODEFN)
+        (\TEDIT.TEXTSTREAM.INCCCODEFN \TEXTSTREAM.INCCCODEFN)
+        (\TEDIT.TEXTOUTCHARFN \TEXTSTREAM.OUTCHARFN)
+        (\TEDIT.TEXTSTREAM.OUTCHARFN \TEXTSTREAM.OUTCHARFN)
+        (\TEDIT.TEXTTTYBOUT \TEXTTTYBOUT)
+        (\TEDIT.UNLINKPIECE \UNLINKPIECE)
+        (\TEDIT.UPDATEPCNODES \UPDATEPCNODES)
+        (\TEDIT.XYTOSEL \TEDIT.SELECT.LINE.SCANNER)))
+
+(RPAQQ FORWARDEDFILES

+       ((PCTREE TEDIT-PCTREE)
+        (TEDIT TEDIT)
+        (TEDIT-FILE TEDIT-FILE)
+        (TEDIT-TEXTOFD TEDIT-STREAM)
+        (TEDITABBREV TEDIT-ABBREV)
+        (TEDITCHAT TEDIT-CHAT)
+        (TEDITCOMMAND TEDIT-COMMAND)
+        (TEDITDCL TEDITDCL)
+        (TEDITDEBUG TEDIT-DEBUG)
+        (TEDITFILE TEDIT-FILE TEDIT-OLDFILE)
+        (TEDITFIND TEDIT-FIND)
+        (TEDITFNKEYS TEDIT-FNKEYS)
+        (TEDITHCPY TEDIT-HCPY)
+        (TEDITHISTORY TEDIT-HISTORY)
+        (TEDITLOOKS TEDIT-LOOKS)
+        (TEDITMENU TEDIT-MENU)
+        (TEDITPAGE TEDIT-PAGE)
+        (TEDITSCREEN TEDIT-SCREEN)
+        (TEDITSELECTION TEDIT-SELECTION)
+        (TEDITWINDOW TEDIT-WINDOW)
+        (TFBRAVO TEDIT-TFBRAVO)))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

library/tedit/TEDIT-STRESS

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Mar-2024 21:34:32" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;70
 15296  
+
(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}<library>tedit>TEDIT-STRESS.;71
 15583  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK)
-                  (VARS TEDIT-STRESSCOMS)
+      :CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
 
-      :PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;54)
+      :PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
 
 
 (PRETTYCOMPRINT TEDIT-STRESSCOMS)
@@ -25,6 +24,7 @@
 
 (STRESSHC

   [LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)

+                                                             (* ; "Edited 21-Oct-2024 00:26 by rmk")


                                                              (* ; "Edited 19-Mar-2024 21:33 by rmk")


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


                                                              (* ; "Edited 13-Mar-2024 00:23 by rmk")

@@ -83,7 +83,7 @@
                               T))
                 (CLOSEF? TSTRM)
                 (CL:WHEN SINGLESTEP
-                    (HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
+                    (\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
           (PRINTOUT T "  Hardcopied " N " files without failure" T)
        finally
 (RETURN (LIST R N])
 
@@ -121,7 +121,8 @@
                                                      T)) finally
 (RETURN (LIST R N])
 
 (STRESSPUT

-  [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP)
               (* ; "Edited 19-Mar-2024 21:34 by rmk")


+  [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP)
               (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 19-Mar-2024 21:34 by rmk")


                                                              (* ; "Edited 12-Mar-2024 09:48 by rmk")

 
     (* ;; "Opens, puts, reopens and tests for equivalence")

@@ -142,13 +143,13 @@
                                     (TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
                                     (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
                                     (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM
 TSTRM TSP STOP)))
-                                           (HELP "Get of put not equivalent" F))
+                                           (\TEDIT.THELP "Get of put not equivalent" F))
                                     (CLOSEF TSP))
                       else
 (SETQ TSTRM (OPENTEXTSTREAM F))
                            (TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
                            (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
                            (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM
 TSTRM TSP STOP)))
-                                  (HELP "Get of put not equivalent" F))
+                                  (\TEDIT.THELP "Get of put not equivalent" F))
                            (CLOSEF TSP))
                     then
 (CLOSEF TSTRM)
                          (add
 N 1)
@@ -242,7 +243,8 @@
 (DEFINEQ
 
 (EQTEXTSTREAM

-  [LAMBDA (TS1 TS2 STOP)
                                     (* ; "Edited 11-Mar-2024 16:53 by rmk")

+  [LAMBDA (TS1 TS2 STOP)
                                     (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 11-Mar-2024 16:53 by rmk")

     (AND (IEQP (TEDIT.NCHARS TS1)
                (TEDIT.NCHARS TS2))
          (OR (for
 I C1 C2 from
 1 to
 (TEDIT.NCHARS TS1) eachtime
 (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
@@ -255,8 +257,8 @@
                            (AND (IMAGEOBJP C1)
                                 (IMAGEOBJP C2)
                                 (EQUALALL C1 C2))) do
 (CL:WHEN STOP
-                                                          (HELP "Different characters: "
-                                                                (LIST I C1 C2)))
+                                                          (\TEDIT.THELP "Different characters: "
+                                                                 (LIST I C1 C2)))
                                                       (RETURN NIL) finally
 (RETURN T])
 
 (SYSOUTRING

@@ -293,7 +295,7 @@
        finally
 (CL:UNLESS NORECLAIM (RECLAIM])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) (
-STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695
-)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271)))))
+  (FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) (
+STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864
+)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558)))))
 STOP