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/workflows/buildDocker.yml

@@ -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

.github/workflows/buildReleaseInclDocker.yml

@@ -131,7 +131,7 @@ jobs:
         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 }}

.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,6 +30,7 @@ loadups/*.dribble
 loadups/whereis.hash
 loadups/apps.sysout
 loadups/fuller.database
+loadups/build/
 
 # manual cross-reference files
 

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

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/TEDIT-DEBUG

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Dec-2024 20:38:14" {WMEDLEY}<internal>TEDIT-DEBUG.;123
 130350 
+
(FILECREATED "29-Mar-2025 22:37:05" {WMEDLEY}<internal>TEDIT-DEBUG.;143
 131559 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS SP)
+      :CHANGES-TO (MACROS DEBUGOUTPUT)
+                  (FNS SP SL SSP SPF STL TEST.TEMPLATE)
 
-      :PREVIOUS-DATE "14-Dec-2024 14:32:20" {WMEDLEY}<internal>TEDIT-DEBUG.;122)
+      :PREVIOUS-DATE "28-Mar-2025 20:51:43" {WMEDLEY}<internal>TEDIT-DEBUG.;141)
 
 
 (PRETTYCOMPRINT TEDIT-DEBUGCOMS)
@@ -26,11 +27,14 @@
         (COMS                                                (* ; 
 
                                                "Get/set (default) object, stream, window, selection")

               (FNS GTO GTS GTW GSEL)
-              (INITVARS (LASTTEXTSTREAM NIL)))
+              (INITVARS (LASTTEXTSTREAM NIL))
+              (FNS TEST.TEMPLATE))
+        (FNS TESTACTION)
         (COMS                                                (* ; "Inspect")

               (FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES))
         (COMS                                                (* ; "Show")

-              (FNS SP SL SSP STL SPF SLF SHOWLINE SLL STBYTES))
+              (FNS SP SL SSP SPF SLF SHOWLINE SLL STBYTES SSEL)
+              (FNS STL CLEARTHISLINE))
         (COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES))
         (COMS (FNS FILEBYTES TFILEBYTES))
         (FNS TRELMOVE TSCROLL TSCROLL*)
@@ -52,7 +56,7 @@
               (FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC))
         (INITVARS (LASTTS NIL))
         (VARS (OK.TO.MODIFY.FNS T))
-        (FNS DFOV OLDWI DFOV.OLDEST COMP DFR)
+        (FNS OLDWI COMP DFR)
         (FNS DFGV GDIRECTORIES)
         (COMS (FNS TTEST LTEST THC)
               (INITVARS (LASTTTESTFILE))
@@ -70,7 +74,7 @@
         (FILES (NOERROR)
                VERSIONDEFS)
                                                              (* ; "Until this is release")

-        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV DFOV)
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV)
                                                                              (NLAML DFVENUE DFR)
                                                                              (LAMA])
 
@@ -109,14 +113,16 @@
              (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM))])
 
 (GTS

-  [LAMBDA (ARG NOERROR)
                                      (* ; "Edited 23-Nov-2024 11:38 by rmk")


+  [LAMBDA (ARG NOERROR)
                                      (* ; "Edited  1-Feb-2025 08:25 by rmk")


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


                                                              (* ; "Edited  4-Oct-2024 22:13 by rmk")


                                                              (* ; "Edited 21-Sep-2024 21:51 by rmk")


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

     (CL:UNLESS (AND (TEXTSTREAM LASTTEXTSTREAM T)
                     (OPENWP (\TEDIT.PRIMARYPANE LASTTEXTSTREAM)))
            (SETQ LASTTEXTSTREAM NIL))
-    (LET* ((TWINDOWS (for
 W in
 (OPENWINDOWS) when
 (WINDOWPROP W 'TEDITCREATED) collect
 W))
+    (LET* ((TWINDOWS (for
 W in
 (OPENWINDOWS) when
 (WINDOWPROP W 'TEDITCREATED)
+                        unless
 (WINDOWPROP W 'TEDIT-DEBUG) collect
 W))
            (TSTREAM (TEXTSTREAM (OR ARG (CL:IF (CDR TWINDOWS)
                                             (WHICHW)
                                             (CAR TWINDOWS)))
@@ -148,6 +154,39 @@
 )
 
 (RPAQ? LASTTEXTSTREAM
 NIL)
+(DEFINEQ
+
+(TEST.TEMPLATE

+  [LAMBDA (FILE)
                                             (* ; "Edited 29-Mar-2025 09:51 by rmk")

+    (CL:WHEN (AND (TEXTSTREAM LASTTEXTSTREAM)
+                  (TEDITWINDOWP LASTTEXTSTREAM)
+                  (OPENWP (TEDITWINDOWP LASTTEXTSTREAM)))
+        (TEXTPROP LASTTEXTSTREAM 'DIRTY NIL)
+        (CLOSEW (TEDITWINDOWP LASTTEXTSTREAM)))
+    (LET [(TSTREAM (TEXTSTREAM (TEDIT FILE NIL NIL '(LEAVETTY T]
+         (SETQ LASTTEXTSTREAM TSTREAM)
+         (GTS
 TSTREAM)
+         (STUFF TSTREAM)
+         TSTREAM])
+)
+(DEFINEQ
+
+(TESTACTION

+  [LAMBDA (CHAR TSTREAM)
                                     (* ; "Edited 23-Mar-2025 11:06 by rmk")

+
+    (* ;; "If CHAR is bound to an action in TSTREAM's read table, execute it.")

+
+    (SETQ TSTREAM (GTS
 TSTREAM))
+    (\TEDIT.COMMAND.FUNCTION? TSTREAM (if
 (CHARCODEP CHAR)
+                                          then
 CHAR
+                                        elseif
 (CHARCODEP CHAR T)
+                                        elseif
 (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM))
+                                          then
 (SETQ CHAR (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM)))
+                                               (CL:IF (CHARCODEP CHAR)
+                                                   CHAR
+                                                   (CHARCODE.DECODE CHAR))
+                                        else
 (ERROR CHAR "is not a keybinding"])
+)
 
 
 
@@ -321,25 +360,31 @@
                 (LENGTH UNDONEEVENTS])
 
 (IPCTB

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


+  [LAMBDA (ARG)
                                              (* ; "Edited 28-Mar-2025 20:42 by rmk")


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


                                                              (* ; "Edited  4-May-2023 20:28 by rmk")

-    (INSPECT (FETCH
 (TEXTOBJ PCTB) of
 (GTO
 ARG))
-           'LIST])
+    (SETQ ARG (GTO
 ARG))
+    (INSPECT (GETTOBJ ARG PCTB)
+           'LIST)
+    ARG])
 
 (IMB

-  [LAMBDA (KEY ARG)
                                          (* ; "Edited 22-Aug-2024 16:34 by rmk")


+  [LAMBDA (IDENTIFIER ARG)
                                   (* ; "Edited 28-Mar-2025 20:45 by rmk")


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


                                                              (* ; "Edited 21-Aug-2024 10:00 by rmk")


                                                              (* ; "Edited  8-Aug-2024 09:08 by rmk")


                                                              (* ; "Edited  4-Aug-2024 09:05 by rmk")

 
-    (* ;; "Inspect the menu button for KEY")

+    (* ;; "Inspect the menu button for IDENTIFIER")

 
-    (LET [(OBJ (MB.FIND KEY (GTO
 ARG)
+    (LET [(OBJ (MB.GET IDENTIFIER (GTO
 ARG)
                       'OBJECT]
-         (CL:IF OBJ (INSPECT OBJ NIL NIL KEY])
+         (CL:IF OBJ (INSPECT OBJ NIL NIL IDENTIFIER))
+         OBJ])
 
 (ICL

-  [LAMBDA (PC ARG)
                                           (* ; "Edited 25-Nov-2024 17:01 by rmk")


+  [LAMBDA (PC ARG)
                                           (* ; "Edited 28-Mar-2025 20:39 by rmk")


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


                                                              (* ; "Edited  4-Oct-2024 13:33 by rmk")

 
     (* ;; "Inspect the character looks of PC")

@@ -347,21 +392,27 @@
     (LET ((DECODED (IPC.DECODEARGS
 PC ARG)))
          (SETQ PC (POP
 DECODED))
          (INSPECT (PCHARLOOKS PC)
-                NIL NIL (CONCAT PC " " (POP
 DECODED])
+                NIL NIL (CONCAT PC " " (POP
 DECODED)))
+         (PCHARLOOKS PC])
 
 (IPL

-  [LAMBDA (PC ARG)
                                           (* ; "Edited 25-Nov-2024 17:01 by rmk")


+  [LAMBDA (PC ARG)
                                           (* ; "Edited 28-Mar-2025 20:39 by rmk")


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


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

     (LET ((DECODED (IPC.DECODEARGS
 PC ARG)))
          (SETQ PC (POP
 DECODED))
          (INSPECT (PPARALOOKS PC)
-                NIL NIL (CONCAT PC " " (POP
 DECODED])
+                NIL NIL (CONCAT PC " " (POP
 DECODED)))
+         (PPARALOOKS PC])
 
 (ICARET

-  [LAMBDA (ARG)
                                              (* ; "Edited 27-Nov-2024 13:48 by rmk")


+  [LAMBDA (ARG)
                                              (* ; "Edited 28-Mar-2025 20:40 by rmk")


+                                                             (* ; "Edited 27-Nov-2024 13:48 by rmk")


                                                              (* ; "Edited  4-Oct-2024 13:33 by rmk")


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

-    (INSPECT (PANECARET (GTW
 ARG])
+    (SETQ ARG (GTW
 ARG))
+    (INSPECT (PANECARET ARG))
+    (PANECARET ARG])
 
 (INSPECTPIECES

   [LAMBDA (PIECE N TAG WHERE)
                                (* ; "Edited 16-Mar-2024 10:07 by rmk")


@@ -393,25 +444,17 @@
 (DEFINEQ
 
 (SP

-  [LAMBDA (PC NP OFILE TOBJ FONT NOCR)
                       (* ; "Edited 16-Dec-2024 15:50 by rmk")


+  [LAMBDA (PC NP OFILE TOBJ FONT NOCR)
                       (* ; "Edited 29-Mar-2025 22:34 by rmk")


+                                                             (* ; "Edited  6-Jan-2025 22:18 by rmk")


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


                                                              (* ; "Edited 30-Nov-2024 19:34 by rmk")


-                                                             (* ; "Edited 26-Nov-2024 20:53 by rmk")


-                                                             (* ; "Edited 23-Nov-2024 15:35 by rmk")


                                                              (* ; "Edited  9-Sep-2024 14:53 by rmk")


-                                                             (* ; "Edited  1-Sep-2024 00:05 by rmk")


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


                                                              (* ; "Edited 15-Jun-2024 11:52 by rmk")


                                                              (* ; "Edited 21-May-2024 11:29 by rmk")


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


-                                                             (* ; "Edited  5-May-2024 12:56 by rmk")


-                                                             (* ; "Edited 29-Apr-2024 12:46 by rmk")


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


-                                                             (* ; "Edited 16-Mar-2024 10:07 by rmk")


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


                                                              (* ; "Edited  3-Jan-2024 00:41 by rmk")


-                                                             (* ; "Edited 27-Dec-2023 13:02 by rmk")


-                                                             (* ; "Edited 25-Nov-2023 10:49 by rmk")


-                                                             (* ; "Edited 23-Nov-2023 11:47 by rmk")


                                                              (* ; "Edited 21-Oct-2023 10:56 by rmk")

 
     (* ;; "PC is the starting piece, NP is the number of pieces including it.")

@@ -421,13 +464,16 @@
     (PROG ((TEXTOBJ (CL:IF (type?
 TEXTOBJ PC)
                         PC
                         (GTO
 TOBJ)))
-           WTYPE)
-          (CL:WHEN (AND NP (LITATOM NP)
-                        (NULL OFILE))
-              (SETQ WTYPE (CL:IF (EQ NP T)
-                              'SP
-                              NP))
-              (SETQ NP NIL))
+           WTYPE TITLE)
+          (if
 OFILE
+              then
 (CL:WHEN (MEMB OFILE '(T TEDIT))
+                       (SETQ WTYPE 'SP)
+                       (SETQ OFILE NIL))
+            elseif
 (AND NP (LITATOM NP))
+              then
 (SETQ WTYPE (CL:IF (EQ NP T)
+                                   'SP
+                                   NP))
+                   (SETQ NP NIL))
           (CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ))
               (PRINTOUT T "Document is empty" T)
               (RETURN))
@@ -456,8 +502,8 @@
               (SETQ NP (CL:IF NP
                            20
                            MAX.SMALLP)))
-          (DEBUGOUTPUT OFILE WTYPE (DSPFONT (OR FONT '(TERMINAL 8))
-                                          OFILE)
+          (DEBUGOUTPUT OFILE WTYPE TITLE (DSPFONT (OR FONT '(TERMINAL 8))
+                                                OFILE)
                  (for
 P PFILES inpieces
 PC as
 I from
 1 to
 NP as
 PCNO
                     from
 (OR (PIECENUM
 PC TEXTOBJ)
                              1) do
 
@@ -479,7 +525,10 @@
           (RETURN PC])
 
 (SL

-  [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE)
               (* ; "Edited  7-Dec-2024 16:34 by rmk")


+  [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE)
               (* ; "Edited 29-Mar-2025 20:27 by rmk")


+                                                             (* ; "Edited 21-Jan-2025 15:39 by rmk")


+                                                             (* ; "Edited  6-Jan-2025 22:58 by rmk")


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


                                                              (* ; "Edited  3-Dec-2024 10:29 by rmk")


                                                              (* ; "Edited 25-Nov-2024 21:42 by rmk")


                                                              (* ; "Edited 18-Nov-2024 21:28 by rmk")


@@ -491,11 +540,18 @@
 
     (* ;; "Shows a selection of the lines backing the display in PANE")

 
-    (LET (LINES WTYPE PNO)
-         (CL:UNLESS OFILE
-             (CL:WHEN (EQ LASTLINE T)
-                 (SETQ WTYPE 'SL)
-                 (SETQ LASTLINE NIL)))
+    (LET (LINES WTYPE PNO TITLE)
+         (if
 OFILE
+             then
 (CL:WHEN (MEMB OFILE '(T TEDIT))
+                      (SETQ WTYPE 'SL)
+                      (SETQ OFILE NIL))
+           elseif
 (MEMB LASTLINE '(T TEDIT))
+             then
 (SETQ WTYPE 'SL)
+                  (SETQ LASTLINE NIL)
+           elseif
 (STRINGP LASTLINE)
+             then
 (SETQ WTYPE 'SL)
+                  (SETQ TITLE (CONCAT "SL:  " LASTLINE))
+                  (SETQ LASTLINE NIL))
          (CL:WHEN [AND (type?
 LINEDESCRIPTOR (CAR (LISTP FIRSTLINE)))
                        (NULL LASTLINE)
                        (OR (NULL (CDR FIRSTLINE))
@@ -508,8 +564,8 @@
          (SETQ TOBJ (pop
 LINES))
          (SETQ PANE (pop
 LINES))
          (SETQ PNO (pop
 LINES))
-         (DEBUGOUTPUT OFILE WTYPE (PRINTOUT OFILE .FONT '(TERMINAL 8)
-                                         "Pane " PNO " = " PANE T)
+         (DEBUGOUTPUT OFILE WTYPE TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8)
+                                               "Pane " PNO " = " PANE T)
                 (PRINTOUT OFILE .FONT '(TERMINAL 8)
                        15 "HT" -3 "BOT" 27 .FONT '(TERMINAL 8 BOLD)
                        "C1" 36 "CN" .FONT '(TERMINAL 8)
@@ -518,11 +574,16 @@
                    finally
 (CL:WHEN (EQ LASTLINE (PANEBOTTOMLINE PANE))
                                (SHOWLINE
 (PANESUFFIX PANE)
                                       OFILE TOBJ)))
-                (TERPRI OFILE))
+                (TERPRI OFILE)
+                (CL:WHEN (EQ FIRSTLINE LASTLINE)
+                    (printout OFILE (for
 L inlines
 (FGETLD LASTLINE NEXTLINE) sum
 1)
+                           " lines below LASTLINE" T T)))
          FIRSTLINE])
 
 (SSP

-  [LAMBDA (SELPIECES NP OFILE TEXTOBJ)
                       (* ; "Edited 26-Nov-2024 20:54 by rmk")


+  [LAMBDA (SELPIECES NP OFILE TEXTOBJ)
                       (* ; "Edited 29-Mar-2025 22:35 by rmk")


+                                                             (* ; "Edited 30-Jan-2025 11:25 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 20:54 by rmk")


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


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


                                                              (* ; "Edited 22-Nov-2023 20:23 by rmk")


@@ -532,149 +593,23 @@
 
     (* ;; "Prints up to NP pieces from SELPIECES.")

 
-    (SETQ TEXTOBJ (GTO
 TEXTOBJ))
+    (if
 (TEXTOBJ NP T)
+        then
 (SETQ TEXTOBJ (TEXTOBJ NP))
+             (SETQ NP NIL)
+      elseif
 (TEXTOBJ OFILE T)
+        then
 (SETQ TEXTOBJ (TEXTOBJ OFILE))
+             (SETQ OFILE NIL)
+      else
 (GTO
 TEXTOBJ))
     (DEBUGOUTPUT OFILE (CL:UNLESS OFILE 'SSP)
+           NIL
            (for
 PC inselpieces
 SELPIECES as
 I from
 1 to
 (OR NP 50)
               do
 (PRINTOUT OFILE .I3 I "/")
                  (SPPRINT
 PC OFILE TEXTOBJ)))
     SELPIECES])
 
-(STL

-  [LAMBDA (THISLINE LASTCS LCHAR1 OFILE)
                     (* ; "Edited 22-Aug-2024 23:51 by rmk")


-                                                             (* ; "Edited  4-Aug-2024 12:08 by rmk")


-                                                             (* ; "Edited 31-Jul-2024 19:55 by rmk")


-                                                             (* ; "Edited 29-Jul-2024 09:20 by rmk")


-                                                             (* ; "Edited  1-Feb-2024 17:00 by rmk")


-                                                             (* ; "Edited 25-Nov-2023 10:50 by rmk")


-                                                             (* ; "Edited 23-Nov-2023 11:41 by rmk")


-                                                             (* ; "Edited 23-Mar-2023 23:00 by rmk")

-
-    (* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done.  During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible.  When complete, they shouldn't appear.")

-
-    (* ;; "If OFILE isn't given, this goes to a textstream")

-
-    (DECLARE
 (USEDFREE PREVSP CHARSLOT))
-    (CL:UNLESS (type?
 THISLINE THISLINE)
-        (CL:WHEN (EQ THISLINE T)
-            (SETQ THISLINE NIL)
-            (SETQ LASTCS CHARSLOT))
-        (SETQ THISLINE (fetch
 (TEXTOBJ THISLINE) of
 (GTO
 THISLINE))))
-    (\DTEST THISLINE 'THISLINE)
-    (DEBUGOUTPUT OFILE (CL:IF OFILE
-                           NIL
-                           'STL)
-           (for
 CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH
 TLSPACEFACTOR
-                                                                               OF
 THISLINE))
-                (FIRSTSPACESLOT _ (fetch
 TLFIRSTSPACE of
 THISLINE))
-                (LINE _ (fetch
 (THISLINE DESC) of
 THISLINE))
-                (NSPACES _ 0)
-                (NCHARS _ 0)
-                (SPACETOTAL _ 0)
-                (PSP _ (AND (BOUNDP 'PREVSP)
-                            (NEQ PREVSP (GETATOMVAL 'PREVSP))
-                            PREVSP)) incharslots
 THISLINE as
 NSLOTS from
 0
-              first
 (if
 (NULL LINE)
-                        then
 (printout OFILE THISLINE ":" T 5 
-                                    "No line parameters, start at CHNO = 1 LX1 = 0" T)
-                             (SETQ CHNO 1)
-                             (SETQ TX 0)
-                      elseif
 (type?
 LINEDESCRIPTOR LINE)
-                        then
 (SETQ CHNO (GETLD LINE LCHAR1))
-                             (SETQ TX (GETLD LINE LX1))
-                             (printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO 
-                                    " LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM)
-                                    T))
-                    (CL:WHEN LCHAR1
-                        (SETQ CHNO (OR LCHAR1 1)))
-                    (SETQ LENGTH TX)
-                    (printout OFILE 29 "XLIM" T) eachtime
 (SETQ CHAR (CHAR CSLOT))
-                                                       (SETQ CHARW (CHARW CSLOT))
-                                                       (CL:UNLESS (CHARSLOTP CSLOT THISLINE)
-                                                              (HELP "THISLINE RUNS OFF THE EDGE" 
-                                                                    THISLINE))
-              repeatuntil
 [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE]
-              do
 (printout OFILE .I4 NSLOTS)
-                 [if
 (IMAGEOBJP CHAR)
-                     then
 (add
 NCHARS 1)
-                          (printout OFILE " " .I5 CHNO ": ")
-                          (add
 TX CHARW)
-                          (printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ")
-                          (SPPRINT.OBJ
 CHAR OFILE)
-                          (add
 LENGTH CHARW)
-                          (ADD
 CHNO 1)
-                   elseif
 (SMALLP CHAR)
-                     then
 (add
 NCHARS 1)
-                          (printout OFILE " " .I5 CHNO ": ")
-                          (printout OFILE .I3 CHAR " "
-                                 (SELCHARQ CHAR
-                                      ((EOL CR LF) 
-                                           (add
 TX CHARW)
-                                           (add
 LENGTH CHARW)
-                                           "EOL")
-                                      (FORM "FORM")
-                                      (SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT)
-                                                    (SETQ EXPANDSPACES T))
-                                             (if
 EXPANDSPACES
-                                                 then
 (add
 LENGTH (SCALEUP SPACEFACTOR CHARW))
-                                                      (add
 TX (SCALEUP SPACEFACTOR CHARW))
-                                               else
 (add
 LENGTH CHARW)
-                                                    (add
 TX CHARW))
-                                             (ADD
 NSPACES 1)
-                                             " ")
-                                      (TAB (add
 LENGTH CHARW)
-                                           (add
 TX CHARW)
-                                           "TAB")
-                                      (Meta,TAB (add
 LENGTH CHARW)
-                                                (add
 TX CHARW)
-                                                "MTAB")
-                                      (PROGN (add
 LENGTH CHARW)
-                                             (add
 TX CHARW)
-                                             (CHARACTER CHAR)))
-                                 .FR 28 CHARW " " .I4 TX 35 CSLOT)
-                          (ADD
 CHNO 1)
-                   elseif
 [AND [OR (CHARSLOTP CHAR THISLINE)
-                                   (AND (NULL CHAR)
-                                        (NOT (TYPE?
 CHARLOOKS CHARW]
-                               (OR (EQ CSLOT PSP)
-                                   (find
 CS incharslots
 (NEXTCHARSLOT CSLOT)
-                                      while
 (CHARSLOTP CS THISLINE) suchthat
 (EQ CSLOT CHAR]
-                     then
                                    (* ; "Presumably a PREVSP")

-                          (ADD
 NSPACES 1)
-                          (printout OFILE " " .I5 CHNO ":")
-                          (ADD
 LENGTH CHARW)
-                          (ADD
 TX CHARW)
-                          (PRINTOUT OFILE " " (OR CHAR "[ENDSP]")
-                                 .FR 28 CHARW " " .I4 TX 35 CSLOT)
-                          (ADD
 CHNO 1)
-                   elseif
 (SMALLP CHARW)
-                     then
 (if
 (EQ CSLOT FIRSTSPACESLOT)
-                              then
 (PRINTOUT OFILE "First space")
-                            else
 (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW)
-                                 (add
 CHNO CHARW))
-                   elseif
 (type?
 CHARLOOKS CHARW)
-                     then
 (printout OFILE 7 CHARW 35 CSLOT)
-                   else
 (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T
-                               )
-                        (TERPRI OFILE)
-                        (GO $$OUT)
-                        (AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? "))
-                                     (TERPRI OFILE)
-                                     (GO $$OUT))]
-                 (TERPRI OFILE)
-              finally
 (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2
-                             "next avail = " (fetch
 (THISLINE NEXTAVAILABLECHARSLOT) of
 THISLINE)
-                             T)
-                    (printout OFILE "line length = " LENGTH -3 "right margin = "
-                           (AND LINE (GETLD LINE RIGHTMARGIN))
-                           -3 "X limit = " (AND LINE (GETLD (fetch
 (THISLINE DESC) of
 THISLINE)
-                                                            LXLIM))
-                           T)
-                    (printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = "
-                           (CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR))
-                           T])
-
 (SPF

-  [LAMBDA (ARG TITLE OFILE)
                                  (* ; "Edited 30-Aug-2024 21:25 by rmk")


+  [LAMBDA (ARG TITLE OFILE)
                                  (* ; "Edited 29-Mar-2025 22:36 by rmk")


+                                                             (* ; "Edited 30-Aug-2024 21:25 by rmk")


                                                              (* ; "Edited 15-Aug-2024 22:39 by rmk")


                                                              (* ; "Edited 13-Aug-2024 10:45 by rmk")


                                                              (* ; "Edited 11-Jul-2024 10:34 by rmk")


@@ -692,9 +627,9 @@
                     (SETQ TEXTOBJ (TEXTOBJ (\TEDIT.MAINW TEXTOBJ))))
                 (SETQ PAGEREGIONS (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))
          (SETQ TITLE (CONCAT "Page regions for " (OR TITLE TEXTOBJ PAGEREGIONS)))
-         (DEBUGOUTPUT OFILE 'SPF (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD)
-                                        TITLE .FONT '(TERMINAL 8)
-                                        T)
+         (DEBUGOUTPUT OFILE 'SPF TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD)
+                                              TITLE .FONT '(TERMINAL 8)
+                                              T)
                 (for
 TYPE PF (FIRSTPF _ (TEDIT.GET.PAGEFORMAT PAGEREGIONS 'FIRST/DEFAULT))
                    in
 '(FIRST/DEFAULT LEFT RIGHT)
                    collect
 (SETQ PF (TEDIT.GET.PAGEFORMAT PAGEREGIONS TYPE))
@@ -964,6 +899,160 @@
                 (SETQ VERSION (\SMALLPIN STREAM))
                 (PRINTOUT OUTFILE VERSION " (" (IDIFFERENCE VERSION 31415)
                        ")" T])
+
+(SSEL

+  [LAMBDA (SEL TEXTOBJ OFILE)
                                (* ; "Edited  3-Feb-2025 23:05 by rmk")

+    (SETQ TEXTOBJ (GTO
 TEXTOBJ))
+    (CL:UNLESS SEL
+        (SETQ SEL (TEXTSEL TEXTOBJ)))
+    (for
 I from
 (GETSEL SEL CH#) to
 (GETSEL SEL CHLAST) do
 (PRINTOUT OFILE (TEDIT.NTHCHAR TEXTOBJ I))
+         )
+    (TERPRI OFILE])
+)
+(DEFINEQ
+
+(STL

+  [LAMBDA (THISLINE LASTCS LCHAR1 OFILE)
                     (* ; "Edited 29-Mar-2025 22:36 by rmk")


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


+                                                             (* ; "Edited  4-Aug-2024 12:08 by rmk")


+                                                             (* ; "Edited 31-Jul-2024 19:55 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 09:20 by rmk")


+                                                             (* ; "Edited  1-Feb-2024 17:00 by rmk")


+                                                             (* ; "Edited 25-Nov-2023 10:50 by rmk")


+                                                             (* ; "Edited 23-Nov-2023 11:41 by rmk")


+                                                             (* ; "Edited 23-Mar-2023 23:00 by rmk")

+
+    (* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done.  During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible.  When complete, they shouldn't appear.")

+
+    (* ;; "If OFILE isn't given, this goes to a textstream")

+
+    (DECLARE
 (USEDFREE PREVSP CHARSLOT))
+    (CL:UNLESS (type?
 THISLINE THISLINE)
+        (CL:WHEN (EQ THISLINE T)
+            (SETQ THISLINE NIL)
+            (SETQ LASTCS CHARSLOT))
+        (SETQ THISLINE (fetch
 (TEXTOBJ THISLINE) of
 (GTO
 THISLINE))))
+    (\DTEST THISLINE 'THISLINE)
+    (DEBUGOUTPUT OFILE (CL:IF OFILE
+                           NIL
+                           'STL)
+           NIL
+           (for
 CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH
 TLSPACEFACTOR
+                                                                               OF
 THISLINE))
+                (FIRSTSPACESLOT _ (fetch
 TLFIRSTSPACE of
 THISLINE))
+                (LINE _ (fetch
 (THISLINE DESC) of
 THISLINE))
+                (NSPACES _ 0)
+                (NCHARS _ 0)
+                (SPACETOTAL _ 0)
+                (PSP _ (AND (BOUNDP 'PREVSP)
+                            (NEQ PREVSP (GETATOMVAL 'PREVSP))
+                            PREVSP)) incharslots
 THISLINE as
 NSLOTS from
 0
+              first
 (if
 (NULL LINE)
+                        then
 (printout OFILE THISLINE ":" T 5 
+                                    "No line parameters, start at CHNO = 1 LX1 = 0" T)
+                             (SETQ CHNO 1)
+                             (SETQ TX 0)
+                      elseif
 (type?
 LINEDESCRIPTOR LINE)
+                        then
 (SETQ CHNO (GETLD LINE LCHAR1))
+                             (SETQ TX (GETLD LINE LX1))
+                             (printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO 
+                                    " LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM)
+                                    T))
+                    (CL:WHEN LCHAR1
+                        (SETQ CHNO (OR LCHAR1 1)))
+                    (SETQ LENGTH TX)
+                    (printout OFILE 29 "XLIM" T) eachtime
 (SETQ CHAR (CHAR CSLOT))
+                                                       (SETQ CHARW (CHARW CSLOT))
+                                                       (CL:UNLESS (CHARSLOTP CSLOT THISLINE)
+                                                              (HELP "THISLINE RUNS OFF THE EDGE" 
+                                                                    THISLINE))
+              repeatuntil
 [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE]
+              do
 (printout OFILE .I4 NSLOTS)
+                 [if
 (IMAGEOBJP CHAR)
+                     then
 (add
 NCHARS 1)
+                          (printout OFILE " " .I5 CHNO ": ")
+                          (add
 TX CHARW)
+                          (printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ")
+                          (SPPRINT.OBJ
 CHAR OFILE)
+                          (add
 LENGTH CHARW)
+                          (ADD
 CHNO 1)
+                   elseif
 (SMALLP CHAR)
+                     then
 (add
 NCHARS 1)
+                          (printout OFILE " " .I5 CHNO ": ")
+                          (printout OFILE .I3 CHAR " "
+                                 (SELCHARQ CHAR
+                                      ((EOL CR LF) 
+                                           (add
 TX CHARW)
+                                           (add
 LENGTH CHARW)
+                                           "EOL")
+                                      (FORM "FORM")
+                                      (SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT)
+                                                    (SETQ EXPANDSPACES T))
+                                             (if
 EXPANDSPACES
+                                                 then
 (add
 LENGTH (SCALEUP SPACEFACTOR CHARW))
+                                                      (add
 TX (SCALEUP SPACEFACTOR CHARW))
+                                               else
 (add
 LENGTH CHARW)
+                                                    (add
 TX CHARW))
+                                             (ADD
 NSPACES 1)
+                                             " ")
+                                      (TAB (add
 LENGTH CHARW)
+                                           (add
 TX CHARW)
+                                           "TAB")
+                                      (Meta,TAB (add
 LENGTH CHARW)
+                                                (add
 TX CHARW)
+                                                "MTAB")
+                                      (PROGN (add
 LENGTH CHARW)
+                                             (add
 TX CHARW)
+                                             (CHARACTER CHAR)))
+                                 .FR 28 CHARW " " .I4 TX 35 CSLOT)
+                          (ADD
 CHNO 1)
+                   elseif
 [AND [OR (CHARSLOTP CHAR THISLINE)
+                                   (AND (NULL CHAR)
+                                        (NOT (TYPE?
 CHARLOOKS CHARW]
+                               (OR (EQ CSLOT PSP)
+                                   (find
 CS incharslots
 (NEXTCHARSLOT CSLOT)
+                                      while
 (CHARSLOTP CS THISLINE) suchthat
 (EQ CSLOT CHAR]
+                     then
                                    (* ; "Presumably a PREVSP")

+                          (ADD
 NSPACES 1)
+                          (printout OFILE " " .I5 CHNO ":")
+                          (ADD
 LENGTH CHARW)
+                          (ADD
 TX CHARW)
+                          (PRINTOUT OFILE " " (OR CHAR "[ENDSP]")
+                                 .FR 28 CHARW " " .I4 TX 35 CSLOT)
+                          (ADD
 CHNO 1)
+                   elseif
 (SMALLP CHARW)
+                     then
 (if
 (EQ CSLOT FIRSTSPACESLOT)
+                              then
 (PRINTOUT OFILE "First space")
+                            else
 (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW)
+                                 (add
 CHNO CHARW))
+                   elseif
 (type?
 CHARLOOKS CHARW)
+                     then
 (printout OFILE 7 CHARW 35 CSLOT)
+                   else
 (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T
+                               )
+                        (TERPRI OFILE)
+                        (GO $$OUT)
+                        (AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? "))
+                                     (TERPRI OFILE)
+                                     (GO $$OUT))]
+                 (TERPRI OFILE)
+              finally
 (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2
+                             "next avail = " (fetch
 (THISLINE NEXTAVAILABLECHARSLOT) of
 THISLINE)
+                             T)
+                    (printout OFILE "line length = " LENGTH -3 "right margin = "
+                           (AND LINE (GETLD LINE RIGHTMARGIN))
+                           -3 "X limit = " (AND LINE (GETLD (fetch
 (THISLINE DESC) of
 THISLINE)
+                                                            LXLIM))
+                           T)
+                    (printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = "
+                           (CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR))
+                           T])
+
+(CLEARTHISLINE

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

+    (LET ((THISLINE (GETTOBJ (GTO
 TSTREAM)
+                           THISLINE)))
+         (replace
 (THISLINE DESC) of
 THISLINE with
 NIL)
+         (for
 CSLOT incharslots
 THISLINE do
 (FILLCHARSLOT CSLOT NIL NIL])
 )
 (DEFINEQ
 
@@ -1201,7 +1290,9 @@
 (DEFINEQ
 
 (SPPRINT

-  [LAMBDA (P OSTREAM TEXTOBJ NOCR)
                           (* ; "Edited  5-Aug-2024 00:30 by rmk")


+  [LAMBDA (P OSTREAM TEXTOBJ NOCR)
                           (* ; "Edited 19-Feb-2025 12:21 by rmk")


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


+                                                             (* ; "Edited  5-Aug-2024 00:30 by rmk")


                                                              (* ; "Edited  5-May-2024 12:55 by rmk")


                                                              (* ; "Edited 23-Apr-2024 08:54 by rmk")


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


@@ -1264,12 +1355,12 @@
                     .I4 PLEN (CL:IF (PPARALAST P)
                                  "*"
                                  "")
-                    (CL:IF (type?
 FMTSPEC PARALOOKS)
-                        (if
 (fetch
 (FMTSPEC FMTNEWPAGEBEFORE) of
 PARALOOKS)
-                            then
 (CL:IF (fetch
 (FMTSPEC FMTNEWPAGEAFTER) of
 PARALOOKS)
+                    (CL:IF (type?
 PARALOOKS PARALOOKS)
+                        (if
 (GETPLOOKS PARALOOKS FMTNEWPAGEBEFORE)
+                            then
 (CL:IF (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
                                      "ba"
                                      "b")
-                          elseif
 (fetch
 (FMTSPEC FMTNEWPAGEAFTER) of
 PARALOOKS)
+                          elseif
 (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
                             then
 "a"
                           else
 "")
                         "")
@@ -1345,7 +1436,8 @@
                    OSTREAM)))])
 
 (SPPRINT.OBJ

-  [LAMBDA (OBJ STREAM POS)
                                   (* ; "Edited  6-Oct-2024 20:54 by rmk")


+  [LAMBDA (OBJ STREAM POS)
                                   (* ; "Edited  9-Jan-2025 16:48 by rmk")


+                                                             (* ; "Edited  6-Oct-2024 20:54 by rmk")


                                                              (* ; "Edited 29-Sep-2024 14:45 by rmk")


                                                              (* ; "Edited 29-Aug-2024 10:44 by rmk")


                                                              (* ; "Edited 25-Aug-2024 14:31 by rmk")


@@ -1364,7 +1456,7 @@
     (CL:UNLESS [NLSETQ (SELECTQ (IMAGEOBJPROP OBJ 'DISPLAYFN)
                            (MB.NWAY.DISPLAYFN 
                                 (PRINTOUT STREAM (IMAGEOBJPROP OBJ 'IDENTIFIER)
-                                       ":" T .TAB (IPLUS POS 2))
+                                       T .TAB (IPLUS POS 2))
                                 (for
 SOBJ in
 (IMAGEOBJPROP OBJ 'SUBOBJECTS)
                                    do
 (PRINTOUT STREAM (IMAGEOBJPROP SOBJ 'IDENTIFIER)
                                              " ")))
@@ -1422,13 +1514,15 @@
                 P])
 
 (SBT

-  [LAMBDA (DONTCLOSE ARG)
                                    (* ; "Edited 13-Jun-2024 22:00 by rmk")


+  [LAMBDA (DONTCLOSE ARG)
                                    (* ; "Edited 28-Mar-2025 20:41 by rmk")


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


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


                                                              (* ; "Edited 29-May-2023 17:23 by rmk")


                                                              (* ; "Edited 26-May-2023 11:05 by rmk")

 
     (* ;; "Inspect the BTREE")

 
+    (SETQ ARG (GTO
 ARG))
     (LET ([W (WINDOWP (GETATOMVAL 'BTW]
           (POS (CREATEPOSITION 50 10)))
          (if
 DONTCLOSE
@@ -1437,8 +1531,9 @@
                                                             OF
 (WINDOWPROP W 'REGION]
                                        10)))
            else
 (CLOSEW W))
-         (SETATOMVAL 'BTW (INSPECT (fetch
 PCTB of
 (GTO
 ARG))
-                                 'LIST POS])
+         (SETATOMVAL 'BTW (INSPECT (GETTOBJ ARG PCTB)
+                                 'LIST POS))
+         (GETTOBJ ARG PCTB])
 
 (COPYPCHAIN

   [LAMBDA (PIECES I J)
                                       (* ; "Edited 23-Sep-2023 11:38 by rmk")

@@ -1883,7 +1978,8 @@
         (for
 R in
 (fetch
 (PARA RUNS) of
 PARA) do
 (PRUN
 R BSTR)))])
 
 (PRUN

-  [LAMBDA (RUN BSTR)
                                         (* ; "Edited 22-Aug-2023 10:59 by rmk")


+  [LAMBDA (RUN BSTR)
                                         (* ; "Edited  2-Jan-2025 10:28 by rmk")


+                                                             (* ; "Edited 22-Aug-2023 10:59 by rmk")


                                                              (* ; "Edited  8-Aug-2023 16:47 by rmk")

 
     (* ;; "Shows the characters in RUN, with font information")

@@ -1902,26 +1998,15 @@
         (LET (FONT (CL (fetch
 (RUN RUNLOOKS) of
 RUN)))
              (SETQ FONT (fetch
 (CHARLOOKS CLFONT) of
 CL))
              (TAB 13 NIL T)
-             (if
 FONT
-                 then
 (for
 X in
 (FONTUNPARSE FONT)
-                         do
 (if
 (MEMB X '(MEDIUM BOLD ITALIC REGULAR))
-                                then
 (PRIN1 (NTHCHAR X 1)
-                                            T)
-                              elseif
 (NUMBERP X)
-                                then
 (PRINTOUT T " " X " ")
-                              else
 (PRIN1 X T)))
-                      (TERPRI T)
-               else
 (PRINTOUT T (fetch
 (CHARLOOKS CLNAME) of
 CL)
-                           " "
-                           (fetch
 (CHARLOOKS CLSIZE) of
 CL)
-                           " "
-                           (CL:IF (fetch
 (CHARLOOKS CLBOLD) of
 CL)
-                               "B"
-                               "M")
-                           (CL:IF (fetch
 (CHARLOOKS CLITAL) of
 CL)
-                               "I"
-                               "R")
-                           T)))
+             (PRINTOUT T (FONTPROP FONT 'FAMILY)
+                    (FONTPROP FONT 'SIZE)
+                    (CL:IF [EQ 'BOLD (CAR (FONTPROP FONT 'FACE]
+                        'B
+                        "")
+                    (CL:IF [EQ 'ITALIC (CADR (FONTPROP FONT 'FACE]
+                        'I
+                        "")
+                    T))
         RUN)])
 
 (ADDLINEPOSITIONS

@@ -2004,58 +2089,12 @@
 (RPAQQ OK.TO.MODIFY.FNS
 T)
 (DEFINEQ
 
-(DFOV

-  [NLAMBDA ARGS
                                              (* ; "Edited  2-Dec-2024 08:14 by rmk")


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


-                                                             (* ; "Edited 12-Jan-2024 00:30 by rmk")


-                                                             (* ; "Edited 15-Dec-2023 12:36 by rmk")


-                                                             (* ; "Edited 13-Aug-2023 14:09 by rmk")

-
-    (* ;; "Brings in a function from an earlier version, for comparison. If FILE is a version number, it uses WHEREIS")

-
-    (SETQ ARGS (NLAMBDA.ARGS ARGS))
-    (PROG ((FN (POP
 ARGS))
-           (FNFILE (POP
 ARGS))
-           (VERSION (POP
 ARGS))
-           (DIRLIST (POP
 ARGS))
-           ALTFNS)
-          (CL:WHEN (FIXP FNFILE)
-              (SETQ VERSION FNFILE)
-              (SETQ FNFILE NIL))
-          [if
 (AND FNFILE (MEMB FNFILE (WHEREIS FN 'FNS T)))
-            elseif
 (SETQ FNFILE (CAR (WHEREIS FN 'FNS T)))
-            else
 (CL:WHEN (EQ (CHARCODE \)
-                              (CHCON1 FN))
-                     (push
 ALTFNS (SUBATOM FN 2)))
-                 (if
 (STRPOS "TEDIT." FN NIL NIL T)
-                     then
 (push
 ALTFNS (PACK* "\" FN))
-                   elseif
 (NOT (STRPOS "\TEDIT." FN 1 NIL T))
-                     then
 (push
 ALTFNS (PACK* "\TEDIT." FN)))
-                 (for
 AF F in
 ALTFNS when
 (SETQ F (CAR (WHEREIS AF 'FNS T)))
-                    collect
 (LIST AF F) finally
 (if
 (CDR $$VAL)
-                                                    then
 (PRINTOUT T "Possible names/files for " FN 
-                                                                ", be more specific" T)
-                                                  elseif
 $$VAL
-                                                    then
 (SETQ FN (CAAR $$VAL))
-                                                         (SETQ FNFILE (CADAR $$VAL))
-                                                  elseif
 FNFILE
-                                                    then
 (PRINTOUT T FN " not found on " FNFILE T)
-                                                  else
 (PRINTOUT T FN " not found" T]
-          (APPLY (FUNCTION EDV)
-                 (LIST FN 'FNS FNFILE VERSION DIRLIST NIL NIL NIL '(:DONTWAIT])
-
 (OLDWI

   [LAMBDA (FN)
                                               (* ; "Edited 16-May-2023 12:02 by rmk")

     (for
 F COMS in
 TEDITFILES when
 (AND (SETQ F (DFOV.OLDEST
 F))
                                         (INFILECOMS? FN NIL (GETDEF (FILECOMS F)
                                                                    'VARS F))) collect
 F])
 
-(DFOV.OLDEST

-  [LAMBDA (FILE DIRLIST)
                                     (* ; "Edited 15-Dec-2023 12:22 by rmk")


-                                                             (* ; "Edited 13-Aug-2023 07:30 by rmk")


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

-    (CAR (LAST (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST])
-
 (COMP

   [LAMBDA (FN)
                                               (* ; "Edited  5-Feb-2023 20:14 by rmk")

     (COMPAREDEFS FN 'FNS (LIST 'SAVE (CAR (REMOVE 'SAVE (WHEREIS FN 'FNS T])
@@ -2323,23 +2362,27 @@
 
 (PUTPROPS DEBUGOUTPUT
 MACRO

           [ARGS
-           `(LET [(OFILE ,(CAR ARGS))
-                  (WTYPE ,(CADR ARGS]
-                 (RESETLST
-                     [if
 WTYPE
-                         then
 [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE)
-                                                 NIL NIL '(FONT DEFAULTFONT]
-                              [RESETSAVE NIL
-                                     `(PROGN (CL:UNLESS RESETSTATE
-                                                 [TEDIT OFILE WTYPE NIL
-                                                        `(READONLY QUIET LEAVETTY T TITLE
-                                                                ,WTYPE])]
-                       elseif
 OFILE
-                         then
 (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW))
-                                     '(PROGN (CLOSEF? OLDVALUE]
-                     [RESETSAVE (DSPFONT NIL OFILE)
-                            '(PROGN (DSPFONT OLDVALUE OFILE]
-                     ,@(CDDR ARGS))])
+           `(LET
+             [(OFILE ,(CAR ARGS))
+              (WTYPE ,(CADR ARGS))
+              (TITLE ,(CADDR ARGS]
+             (RESETLST
+                 [if
 WTYPE
+                     then
 [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE)
+                                             NIL NIL '(FONT DEFAULTFONT]
+                          [RESETSAVE NIL
+                                 `(PROGN (CL:UNLESS RESETSTATE
+                                             [TEDIT OFILE WTYPE NIL
+                                                    `(READONLY QUIET LEAVETTY T TITLE
+                                                            ,(OR TITLE WTYPE]
+                                             (WINDOWPROP (WFROMDS OFILE)
+                                                    'TEDIT-DEBUG T))]
+                   elseif
 OFILE
+                     then
 (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW))
+                                 '(PROGN (CLOSEF? OLDVALUE]
+                 [RESETSAVE (DSPFONT NIL OFILE)
+                        '(PROGN (DSPFONT OLDVALUE OFILE]
+                 ,@(CDDDR ARGS))])
 )
 (DEFINEQ
 
@@ -2419,37 +2462,37 @@
 
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
-(ADDTOVAR NLAMA
 VSEE DFGV DFOV)
+(ADDTOVAR NLAMA
 VSEE DFGV)
 
 (ADDTOVAR NLAML
 DFVENUE DFR)
 
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4840 7227 (GTO 4850 . 5100) (GTS 5102 . 6701) (GTW 6703 . 6859) (GSEL 6861 . 7225)) (
-7284 20415 (IPC 7294 . 8798) (ILINES 8800 . 11341) (ISEL 11343 . 11954) (ITS 11956 . 13680) (IPANES 
-13682 . 13917) (ITL 13919 . 14338) (IHIST 14340 . 17002) (IPCTB 17004 . 17312) (IMB 17314 . 17929) (
-ICL 17931 . 18496) (IPL 18498 . 18902) (ICARET 18904 . 19281) (INSPECTPIECES 19283 . 20413)) (20437 
-55479 (SP 20447 . 25793) (SL 25795 . 28371) (SSP 28373 . 29486) (STL 29488 . 38000) (SPF 38002 . 40301
-) (SLF 40303 . 49436) (SHOWLINE 49438 . 53000) (SLL 53002 . 53749) (STBYTES 53751 . 55477)) (55480 
-60853 (NTHPIECE 55490 . 56622) (NPIECES 56624 . 57489) (NTHPIECECHAR 57491 . 58799) (SELPIECE 58801 . 
-59243) (PIECENUM 59245 . 59964) (PCBYTES 59966 . 60851)) (60854 63328 (FILEBYTES 60864 . 62288) (
-TFILEBYTES 62290 . 63326)) (63329 64651 (TRELMOVE 63339 . 63582) (TSCROLL 63584 . 63750) (TSCROLL* 
-63752 . 64649)) (64652 67701 (TRY 64662 . 65931) (TEDITCLOSEW 65933 . 66276) (PARALASTWITHOUTEOL 66278
- . 67163) (FIXPARALAST 67165 . 67699)) (67702 81927 (SPPRINT 67712 . 74128) (SPPRINT.CHAR 74130 . 
-75114) (SPPRINT.OBJ 75116 . 78069) (SHOWPIECEBYTES 78071 . 79627) (CHECKPLENGTHS 79629 . 80086) (SBT 
-80088 . 81077) (COPYPCHAIN 81079 . 81925)) (81928 83989 (POSLINE 81938 . 83987)) (83990 84873 (
-PRESPLIT 84000 . 84871)) (84874 86587 (ALLTL 84884 . 86137) (NTHCHARSLOT 86139 . 86585)) (86613 96826 
-(PLCHAIN 86623 . 87151) (PRINTLINE 87153 . 90143) (SL.GETLINES 90145 . 93438) (CHECKLINES 93440 . 
-94420) (COLLECTLINES 94422 . 94674) (NTHLINE 94676 . 95681) (HEIGHT 95683 . 95971) (LINEBOTS 95973 . 
-96824)) (96827 99275 (IPC.DECODEARGS 96837 . 99273)) (99276 99869 (SPF1 99286 . 99867)) (99898 102276 
-(SLF.FATPLEN 99908 . 100767) (FILEPIECE 100769 . 102274)) (102309 103077 (SELTEDIT 102319 . 103075)) (
-103147 109305 (PPARA 103157 . 103579) (PRUN 103581 . 105603) (ADDLINEPOSITIONS 105605 . 107032) (SBR 
-107034 . 107688) (SBC 107690 . 109303)) (109362 114037 (DFOV 109372 . 111842) (OLDWI 111844 . 112219) 
-(DFOV.OLDEST 112221 . 112646) (COMP 112648 . 112843) (DFR 112845 . 114035)) (114038 115071 (DFGV 
-114048 . 114574) (GDIRECTORIES 114576 . 115069)) (115072 121637 (TTEST 115082 . 119614) (LTEST 119616
- . 120981) (THC 120983 . 121635)) (121951 122643 (SHOWSAFE 121961 . 122641)) (122696 123143 (MYH 
-122706 . 123141)) (123388 124483 (DFVENUE 123398 . 124277) (VSEE 124279 . 124481)) (124484 124938 (PTT
- 124494 . 124936)) (126036 128352 (TEDIT-DEBUG 126046 . 128350)) (128353 130089 (TRENAME 128363 . 
-130087)))))
+  (FILEMAP (NIL (4984 7543 (GTO 4994 . 5244) (GTS 5246 . 7017) (GTW 7019 . 7175) (GSEL 7177 . 7541)) (
+7576 8135 (TEST.TEMPLATE 7586 . 8133)) (8136 9071 (TESTACTION 8146 . 9069)) (9096 22911 (IPC 9106 . 
+10610) (ILINES 10612 . 13153) (ISEL 13155 . 13766) (ITS 13768 . 15492) (IPANES 15494 . 15729) (ITL 
+15731 . 16150) (IHIST 16152 . 18814) (IPCTB 18816 . 19242) (IMB 19244 . 20003) (ICL 20005 . 20706) (
+IPL 20708 . 21248) (ICARET 21250 . 21777) (INSPECTPIECES 21779 . 22909)) (22933 50561 (SP 22943 . 
+27587) (SL 27589 . 31035) (SSP 31037 . 32592) (SPF 32594 . 35020) (SLF 35022 . 44155) (SHOWLINE 44157
+ . 47719) (SLL 47721 . 48468) (STBYTES 48470 . 50196) (SSEL 50198 . 50559)) (50562 59579 (STL 50572 . 
+59208) (CLEARTHISLINE 59210 . 59577)) (59580 64953 (NTHPIECE 59590 . 60722) (NPIECES 60724 . 61589) (
+NTHPIECECHAR 61591 . 62899) (SELPIECE 62901 . 63343) (PIECENUM 63345 . 64064) (PCBYTES 64066 . 64951))
+ (64954 67428 (FILEBYTES 64964 . 66388) (TFILEBYTES 66390 . 67426)) (67429 68751 (TRELMOVE 67439 . 
+67682) (TSCROLL 67684 . 67850) (TSCROLL* 67852 . 68749)) (68752 71801 (TRY 68762 . 70031) (TEDITCLOSEW
+ 70033 . 70376) (PARALASTWITHOUTEOL 70378 . 71263) (FIXPARALAST 71265 . 71799)) (71802 86449 (SPPRINT 
+71812 . 78397) (SPPRINT.CHAR 78399 . 79383) (SPPRINT.OBJ 79385 . 82443) (SHOWPIECEBYTES 82445 . 84001)
+ (CHECKPLENGTHS 84003 . 84460) (SBT 84462 . 85599) (COPYPCHAIN 85601 . 86447)) (86450 88511 (POSLINE 
+86460 . 88509)) (88512 89395 (PRESPLIT 88522 . 89393)) (89396 91109 (ALLTL 89406 . 90659) (NTHCHARSLOT
+ 90661 . 91107)) (91135 101348 (PLCHAIN 91145 . 91673) (PRINTLINE 91675 . 94665) (SL.GETLINES 94667 . 
+97960) (CHECKLINES 97962 . 98942) (COLLECTLINES 98944 . 99196) (NTHLINE 99198 . 100203) (HEIGHT 100205
+ . 100493) (LINEBOTS 100495 . 101346)) (101349 103797 (IPC.DECODEARGS 101359 . 103795)) (103798 104391
+ (SPF1 103808 . 104389)) (104420 106798 (SLF.FATPLEN 104430 . 105289) (FILEPIECE 105291 . 106796)) (
+106831 107599 (SELTEDIT 106841 . 107597)) (107669 113281 (PPARA 107679 . 108101) (PRUN 108103 . 109579
+) (ADDLINEPOSITIONS 109581 . 111008) (SBR 111010 . 111664) (SBC 111666 . 113279)) (113338 115114 (
+OLDWI 113348 . 113723) (COMP 113725 . 113920) (DFR 113922 . 115112)) (115115 116148 (DFGV 115125 . 
+115651) (GDIRECTORIES 115653 . 116146)) (116149 122714 (TTEST 116159 . 120691) (LTEST 120693 . 122058)
+ (THC 122060 . 122712)) (123028 123720 (SHOWSAFE 123038 . 123718)) (123773 124220 (MYH 123783 . 124218
+)) (124465 125560 (DFVENUE 124475 . 125354) (VSEE 125356 . 125558)) (125561 126015 (PTT 125571 . 
+126013)) (127250 129566 (TEDIT-DEBUG 127260 . 129564)) (129567 131303 (TRENAME 129577 . 131301)))))
 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,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3
 34260  
+
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4
 34381  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS GET.OBJ.FROM.USER)
 
-      :PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
+      :PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
 
 
 (PRETTYCOMPRINT IMAGEOBJCOMS)
@@ -674,7 +674,8 @@
 (DEFINEQ
 
 (GET.OBJ.FROM.USER

-  [LAMBDA (TEXTSTREAM TEXTOBJ)
                               (* ; "Edited  7-Jul-2024 21:04 by rmk")


+  [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 at the current position of its caret.")

@@ -688,7 +689,7 @@
                             (TEDIT.INSERT TEXTSTREAM VAL))
                          (LITATOM                            (* ; 
 
                                                            "Atoms and strings get inserted as text.")

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

                             (TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
                          (T [COND
@@ -769,12 +770,12 @@
 
 (FILESLOAD EDITBITMAP)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT 
-5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 (
-BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) (
-BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5 
-20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) (
-BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4 
-25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) (
-PROMPTFOREVALED 31934 . 34158)))))
+  (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 "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59
 14133  
+
(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 "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56)
+      :PREVIOUS-DATE "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60)
 
 
 (PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -153,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")

 
@@ -171,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")


@@ -265,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))
@@ -283,8 +292,8 @@
                                    thereis
 (ShellWhich (CAR TEMPLATE])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3262 5876 (PDFFILEP 3272 . 4186) (PDF.HARDCOPYW 4188 . 4786) (PDF.TEXT 4788 . 5505) (
-PDF.TEDIT 5507 . 5874)) (6316 13376 (OPEN-PDF-STREAM 6326 . 8462) (CLOSE-PDF-STREAM 8464 . 9751) (
-PS-TO-PDF 9753 . 13374)) (13377 13775 (SEE-PDF 13387 . 13773)) (13826 14110 (PDFCONVERTER 13836 . 
-14108)))))
+  (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,98 +1,209 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9
 10946  
+
(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 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
+      :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)
-                         (GLOBALVARS TEDIT.ABBREVS)
-                         (INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
-                                                    ("n" . "357,44")
-                                                    ("m" . "357,45")
-                                                    ("T" . "357,57")
-                                                    ("d" . "357,60")
-                                                    ("D" . "357,61")
-                                                    ("s" . "0,247")
-                                                    ("'" . "0,271")
-                                                    ("`" . "0,251")
-                                                    ("%"" . "0,252")
-                                                    ("~" . "0,272")
-                                                    ("1/4" . "0,274")
-                                                    ("1/2" . "0,275")
-                                                    ("3/4" . "0,276")
-                                                    ("1/3" . "357,375")
-                                                    ("2/3" . "357,376")
-                                                    ("c" . "0,323")
-                                                    ("c/o" . "357,100")
-                                                    ("%%" . "357,100")
-                                                    ("->" . "0,256")
-                                                    ("ra" . "0,256")
-                                                    ("|" . "0,257")
-                                                    ("da" . "0,257")
-                                                    ("^" . "0,255")
-                                                    ("ua" . "0,255")
-                                                    ("<-" . "0,254")
-                                                    ("la" . "0,254")
-                                                    ("_" . "0,254")
-                                                    ("L" . "0,243")
-                                                    ("o" . "0,260")
-                                                    ("Y" . "0,245")
-                                                    ("+" . "0,261")
-                                                    ("x" . "0,264")
-                                                    ("/" . "0,270")
-                                                    ("=" . "357,121")
-                                                    ("p" . "0,266")
-                                                    ("r" . "0,322")
-                                                    ("t" . "0,324")
-                                                    ("tm" . "0,324")
-                                                    ("box" . "42,42")
-                                                    ("cbox" . "42,61")
-                                                    ("-" . "357,43")
-                                                    ("=" . "357,42")
-                                                    (" " . "357,41")
-                                                    ("DATE" . \TEDIT.EXPAND.DATE)
-                                                    (">>DATE<<" . \TEDIT.EXPAND.DATE])
+(RPAQQ TEDIT-ABBREVCOMS

+       [(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")
+                                   ("m" . "357,45")
+                                   ("T" . "357,57")
+                                   ("d" . "357,60")
+                                   ("D" . "357,61")
+                                   ("s" . "0,247")
+                                   ("'" . "0,271")
+                                   ("`" . "0,251")
+                                   ("%"" . "0,252")
+                                   ("~" . "0,272")
+                                   ("1/4" . "0,274")
+                                   ("1/2" . "0,275")
+                                   ("3/4" . "0,276")
+                                   ("1/3" . "357,375")
+                                   ("2/3" . "357,376")
+                                   ("c" . "0,323")
+                                   ("c/o" . "357,100")
+                                   ("%%" . "357,100")
+                                   ("->" . "0,256")
+                                   ("ra" . "0,256")
+                                   ("|" . "0,257")
+                                   ("da" . "0,257")
+                                   ("^" . "0,255")
+                                   ("ua" . "0,255")
+                                   ("<-" . "0,254")
+                                   ("la" . "0,254")
+                                   ("_" . "0,254")
+                                   ("L" . "0,243")
+                                   ("o" . "0,260")
+                                   ("Y" . "0,245")
+                                   ("+" . "0,261")
+                                   ("x" . "0,264")
+                                   ("/" . "0,270")
+                                   ("=" . "357,121")
+                                   ("p" . "0,266")
+                                   ("r" . "0,322")
+                                   ("t" . "0,324")
+                                   ("tm" . "0,324")
+                                   ("box" . "42,42")
+                                   ("cbox" . "42,61")
+                                   ("-" . "357,43")
+                                   ("=" . "357,42")
+                                   (" " . "357,41")
+                                   ("DATE" . \TEDIT.EXPAND.DATE)
+                                   (">>DATE<<" . \TEDIT.EXPAND.DATE])
 (DEFINEQ
 
 (\TEDIT.ABBREV.EXPAND

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 31-Oct-2024 17:50 by rmk")


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

@@ -109,100 +220,92 @@
                           " " 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
 
 (GLOBALVARS TEDIT.ABBREVS)
 )
 
-(RPAQ? TEDIT.ABBREVS
 '(("b" . "357,146")
-                       ("n" . "357,44")
-                       ("m" . "357,45")
-                       ("T" . "357,57")
-                       ("d" . "357,60")
-                       ("D" . "357,61")
-                       ("s" . "0,247")
-                       ("'" . "0,271")
-                       ("`" . "0,251")
-                       ("%"" . "0,252")
-                       ("~" . "0,272")
-                       ("1/4" . "0,274")
-                       ("1/2" . "0,275")
-                       ("3/4" . "0,276")
-                       ("1/3" . "357,375")
-                       ("2/3" . "357,376")
-                       ("c" . "0,323")
-                       ("c/o" . "357,100")
-                       ("%%" . "357,100")
-                       ("->" . "0,256")
-                       ("ra" . "0,256")
-                       ("|" . "0,257")
-                       ("da" . "0,257")
-                       ("^" . "0,255")
-                       ("ua" . "0,255")
-                       ("<-" . "0,254")
-                       ("la" . "0,254")
-                       ("_" . "0,254")
-                       ("L" . "0,243")
-                       ("o" . "0,260")
-                       ("Y" . "0,245")
-                       ("+" . "0,261")
-                       ("x" . "0,264")
-                       ("/" . "0,270")
-                       ("=" . "357,121")
-                       ("p" . "0,266")
-                       ("r" . "0,322")
-                       ("t" . "0,324")
-                       ("tm" . "0,324")
-                       ("box" . "42,42")
-                       ("cbox" . "42,61")
-                       ("-" . "357,43")
-                       ("=" . "357,42")
-                       (" " . "357,41")
-                       ("DATE" . \TEDIT.EXPAND.DATE)
-                       (">>DATE<<" . \TEDIT.EXPAND.DATE)))
+(RPAQ? TEDIT.ABBREVS

+       '(("b" . "357,146")
+         ("n" . "357,44")
+         ("m" . "357,45")
+         ("T" . "357,57")
+         ("d" . "357,60")
+         ("D" . "357,61")
+         ("s" . "0,247")
+         ("'" . "0,271")
+         ("`" . "0,251")
+         ("%"" . "0,252")
+         ("~" . "0,272")
+         ("1/4" . "0,274")
+         ("1/2" . "0,275")
+         ("3/4" . "0,276")
+         ("1/3" . "357,375")
+         ("2/3" . "357,376")
+         ("c" . "0,323")
+         ("c/o" . "357,100")
+         ("%%" . "357,100")
+         ("->" . "0,256")
+         ("ra" . "0,256")
+         ("|" . "0,257")
+         ("da" . "0,257")
+         ("^" . "0,255")
+         ("ua" . "0,255")
+         ("<-" . "0,254")
+         ("la" . "0,254")
+         ("_" . "0,254")
+         ("L" . "0,243")
+         ("o" . "0,260")
+         ("Y" . "0,245")
+         ("+" . "0,261")
+         ("x" . "0,264")
+         ("/" . "0,270")
+         ("=" . "357,121")
+         ("p" . "0,266")
+         ("r" . "0,322")
+         ("t" . "0,324")
+         ("tm" . "0,324")
+         ("box" . "42,42")
+         ("cbox" . "42,61")
+         ("-" . "357,43")
+         ("=" . "357,42")
+         (" " . "357,41")
+         ("DATE" . \TEDIT.EXPAND.DATE)
+         (">>DATE<<" . \TEDIT.EXPAND.DATE)))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
-\TEDIT.TRY.ABBREV 6831 . 8977)))))
+  (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-BUTTONS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "22-Dec-2024 22:47:22" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;200
 119344 
+
(FILECREATED "24-Mar-2025 09:26:13" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;223
 124611 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS MB.3STATE.BUTTONEVENTINFN)
+      :CHANGES-TO (FNS MB.FIELD.INSURETYPE MB.BUTTONEVENTINFN)
 
-      :PREVIOUS-DATE "20-Dec-2024 22:19:48" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;198)
+      :PREVIOUS-DATE "14-Mar-2025 15:29:51" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;219)
 
 
 (PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
@@ -19,12 +19,11 @@
         (COMS                                                (* ; 
 
                                                "Generic functions for the various types of buttons.")

               (RECORDS MBARG)
-              (FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDITMENU.STREAM TEDIT.BACKTOMAIN))
+              (FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDIT.BACKTOMAIN))
         [COMS                                                (* ; "Simple Menu Button support")

               (FNS MB.BUTTONEVENTINFN MB.DISPLAYFN MB.SETIMAGE MB.SIZEFN MB.WHENOPERATEDONFN 
                    MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MB.CREATE MB.CHANGENAME MB.INIT 
-                   MB.TRACK.UNTIL MB.DON'T)
-              (GLOBALVARS MB.IMAGEFNS)
+                   MB.TRACK.UNTIL MB.DON'T MB.SPEC.REMAINDER)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.INIT]
         [COMS                                                (* ; "3STATE")

               
@@ -32,7 +31,6 @@
 
               (FNS MB.3STATE.CREATE MB.3STATE.DISPLAYFN MB.3STATE.SHOWSELFN MB.3STATE.INIT 
                    MB.3STATE.SETSTATEFN MB.3STATE.BUTTONEVENTINFN)
-              (GLOBALVARS MB.3STATE.IMAGEFNS)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.3STATE.INIT]
         [COMS                                                (* ; "NWAY")

               
@@ -42,18 +40,15 @@
                    MB.NWAY.SELECT MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN 
                    MB.NWAY.INIT MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ 
                    MB.NWAY.SETSTATEFN)
-              (GLOBALVARS MB.NWAY.IMAGEFNS)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT]
         [COMS                                                (* ; "TOGGLE")

               (FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE 
                    MB.TOGGLE.SETSTATEFN MB.TOGGLE.BUTTONEVENTINFN MB.TOGGLE.WHENOPERATEDONFN)
-              (GLOBALVARS MB.TOGGLE.IMAGEFNS)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.TOGGLE.INIT]
         (COMS                                                (* ; "FIELDS")

               (FNS MB.FIELD.CREATE MB.FIELD.DISPLAYFN MB.FIELD.IMAGEBOXFN MB.FIELD.PREFIXCREATE 
                    MB.FIELD.SUFFIXCREATE MB.FIELD.INIT MB.FIELD.WHENOPERATEDONFN MB.FIELD.GETSTATEFN
                    MB.FIELD.SETSTATEFN MB.FIELD.BUTTONEVENTINFN MB.FIELD.SIZEFN MB.FIELD.INSURETYPE)
-              (GLOBALVARS MB.FIELD.IMAGEFNS)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.FIELD.INIT])
 
 
@@ -72,7 +67,8 @@
 (DEFINEQ
 
 (MB.ADD

-  [LAMBDA (MENUDESC MENUTSTREAM WHERE)
                       (* ; "Edited 22-Oct-2024 09:16 by rmk")


+  [LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES)
    (* ; "Edited  5-Jan-2025 11:36 by rmk")


+                                                             (* ; "Edited 22-Oct-2024 09:16 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:26 by rmk")


                                                              (* ; "Edited 18-Oct-2024 13:49 by rmk")


                                                              (* ; "Edited  6-Oct-2024 15:25 by rmk")


@@ -92,73 +88,80 @@
 
     (* ;; "Returns the textstream character number of the character just after the last inserted character/object.")

 
-    (for
 DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL]
-         [TAB _ (CONCATCODES (CHARCODE (TAB]
-         (CH# _ (if
 (NULL WHERE)
-                    then
 (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ)))
-                  elseif
 (FIXP WHERE)
-                  else
 (\ILLEGAL.ARG WHERE))) in
 MENUDESC declare
 (SPECVARS CH#)
-       do
 (SETQ DESC (MKLIST DESC))                          (* ; "MKLIST for EOL/TAB, FIXP")

-          (SETQ TYPE (CAR DESC))
-          (SETQ SPEC (CDR DESC))
-          (SELECTQ TYPE
-              (                                              (* ; ;; NIL)
 
+    (RESETLST
+        (CL:UNLESS INCREMENTALUPDATES (TEDIT.DEFER.UPDATES MENUTSTREAM))
+        (for
 DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL]
+             [TAB _ (CONCATCODES (CHARCODE (TAB]
+             (CH# _ (if
 (NULL WHERE)
+                        then
 (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ)))
+                      elseif
 (FIXP WHERE)
+                      else
 (\ILLEGAL.ARG WHERE))) in
 MENUDESC declare
 (SPECVARS CH#)
+           do
 (SETQ DESC (MKLIST DESC))                      (* ; "MKLIST for EOL/TAB, FIXP")

+              (SETQ TYPE (CAR DESC))
+              (SETQ SPEC (CDR DESC))
+              (SELECTQ TYPE
+                  (                                          (* ; ;; NIL)
 
                                                              (* ; 
 
                                                           "Ignore comments within menu descriptions")

-                   )
-              (EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON))
-                   (add
 CH# 1))
-              (TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON))
-                   (add
 CH# 1))
-              (ACTION                                        (* ; "Hitting calls a function")

-                      (TEDIT.INSERT.OBJECT (MB.CREATE
 SPEC)
-                             MENUTSTREAM CH# '(PROTECTED OFF))
-                      (add
 CH# 1))
-              (3STATE                                        (* ; 
+                       )
+                  (EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON))
+                       (add
 CH# 1))
+                  (TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON))
+                       (add
 CH# 1))
+                  (ACTION                                    (* ; "Hitting calls a function")

+                          (TEDIT.INSERT.OBJECT (MB.CREATE
 SPEC)
+                                 MENUTSTREAM CH# '(PROTECTED OFF))
+                          (add
 CH# 1))
+                  (3STATE                                    (* ; 
 
                              "3-state button;  hitting it changes state among ON, OFF, and NEUTRAL.")

-                      (TEDIT.INSERT.OBJECT (MB.3STATE.CREATE
 SPEC)
-                             MENUTSTREAM CH# '(PROTECTED OFF))
-                      (add
 CH# 1))
-              (TOGGLE                                        (* ; 
+                          (TEDIT.INSERT.OBJECT (MB.3STATE.CREATE
 SPEC)
+                                 MENUTSTREAM CH# '(PROTECTED OFF))
+                          (add
 CH# 1))
+                  (TOGGLE                                    (* ; 
 
                                            "TOGGLE button;  hitting it switches between ON and OFF.")

-                      (TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE
 SPEC)
-                             MENUTSTREAM CH# '(PROTECTED OFF))
-                      (add
 CH# 1))
-              (NWAY                                          (* ; 
+                          (TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE
 SPEC)
+                                 MENUTSTREAM CH# '(PROTECTED OFF))
+                          (add
 CH# 1))
+                  (NWAY                                      (* ; 
 
                                                 "N-way buttons;  choosing one turns the others off.")

-                    (SETQ OBJ (MB.NWAY.CREATE
 SPEC))
-                    (TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF))
-                    (add
 CH# 1))
-              (TEXT                                          (* ; "Arbitrary protected text.")

-                    [TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC))
-                           CH#
-                           (CL:IF (CADR (ASSOC 'FONT SPEC))
-                               `(FONT ,(CADR (ASSOC 'FONT SPEC))
-                                      PROTECTED ON)
-                               '(PROTECTED ON))]
-                    [add
 CH# (NCHARS (CADR (ASSOC 'STRING SPEC])
-              (FIELD (SETQ CH# (MB.FIELD.CREATE
 SPEC MENUTSTREAM CH#)))
-              (MENU                                          (* ; 
+                        (SETQ OBJ (MB.NWAY.CREATE
 SPEC))
+                        (TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF))
+                        (add
 CH# 1))
+                  (TEXT                                      (* ; "Arbitrary protected text.")

+                        [TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC))
+                               CH#
+                               (CL:IF (CADR (ASSOC 'FONT SPEC))
+                                   `(FONT ,(CADR (ASSOC 'FONT SPEC))
+                                          PROTECTED ON)
+                                   '(PROTECTED ON))]
+                        [add
 CH# (NCHARS (CADR (ASSOC 'STRING SPEC])
+                  (FIELD (SETQ CH# (MB.FIELD.CREATE
 SPEC MENUTSTREAM CH#)))
+                  (MENU                                      (* ; 
 
                                                             "Real menu, except the selection sticks")

-                    (\TEDIT.THELP "NOT IMPLEMENTED")
-                    (TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC))
-                           MENUTSTREAM CH# '(PROTECTED OFF))
-                    (add
 CH# 1))
-              (if
 (STRINGP TYPE)
-                  then
 (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON))
-                       (add
 CH# (NCHARS TYPE))
-                elseif
 (FIXP TYPE)
-                  then
                                       (* ; "TYPE spaces")

-                       (TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE))
-                              CH#
-                              '(PROTECTED ON))
-                       (add
 CH# TYPE)
-                elseif
 (LISTP TYPE)
-                  then
 
-                       (* ;; "Form to be evaluated")

+                        (\TEDIT.THELP "NOT IMPLEMENTED")
+                        (TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC))
+                               MENUTSTREAM CH# '(PROTECTED OFF))
+                        (add
 CH# 1))
+                  (if
 (STRINGP TYPE)
+                      then
 (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON))
+                           (add
 CH# (NCHARS TYPE))
+                    elseif
 (FIXP TYPE)
+                      then
                                   (* ; "TYPE spaces")

+                           (TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE))
+                                  CH#
+                                  '(PROTECTED ON))
+                           (add
 CH# TYPE)
+                    elseif
 (LISTP TYPE)
+                      then
 
+                           (* ;; "Form to be evaluated")

 
-                       (add
 CH# (EVAL TYPE))
-                else
 (\ILLEGAL.ARG DESC))) finally
 (RETURN CH#])
+                           (add
 CH# (EVAL TYPE))
+                    else
 (\ILLEGAL.ARG DESC))) finally
 (\TEDIT.SHOWSEL NIL NIL MENUTSTREAM) 
+                                                             (* ; 
+
                                                             "User has to click to get a selection")

+                                                     (SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ))
+                                                            SET NIL)
+                                                     (RETURN CH#)))])
 
 (MB.DELETE

   [LAMBDA (IDENTIFIERS MENUSTREAM)
                           (* ; "Edited  8-Nov-2024 08:58 by rmk")

@@ -168,7 +171,8 @@
                         (CAR CHNOS])
 
 (MB.GET

-  [LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE)
      (* ; "Edited 13-Dec-2024 09:24 by rmk")


+  [LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE)
      (* ; "Edited 11-Jan-2025 20:49 by rmk")


+                                                             (* ; "Edited 13-Dec-2024 09:24 by rmk")


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


                                                              (* ; "Edited  7-Nov-2024 22:20 by rmk")


                                                              (* ; "Edited 22-Oct-2024 22:02 by rmk")


@@ -251,9 +255,9 @@
                                              (ERROR R " is not a button return"))
                                  finally
 (CL:UNLESS (CDR RETURNS)
                                              (RETURN (CAR $$VAL)))])
-             (CL:IF (LITATOM IDENTIFIERS)
-                 (CADR RESULT)
-                 RESULT)))])
+             (CL:IF (LISTP IDENTIFIERS)
+                 RESULT
+                 (CADR RESULT))))])
 
 (MB.GET.MBARG

   [LAMBDA (IDPC MENUSTREAM)
                                  (* ; "Edited 17-Dec-2024 11:54 by rmk")


@@ -284,17 +288,6 @@
                       ARGENDPC _ ENDPC
                       ARGIDPC _ IDPC])
 
-(TEDITMENU.STREAM

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 29-Sep-2024 15:29 by rmk")


-                                                             (* ; "Edited 28-Aug-2024 15:48 by rmk")


-                                                             (* ; "Edited 10-Apr-2023 09:53 by rmk")

-                                                             (* jds "13-Aug-84 14:10")

-
-    (* ;; "returns the textstream of the teditmenu attached to this stream if any")

-
-    (for
 W in
 (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)) when
 (TEDITMENUP W "TEdit Menu")
-       do
 (RETURN (TEXTSTREAM W])
-
 (TEDIT.BACKTOMAIN

   [LAMBDA (MENUSTREAM)
                                       (* ; "Edited 20-Oct-2024 10:02 by rmk")


                                                              (* ; "Edited 25-Aug-2024 09:17 by rmk")

@@ -315,6 +308,9 @@
 
 (MB.BUTTONEVENTINFN

   [LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON)

+                                                             (* ; "Edited 22-Mar-2025 14:00 by rmk")


+                                                             (* ; "Edited 12-Jan-2025 13:03 by rmk")


+                                                             (* ; "Edited 28-Dec-2024 20:21 by rmk")


                                                              (* ; "Edited 22-Aug-2024 16:26 by rmk")


                                                              (* ; "Edited 20-Aug-2024 10:04 by rmk")


                                                              (* ; "Edited 20-Jul-2024 15:26 by rmk")


@@ -325,6 +321,7 @@
 
     (if
 [OR (EQ BUTTON 'RIGHT)
             (SHIFTDOWNP 'CTRL)
+            (SHIFTDOWNP 'SHIFT)
             (LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
                  (OR (ILESSP RELX 0)
                      (ILESSP RELY 0)
@@ -515,7 +512,11 @@
                      'INVERT))])
 
 (MB.CREATE

-  [LAMBDA (SPEC IMAGEFNS)
                                    (* ; "Edited 18-Oct-2024 10:27 by rmk")


+  [LAMBDA (SPEC IMAGEFNS)
                                    (* ; "Edited 12-Jan-2025 12:35 by rmk")


+                                                             (* ; "Edited  9-Jan-2025 16:51 by rmk")


+                                                             (* ; "Edited  6-Jan-2025 00:19 by rmk")


+                                                             (* ; "Edited  4-Jan-2025 16:29 by rmk")


+                                                             (* ; "Edited 18-Oct-2024 10:27 by rmk")


                                                              (* ; "Edited  6-Oct-2024 16:59 by rmk")


                                                              (* ; "Edited  5-Oct-2024 11:51 by rmk")


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


@@ -532,25 +533,34 @@
 
     (* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields.  ")

 
-    (for
 S PROP VAL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS (CADR (ASSOC 'IMAGEFNS SPEC))
-                                                   MB.IMAGEFNS))) in
 SPEC
+    (for
 S PROP VAL IDENTIFIER LABEL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS
+                                                                    (CADR (ASSOC 'IMAGEFNS SPEC))
+                                                                    MB.IMAGEFNS))) in
 SPEC
        eachtime
 (SETQ PROP (MKATOM (CAR S)))
              (SETQ VAL (CADR S)) unless
 (EQ PROP 'IMAGEFNS)
        do
 (SELECTQ PROP
               (FONT [SETQ VAL (FONTCREATE (FONTCREATE VAL NIL NIL NIL 'DISPLAY])
-              ((LABEL IDENTIFIER) 
-                   (SETQ VAL (MKATOM VAL)))
+              (LABEL (SETQ LABEL (SETQ VAL (MKSTRING VAL))))
+              (IDENTIFIER (SETQ IDENTIFIER VAL)
+                          (GO $$ITERATE))
               NIL)
           (IMAGEOBJPROP OBJ PROP VAL)
        finally
 (CL:UNLESS (IMAGEOBJPROP OBJ 'FONT)
                    (IMAGEOBJPROP OBJ 'FONT (FONTCREATE '(HELVETICA 8 BOLD)
                                                   NIL NIL NIL 'DISPLAY)))
-             (CL:UNLESS (IMAGEOBJPROP OBJ 'IDENTIFIER)
-                 (if
 (SETQ VAL (IMAGEOBJPROP OBJ 'LABEL))
-                     then
 [IMAGEOBJPROP OBJ 'IDENTIFIER
-                                 (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline #\:)
-                                                        VAL]
-                   else
 (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC))))
+             (if
 (NULL IDENTIFIER)
+                 then
 (if
 LABEL
+                          then
 [SETQ IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab 
+                                                                                        #\Newline #\:
+                                                                                        )
+                                                                       LABEL]
+                        else
 (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC)))
+               elseif
 (OR (LITATOM IDENTIFIER)
+                          (SMALLP IDENTIFIER))
+               elseif
 (STRINGP IDENTIFIER)
+                 then
 (SETQ IDENTIFIER (MKATOM IDENTIFIER))
+               else
 (\ILLEGAL.ARG VAL))
+             (IMAGEOBJPROP OBJ 'IDENTIFIER IDENTIFIER)
              (CL:WHEN (IMAGEOBJPROP OBJ 'INITSTATE)
                  (IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP OBJ 'INITSTATE)))
              (MB.SETIMAGE
 OBJ)
@@ -569,12 +579,14 @@
           (TEDIT.OBJECT.CHANGED TEXTOBJ OBJ])
 
 (MB.INIT

-  [LAMBDA NIL
                                                (* ; "Edited  7-Dec-2024 09:05 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited  7-Jan-2025 22:49 by rmk")


+                                                             (* ; "Edited  7-Dec-2024 09:05 by rmk")


                                                              (* ; "Edited 28-Aug-2024 23:34 by rmk")


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


                                                              (* ; "Edited 20-Aug-2024 15:23 by rmk")


                                                              (* ; "Edited 18-Feb-2024 14:15 by rmk")

                                                              (* jds "12-Feb-85 14:32")

+    (DECLARE
 (GLOBALVARS MB.IMAGEFNS))
     (SETQ MB.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAYFN)
                              (FUNCTION MB.SIZEFN)
                              (FUNCTION MB.PUTFN)
@@ -610,10 +622,17 @@
                                                              (* ; "Edited  7-Dec-2024 08:58 by rmk")

     (CL:UNLESS (IMAGEOBJPROP OBJ 'DELETABLE)
            'DON'T])
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS MB.IMAGEFNS)
+(MB.SPEC.REMAINDER

+  [LAMBDA (SPEC IGNORE OBJ)
                                  (* ; "Edited 16-Feb-2025 13:07 by rmk")

+
+    (* ;; "Reduces SPEC to properties that not to be IGNORED because they have been dealt with separately. If OBJ, those properties are installed as IMAGEOBJPROP's.")

+
+    (for
 S in
 SPEC unless
 (MEMB (CAR S)
+                                IGNORE) collect
 (CL:WHEN OBJ
+                                                    (IMAGEOBJPROP OBJ (CAR S)
+                                                           (CADR S)))
+                                              S])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
@@ -696,7 +715,8 @@
               NIL])
 
 (MB.3STATE.INIT

-  [LAMBDA NIL
                                                (* ; "Edited  7-Dec-2024 12:38 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited  7-Jan-2025 22:49 by rmk")


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


                                                              (* ; "Edited 18-Oct-2024 11:40 by rmk")


                                                              (* ; "Edited 25-Aug-2024 23:11 by rmk")


                                                              (* ; "Edited 20-Aug-2024 15:36 by rmk")

@@ -704,6 +724,7 @@
 
     (* ;; "Initialize the IMAGEFNS for 3-state menu button IMAGEOBJs")

 
+    (DECLARE
 (GLOBALVARS MB.3STATE.IMAGEFNS))
     (SETQ MB.3STATE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.3STATE.DISPLAYFN)
                                     (FUNCTION MB.SIZEFN)
                                     (FUNCTION MB.PUTFN)
@@ -778,10 +799,6 @@
              (TEDIT.BACKTOMAIN
 MENUTSTREAM)))
     'DON'T])
 )
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS MB.3STATE.IMAGEFNS)
-)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (MB.3STATE.INIT
)
@@ -799,7 +816,10 @@
 (DEFINEQ
 
 (MB.NWAY.CREATE

-  [LAMBDA (SPEC)
                                             (* ; "Edited 20-Dec-2024 22:17 by rmk")


+  [LAMBDA (SPEC MENUTSTREAM CH#)
                             (* ; "Edited 16-Feb-2025 12:08 by rmk")


+                                                             (* ; "Edited  9-Jan-2025 11:38 by rmk")


+                                                             (* ; "Edited  4-Jan-2025 21:39 by rmk")


+                                                             (* ; "Edited 20-Dec-2024 22:17 by rmk")


                                                              (* ; "Edited 22-Oct-2024 00:26 by rmk")


                                                              (* ; "Edited 29-Sep-2024 12:43 by rmk")


                                                              (* ; "Edited 31-Aug-2024 14:57 by rmk")


@@ -824,6 +844,10 @@
           (DONTAPPLY (CADR (ASSOC 'DONTAPPLY SPEC)))
           (OBJ (IMAGEOBJCREATE NIL MB.NWAY.IMAGEFNS))
           SPACING HEIGHT SUBOBJECTS)
+         (if
 (AND IDENTIFIER (LITATOM IDENTIFIER))
+           elseif
 (STRINGP IDENTIFIER)
+             then
 (SETQ IDENTIFIER (MKATOM IDENTIFIER))
+           else
 (\ILLEGAL.ARG IDENTIFIER))
          (SETQ SPACING (STRINGWIDTH "   " FONT))
          [SETQ HEIGHT (IPLUS 2 (FONTPROP FONT 'HEIGHT]
          (CL:UNLESS (LISTP BUTTONS)
@@ -986,7 +1010,9 @@
                     BOX])
 
 (MB.NWAY.SELECT

-  [LAMBDA (OBJ SELECTED MENUWINDOW SEL)
                      (* ; "Edited 29-Sep-2024 12:44 by rmk")


+  [LAMBDA (OBJ SELECTED MENUWINDOW SEL)
                      (* ; "Edited  3-Jan-2025 12:56 by rmk")


+                                                             (* ; "Edited  1-Jan-2025 12:30 by rmk")


+                                                             (* ; "Edited 29-Sep-2024 12:44 by rmk")


                                                              (* ; "Edited 24-Aug-2024 15:28 by rmk")


                                                              (* ; "Edited 20-Aug-2024 15:13 by rmk")


                                                              (* ; "Edited  2-Aug-2024 00:28 by rmk")


@@ -1002,29 +1028,37 @@
          (CL:WHEN (AND SELECTED (NEQ SELECTED T)
                        (LITATOM SELECTED))
              (SETQ SELECTED (MB.NWAY.FINDSUBOBJ
 SELECTED OBJ)))
-         (CL:UNLESS (EQ OLDSELECTED SELECTED)                (* ; "Reclicking is a no-op. ")

-             (CL:WHEN (AND OLDSELECTED SELECTED)             (* ; 
+         (if
 (AND NIL (EQ OLDSELECTED SELECTED))
+             then
 (IMAGEOBJPROP OBJ 'STATE 'OFF)             (* ; 
+
                                                    "Reclicking the current selection turns it off. ")

+                  (IMAGEOBJPROP OBJ 'SELECTED NIL)
+                  (CL:WHEN MENUWINDOW
+                      (BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
+                             0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
+                             (IMAGEOBJPROP OLDSELECTED 'Y)
+                             NIL NIL 'INPUT 'REPLACE))
+           else
 (CL:WHEN (AND OLDSELECTED SELECTED)          (* ; 
 
                                                             "Turn the old one off if it's changing")

-                 (IMAGEOBJPROP OLDSELECTED 'STATE 'OFF)
-                 (CL:WHEN MENUWINDOW
-                     (BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
-                            0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
-                            (IMAGEOBJPROP OLDSELECTED 'Y)
-                            NIL NIL 'INPUT 'REPLACE))
-                 (IMAGEOBJPROP OBJ 'STATE NIL)
-                 (IMAGEOBJPROP OBJ 'SELECTED NIL))
-             (CL:WHEN (AND SELECTED (NEQ T SELECTED))        (* ; "Turn on the new one.")

-                 (IMAGEOBJPROP SELECTED 'STATE 'ON)
-                 (CL:WHEN MENUWINDOW
-                     (BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE)
-                            0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X)
-                            (IMAGEOBJPROP SELECTED 'Y)
-                            NIL NIL 'INVERT 'REPLACE))
-                 (IMAGEOBJPROP OBJ 'SELECTED SELECTED)
-                 (IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER))
-                 (CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN)
-                     (APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
-                            OBJ SELECTED SEL MENUWINDOW))))])
+                    (IMAGEOBJPROP OLDSELECTED 'STATE 'OFF)
+                    (CL:WHEN MENUWINDOW
+                        (BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
+                               0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
+                               (IMAGEOBJPROP OLDSELECTED 'Y)
+                               NIL NIL 'INPUT 'REPLACE))
+                    (IMAGEOBJPROP OBJ 'STATE NIL)
+                    (IMAGEOBJPROP OBJ 'SELECTED NIL))
+                (CL:WHEN (AND SELECTED (NEQ T SELECTED))     (* ; "Turn on the new one.")

+                    (IMAGEOBJPROP SELECTED 'STATE 'ON)
+                    (CL:WHEN MENUWINDOW
+                        (BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE)
+                               0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X)
+                               (IMAGEOBJPROP SELECTED 'Y)
+                               NIL NIL 'INVERT 'REPLACE))
+                    (IMAGEOBJPROP OBJ 'SELECTED SELECTED)
+                    (IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER))
+                    (CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN)
+                        (APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
+                               OBJ SELECTED SEL MENUWINDOW)))])
 
 (MB.NWAY.BUTTONEVENTINFN

   [LAMBDA (OBJ MENUDS SEL RELX RELY SELWINDOW MENUTSTREAM BUTTON)

@@ -1105,7 +1139,8 @@
          NEWOBJ])
 
 (MB.NWAY.INIT

-  [LAMBDA (BUTTONS FONT INITSTATE)
                           (* ; "Edited  7-Dec-2024 09:05 by rmk")


+  [LAMBDA (BUTTONS FONT INITSTATE)
                           (* ; "Edited  7-Jan-2025 22:50 by rmk")


+                                                             (* ; "Edited  7-Dec-2024 09:05 by rmk")


                                                              (* ; "Edited 24-Aug-2024 23:11 by rmk")


                                                              (* ; "Edited 20-Aug-2024 16:41 by rmk")


                                                              (* ; "Edited 11-Aug-2024 17:13 by rmk")

@@ -1113,6 +1148,7 @@
 
     (* ;; "Selection happens in the BUTTEVENTINFN, no WHENOPERATEDONFN")

 
+    (DECLARE
 (GLOBALVARS MB.NWAY.IMAGEFNS))
     (SETQ MB.NWAY.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NWAY.DISPLAYFN)
                                   (FUNCTION MB.NWAY.SIZEFN)
                                   (FUNCTION MB.PUTFN)
@@ -1155,7 +1191,8 @@
                                                              (RETURN (DREVERSE LINES])
 
 (MB.NWAY.ADDITEM

-  [LAMBDA (OBJ NEWBUTTON)
                                    (* ; "Edited 20-Oct-2024 00:13 by rmk")


+  [LAMBDA (OBJ NEWBUTTON)
                                    (* ; "Edited  9-Jan-2025 11:38 by rmk")


+                                                             (* ; "Edited 20-Oct-2024 00:13 by rmk")


                                                              (* ; "Edited 29-Sep-2024 12:47 by rmk")


                                                              (* ; "Edited 26-Aug-2024 09:36 by rmk")


                                                              (* ; "Edited 20-Aug-2024 15:46 by rmk")


@@ -1169,7 +1206,7 @@
 
     (CL:WHEN NEWBUTTON
         (LET* [(SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS))
-               [NEWSOBJ (MB.TOGGLE.CREATE
 `((IDENTIFIER ,(U-CASE NEWBUTTON))
+               [NEWSOBJ (MB.TOGGLE.CREATE
 `((IDENTIFIER ,NEWBUTTON)
                                             (LABEL ,NEWBUTTON)
                                             (FONT ,(IMAGEOBJPROP OBJ 'FONT]
                (MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE]
@@ -1230,10 +1267,6 @@
          (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC))
     PC])
 )
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS MB.NWAY.IMAGEFNS)
-)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (MB.NWAY.INIT
)
@@ -1286,7 +1319,8 @@
              (BLTSHADE BLACKSHADE STREAM X Y XSIZE YSIZE 'INVERT))])
 
 (MB.TOGGLE.INIT

-  [LAMBDA NIL
                                                (* ; "Edited  7-Dec-2024 12:33 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited  7-Jan-2025 22:50 by rmk")


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


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


                                                              (* ; "Edited 18-Oct-2024 13:27 by rmk")


                                                              (* ; "Edited  6-Oct-2024 23:43 by rmk")


@@ -1294,6 +1328,7 @@
                                                              (* ; "Edited 24-Aug-2024 10:56 by rmk")


                                                              (* ; "Edited 20-Aug-2024 15:47 by rmk")

                                                              (* jds " 9-Feb-86 15:18")

+    (DECLARE
 (GLOBALVARS MB.TOGGLE.IMAGEFNS))
     (SETQ MB.TOGGLE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.TOGGLE.DISPLAYFN)
                                     (FUNCTION MB.SIZEFN)
                                     (FUNCTION MB.PUTFN)
@@ -1418,10 +1453,6 @@
         ((DESELECTED HIGHLIGHTED UNHIGHLIGHTED))
         NIL])
 )
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS MB.TOGGLE.IMAGEFNS)
-)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (MB.TOGGLE.INIT
)
@@ -1434,7 +1465,11 @@
 (DEFINEQ
 
 (MB.FIELD.CREATE

-  [LAMBDA (SPEC MENUTSTREAM CH#)
                             (* ; "Edited 16-Dec-2024 13:33 by rmk")


+  [LAMBDA (SPEC MENUTSTREAM CH#)
                             (* ; "Edited 16-Feb-2025 15:01 by rmk")


+                                                             (* ; "Edited 11-Jan-2025 09:59 by rmk")


+                                                             (* ; "Edited  9-Jan-2025 16:52 by rmk")


+                                                             (* ; "Edited  5-Jan-2025 12:09 by rmk")


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


                                                              (* ; "Edited  9-Dec-2024 21:53 by rmk")


                                                              (* ; "Edited  4-Dec-2024 15:57 by rmk")


                                                              (* ; "Edited 20-Oct-2024 23:43 by rmk")


@@ -1462,22 +1497,21 @@
           [FIELDFONT (FONTCREATE (OR (CADR (ASSOC 'FIELDFONT SPEC))
                                      '(HELVETICA 8]
           PRE POST FIELDLOOKS PREFIXOBJ SUFFIXOBJ REMAINDER)
-
-         (* ;; "Collect any other properties to put on the prefix")

-
-         (SETQ REMAINDER (for
 S in
 SPEC unless
 (MEMB (CAR S)
-                                                     '(INITSTATE PRELABEL POSTLABEL IDENTIFIER 
-                                                             LABELFONT FIELDFONT)) collect
 S))
+         (if
 (NULL IDENTIFIER)
+             then
 (if
 PRELABEL
+                      then
 [SETQ IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline
+                                                                                    #\:)
+                                                                   PRELABEL]
+                    else
 (ERROR (ERROR "Missing both IDENTIFIER and PRELABEL" SPEC)))
+           elseif
 (OR (LITATOM IDENTIFIER)
+                      (SMALLP IDENTIFIER))
+           elseif
 (STRINGP IDENTIFIER)
+             then
 (SETQ IDENTIFIER (MKATOM IDENTIFIER))
+           else
 (\ILLEGAL.ARG IDENTIFIER))
+         (push
 SPEC (LIST 'IDENTIFIER IDENTIFIER))
 
          (* ;; "SPEC could specify a prelabel font different from a field font")

 
-         (CL:UNLESS IDENTIFIER
-             (if
 PRELABEL
-                 then
 [push
 SPEC (LIST IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab 
-                                                                                          #\Newline 
-                                                                                          #\:)
-                                                                         PRELABEL]
-               else
 (ERROR "NO IDENTIFIER FOR FIELD")))
          [SETQ PRE `((,FIELDFONT " {"]
          (CL:WHEN PRELABEL
              (push
 PRE (LIST LABELFONT PRELABEL)))
@@ -1489,25 +1523,29 @@
 
          (SETQ FIELDLOOKS (\TEDIT.CHARLOOKS.FROM.FONT FIELDFONT))
          (SETQ PREFIXOBJ (MB.FIELD.PREFIXCREATE
 SPEC PRE FIELDLOOKS))
+         (SETQ SUFFIXOBJ (MB.FIELD.SUFFIXCREATE
 SPEC POST FIELDLOOKS))
+         (IMAGEOBJPROP PREFIXOBJ 'SUFFIXOBJ SUFFIXOBJ)
+         [SETQ REMAINDER (MB.SPEC.REMAINDER
 SPEC '(INITSTATE PRELABEL POSTLABEL IDENTIFIER LABELFONT
+                                                         FIELDFONT]
          (for
 S in
 REMAINDER do
 (IMAGEOBJPROP PREFIXOBJ (CAR S)
                                        (CADR S)))
-         (SETQ SUFFIXOBJ (MB.FIELD.SUFFIXCREATE
 SPEC POST FIELDLOOKS))
 
          (* ;; "Let the suffixobj have the same extras as the prefix ?  E.g. DELETABLE ?")

 
          (for
 S in
 REMAINDER do
 (IMAGEOBJPROP SUFFIXOBJ (CAR S)
                                        (CADR S)))
-         (IMAGEOBJPROP PREFIXOBJ 'SUFFIXOBJ SUFFIXOBJ)
 
          (* ;; "")

 
          (TEDIT.INSERT.OBJECT PREFIXOBJ MENUTSTREAM CH# FIELDFONT)
          (add
 CH# 1)
          (CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Initial entry")

-             [TEDIT.INSERT MENUTSTREAM (MKSTRING INITSTATE)
-                    CH#
-                    `(FONT ,FIELDFONT]
-             (add
 CH# (NCHARS INITSTATE)))
+             (add
 CH# (if
 (EQ 'IMAGEOBJ (CADR (ASSOC 'FIELDTYPE SPEC)))
+                          then
 [TEDIT.INSERT.OBJECT INITSTATE MENUTSTREAM CH#
+                                      `(FONT ,FIELDFONT]
+                               1
+                        else
 [TEDIT.INSERT MENUTSTREAM INITSTATE CH# `(FONT ,FIELDFONT]
+                             (NCHARS INITSTATE))))
          (TEDIT.INSERT.OBJECT SUFFIXOBJ MENUTSTREAM CH# FIELDFONT)
          (add
 CH# 1])
 
@@ -1547,7 +1585,9 @@
                               XKERN _ 0])
 
 (MB.FIELD.PREFIXCREATE

-  [LAMBDA (SPEC PRE FIELDLOOKS)
                              (* ; "Edited  9-Dec-2024 21:53 by rmk")


+  [LAMBDA (SPEC PRE FIELDLOOKS)
                              (* ; "Edited 11-Jan-2025 09:58 by rmk")


+                                                             (* ; "Edited  4-Jan-2025 16:53 by rmk")


+                                                             (* ; "Edited  9-Dec-2024 21:53 by rmk")


                                                              (* ; "Edited  7-Dec-2024 09:01 by rmk")


                                                              (* ; "Edited  4-Dec-2024 17:48 by rmk")


                                                              (* ; "Edited  8-Nov-2024 08:36 by rmk")


@@ -1577,12 +1617,12 @@
              (IMAGEOBJPROP OBJ SPEC 'SETSTATEFN (FUNCTION MB.FIELD.SETSTATEFN)))
          (IMAGEOBJPROP OBJ 'FIELDLOOKS FIELDLOOKS)
          (for
 S in
 SPEC unless
 (MEMB (CAR S)
-                                     '(PRELABEL POSTLABEL LABELFONT FIELDFONT))
+                                     '(PRELABEL POSTLABEL LABELFONT IDENTIFIER FIELDFONT))
             do
 (IMAGEOBJPROP OBJ (CAR S)
                       (CADR S)))
          (CL:WHEN (AND EMPTYVALUE (EQ INITSTATE (CADR EMPTYVALUE)))
              (SETQ INITSTATE '**EMPTY**))
-         (CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Can SELECTION be initialized?")

+         (CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**))
              (CL:UNLESS (SELECTQ FIELDTYPE
                             (NUMBER (NUMBERP INITSTATE))
                             (SYMBOL (LITATOM INITSTATE))
@@ -1594,9 +1634,12 @@
                             ((TEXT STRING) 
                                  (STRINGP INITSTATE))
                             (IMAGEOBJ (IMAGEOBJP INITSTATE))
+                            (SELECTION (OR (ATOM INITSTATE)
+                                           (STRINGP INITSTATE)))
                             NIL)
                     (\ILLEGAL.ARG INITSTATE))
              (IMAGEOBJPROP OBJ 'INITSTATE INITSTATE))
+         (IMAGEOBJPROP OBJ 'IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC)))
          (IMAGEOBJPROP OBJ 'FIELDPREFIX T)
          OBJ])
 
@@ -1623,7 +1666,8 @@
          OBJ])
 
 (MB.FIELD.INIT

-  [LAMBDA NIL
                                                (* ; "Edited  7-Dec-2024 09:05 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited  7-Jan-2025 22:51 by rmk")


+                                                             (* ; "Edited  7-Dec-2024 09:05 by rmk")


                                                              (* ; "Edited  4-Dec-2024 16:09 by rmk")


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


                                                              (* ; "Edited 20-Aug-2024 16:03 by rmk")


@@ -1633,6 +1677,7 @@
 
     (* ;; "The displayfn is NILL--field prefixes don't display")

 
+    (DECLARE
 (GLOBALVARS MB.FIELD.IMAGEFNS))
     (SETQ MB.FIELD.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.FIELD.DISPLAYFN)
                                    (FUNCTION MB.FIELD.IMAGEBOXFN)
                                    (FUNCTION MB.PUTFN)
@@ -1840,7 +1885,8 @@
            XKERN _ 0])
 
 (MB.FIELD.INSURETYPE

-  [LAMBDA (FIELDTYPE STR TSTREAM)
                            (* ; "Edited  4-Dec-2024 20:09 by rmk")


+  [LAMBDA (FIELDTYPE STR TSTREAM)
                            (* ; "Edited 24-Mar-2025 09:26 by rmk")


+                                                             (* ; "Edited  4-Dec-2024 20:09 by rmk")


                                                              (* ; "Edited  8-Nov-2024 08:37 by rmk")


                                                              (* ; "Edited 29-Sep-2024 21:52 by rmk")


                                                              (* ; "Edited 31-Aug-2024 12:46 by rmk")


@@ -1861,6 +1907,8 @@
                     ((TEXT STRING)                           (* ; 
 
                                                            "String should be a string, not NIL atom")

                          (SETQ VAL (OR STR '**EMPTY**)))
+                    (TRIMMEDSTRING (CL:UNLESS (STREQUAL "" TRIMMED)
+                                          (SETQ VAL TRIMMED)))
                     ((NUMBER PICAS POSITIVENUMBER SIGNEDNUMBER CARDINAL) 
                          (SETQ TRIMMED (MKATOM TRIMMED))
                          (if
 (OR (EQ 0 (NCHARS TRIMMED))
@@ -1908,34 +1956,30 @@
                     (\TEDIT.THELP "UNRECOGNIZED FIELD TYPE" FIELDTYPE))
                 VAL])
 )
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS MB.FIELD.IMAGEFNS)
-)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (MB.FIELD.INIT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3459 19034 (MB.ADD 3469 . 9058) (MB.DELETE 9060 . 9434) (MB.GET 9436 . 16099) (
-MB.GET.MBARG 16101 . 17770) (TEDITMENU.STREAM 17772 . 18439) (TEDIT.BACKTOMAIN 18441 . 19032)) (19078 
-36844 (MB.BUTTONEVENTINFN 19088 . 20297) (MB.DISPLAYFN 20299 . 22358) (MB.SETIMAGE 22360 . 23528) (
-MB.SIZEFN 23530 . 25078) (MB.WHENOPERATEDONFN 25080 . 27029) (MB.COPYFN 27031 . 27489) (MB.GETFN 27491
- . 28452) (MB.PUTFN 28454 . 29554) (MB.SHOWSELFN 29556 . 31065) (MB.CREATE 31067 . 34052) (
-MB.CHANGENAME 34054 . 34536) (MB.INIT 34538 . 35847) (MB.TRACK.UNTIL 35849 . 36544) (MB.DON'T 36546 . 
-36842)) (37069 46900 (MB.3STATE.CREATE 37079 . 37943) (MB.3STATE.DISPLAYFN 37945 . 38931) (
-MB.3STATE.SHOWSELFN 38933 . 41244) (MB.3STATE.INIT 41246 . 42498) (MB.3STATE.SETSTATEFN 42500 . 43158)
- (MB.3STATE.BUTTONEVENTINFN 43160 . 46898)) (47125 76244 (MB.NWAY.CREATE 47135 . 52645) (
-MB.NWAY.DISPLAYFN 52647 . 53510) (MB.NWAY.WHENOPERATEDONFN 53512 . 55702) (MB.NWAY.SIZEFN 55704 . 
-59640) (MB.NWAY.SELECT 59642 . 62452) (MB.NWAY.BUTTONEVENTINFN 62454 . 65666) (MB.NWAY.NEWMENUBUTTON 
-65668 . 66380) (MB.NWAY.COPYFN 66382 . 67349) (MB.NWAY.INIT 67351 . 68685) (MB.NWAY.ARRANGEBUTTONS 
-68687 . 70658) (MB.NWAY.ADDITEM 70660 . 74422) (MB.NWAY.FINDSUBOBJ 74424 . 74938) (MB.NWAY.SETSTATEFN 
-74940 . 76242)) (76391 88119 (MB.TOGGLE.CREATE 76401 . 77396) (MB.TOGGLE.DISPLAYFN 77398 . 78881) (
-MB.TOGGLE.INIT 78883 . 80523) (MB.SET.TOGGLE 80525 . 81726) (MB.TOGGLE.SETSTATEFN 81728 . 82568) (
-MB.TOGGLE.BUTTONEVENTINFN 82570 . 86774) (MB.TOGGLE.WHENOPERATEDONFN 86776 . 88117)) (88270 119196 (
-MB.FIELD.CREATE 88280 . 93015) (MB.FIELD.DISPLAYFN 93017 . 93808) (MB.FIELD.IMAGEBOXFN 93810 . 95292) 
-(MB.FIELD.PREFIXCREATE 95294 . 98846) (MB.FIELD.SUFFIXCREATE 98848 . 100508) (MB.FIELD.INIT 100510 . 
-102119) (MB.FIELD.WHENOPERATEDONFN 102121 . 103392) (MB.FIELD.GETSTATEFN 103394 . 107328) (
-MB.FIELD.SETSTATEFN 107330 . 112025) (MB.FIELD.BUTTONEVENTINFN 112027 . 114332) (MB.FIELD.SIZEFN 
-114334 . 114574) (MB.FIELD.INSURETYPE 114576 . 119194)))))
+  (FILEMAP (NIL (3253 19106 (MB.ADD 3263 . 9692) (MB.DELETE 9694 . 10068) (MB.GET 10070 . 16840) (
+MB.GET.MBARG 16842 . 18511) (TEDIT.BACKTOMAIN 18513 . 19104)) (19150 39086 (MB.BUTTONEVENTINFN 19160
+ . 20728) (MB.DISPLAYFN 20730 . 22789) (MB.SETIMAGE 22791 . 23959) (MB.SIZEFN 23961 . 25509) (
+MB.WHENOPERATEDONFN 25511 . 27460) (MB.COPYFN 27462 . 27920) (MB.GETFN 27922 . 28883) (MB.PUTFN 28885
+ . 29985) (MB.SHOWSELFN 29987 . 31496) (MB.CREATE 31498 . 35521) (MB.CHANGENAME 35523 . 36005) (
+MB.INIT 36007 . 37468) (MB.TRACK.UNTIL 37470 . 38165) (MB.DON'T 38167 . 38463) (MB.SPEC.REMAINDER 
+38465 . 39084)) (39248 49238 (MB.3STATE.CREATE 39258 . 40122) (MB.3STATE.DISPLAYFN 40124 . 41110) (
+MB.3STATE.SHOWSELFN 41112 . 43423) (MB.3STATE.INIT 43425 . 44836) (MB.3STATE.SETSTATEFN 44838 . 45496)
+ (MB.3STATE.BUTTONEVENTINFN 45498 . 49236)) (49393 80061 (MB.NWAY.CREATE 49403 . 55445) (
+MB.NWAY.DISPLAYFN 55447 . 56310) (MB.NWAY.WHENOPERATEDONFN 56312 . 58502) (MB.NWAY.SIZEFN 58504 . 
+62440) (MB.NWAY.SELECT 62442 . 66012) (MB.NWAY.BUTTONEVENTINFN 66014 . 69226) (MB.NWAY.NEWMENUBUTTON 
+69228 . 69940) (MB.NWAY.COPYFN 69942 . 70909) (MB.NWAY.INIT 70911 . 72402) (MB.NWAY.ARRANGEBUTTONS 
+72404 . 74375) (MB.NWAY.ADDITEM 74377 . 78239) (MB.NWAY.FINDSUBOBJ 78241 . 78755) (MB.NWAY.SETSTATEFN 
+78757 . 80059)) (80140 92027 (MB.TOGGLE.CREATE 80150 . 81145) (MB.TOGGLE.DISPLAYFN 81147 . 82630) (
+MB.TOGGLE.INIT 82632 . 84431) (MB.SET.TOGGLE 84433 . 85634) (MB.TOGGLE.SETSTATEFN 85636 . 86476) (
+MB.TOGGLE.BUTTONEVENTINFN 86478 . 90682) (MB.TOGGLE.WHENOPERATEDONFN 90684 . 92025)) (92108 124532 (
+MB.FIELD.CREATE 92118 . 97569) (MB.FIELD.DISPLAYFN 97571 . 98362) (MB.FIELD.IMAGEBOXFN 98364 . 99846) 
+(MB.FIELD.PREFIXCREATE 99848 . 103784) (MB.FIELD.SUFFIXCREATE 103786 . 105446) (MB.FIELD.INIT 105448
+ . 107215) (MB.FIELD.WHENOPERATEDONFN 107217 . 108488) (MB.FIELD.GETSTATEFN 108490 . 112424) (
+MB.FIELD.SETSTATEFN 112426 . 117121) (MB.FIELD.BUTTONEVENTINFN 117123 . 119428) (MB.FIELD.SIZEFN 
+119430 . 119670) (MB.FIELD.INSURETYPE 119672 . 124530)))))
 STOP

library/tedit/TEDIT-CHAT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16
 12363  
+
(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17
 12449  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS TEDITCHAT.CHARFN)
 
-      :PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
+      :PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16)
 
 
 (PRETTYCOMPRINT TEDIT-CHATCOMS)
@@ -70,7 +70,8 @@
           (replace
 (CHAT.STATE HELD) of
 STATE with
 NIL])
 
 (TEDITCHAT.CHARFN

-  [LAMBDA (CH CHAT.STATE)
                                    (* ; "Edited 24-Jun-2024 00:04 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")


@@ -79,7 +80,7 @@
            (TEXTOBJ (TEXTOBJ TSTREAM)))
           (\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
           (SELCHARQ CH
-               (BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
+               (BS (\TEDIT.CHARDELETE TSTREAM))
                (LF NIL)
                (BOUT TSTREAM CH])
 )
@@ -213,6 +214,6 @@
        CHATDECLS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
- 3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
+  (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-COMMAND

@@ -1,165 +1,31 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133
 49278  
+
(FILECREATED "23-Mar-2025 15:27:20" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;163
 19331  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
+      :CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION? \TEDIT.COMMAND.LOOP)
+                  (VARS TEDIT-COMMANDCOMS)
 
-      :PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
+      :PREVIOUS-DATE "16-Mar-2025 14:20:07" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;160)
 
 
 (PRETTYCOMPRINT TEDIT-COMMANDCOMS)
 
 (RPAQQ TEDIT-COMMANDCOMS

-       [[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
-               (CONSTANTS (MSPACE 153)
-                      (NSPACE 152)
-                      (THINSPACE 159)
-                      (FIGSPACE 154))
-               (EXPORT (CONSTANTS (NONE.TTC 0)
-                              (CHARDELETE.TTC 1)
-                              (WORDDELETE.TTC 2)
-                              (DELETE.TTC 3)
-                              (FUNCTIONCALL.TTC 4)
-                              (REDO.TTC 5)
-                              (UNDO.TTC 6)
-                              (CMD.TTC 7)
-                              (NEXT.TTC 8)
-                              (EXPAND.TTC 9)
-                              (CHARDELETE.FORWARD.TTC 10)
-                              (WORDDELETE.FORWARD.TTC 11)
-                              (PUNCT.TTC 20)
-                              (TEXT.TTC 21)
-                              (WHITESPACE.TTC 22))
-                      (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK)
-                      (RECORDS TEDITTERMCODE)
-                      
-                      (* ;; "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character  (RMK:  THESE DON'T SEEM TO BE USED)")

-
-                      (CONSTANTS (NOTBEFORE.LB 1)
-                                                             (* ; 
-
                                   "Must not break before this character (e.g. Japanese right-paren)")

-                             (NOTAFTER.LB 2)
-                                                             (* ; 
-
                                     "Must not break after this character (e.g. Japanese open-quote)")

-                             (BEFORE.LB 4)
-                                                             (* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)")

-                             (AFTER.LB 8)
-                                                             (* ; 
-
    "OK to break after this char, if it's OK to break before the next one (true of most white space)")

-                             (DISAPPEAR-IF-NOT-SPLIT.LB 16)
-                                                             (* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)")

-                             (NEWCHAR-IF-SPLIT.LB 32)
-                                                             (* ; "Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found.")

-                             ]
-        (FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.LOOP 
-             \TEDIT.COMMAND.RESET.SETUP)
+       ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK)))
+        (FNS \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.FUNCTION?)
+        (FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.RESET.SETUP)
         [INITVARS (TEDIT.INTERRUPTS '((2 BREAK)
                                       (5 ERROR)
                                       (7 HELP)
                                       (20 CONTROL-T]
         (VARS (|| NIL))
-        (GLOBALVARS || TEDIT.INTERRUPTS)
-        (COMS                                                (* ; "Read-table Utilities")

-              (FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX 
-                   TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET 
-                   TEDIT.ATOMBOUND.READTABLE)
-              [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE))
-                                                    (TEDIT.WORDBOUND.READTABLE (
-                                                                           \TEDIT.WORDBOUND.READTABLE
-                                                                                ]
-              (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE))
-        [COMS                                                (* ; "Wheelscroll")

-              (FILES (SYSLOAD FROM LISPUSERS)
-                     WHEELSCROLL)
-              (FNS \TEDIT.WHEELSCROLL)
-              (GLOBALVARS WHEELSCROLLCHARCODES)
-              (VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL]
-        (COMS                                                (* ; "Clipboard")

-              (FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL
-                   )
-              [DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY (CONSTANTS (CLIPBOARDCODES
-                                                                     (CHARCODE (meta,C meta,X meta,c
-                                                                                      meta,X]
-              (P (\TEDIT.CLIPBOARD])
+                                                             (* ; "Why?")

+        (GLOBALVARS || TEDIT.INTERRUPTS)))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ \SCRATCHLEN
 64)
-
-
-(CONSTANTS (\SCRATCHLEN 64))
-)
-
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ MSPACE
 153)
-
-(RPAQQ NSPACE
 152)
-
-(RPAQQ THINSPACE
 159)
-
-(RPAQQ FIGSPACE
 154)
-
-
-(CONSTANTS (MSPACE 153)
-       (NSPACE 152)
-       (THINSPACE 159)
-       (FIGSPACE 154))
-)
-
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
-(RPAQQ NONE.TTC
 0)
-
-(RPAQQ CHARDELETE.TTC
 1)
-
-(RPAQQ WORDDELETE.TTC
 2)
-
-(RPAQQ DELETE.TTC
 3)
-
-(RPAQQ FUNCTIONCALL.TTC
 4)
-
-(RPAQQ REDO.TTC
 5)
-
-(RPAQQ UNDO.TTC
 6)
-
-(RPAQQ CMD.TTC
 7)
-
-(RPAQQ NEXT.TTC
 8)
-
-(RPAQQ EXPAND.TTC
 9)
-
-(RPAQQ CHARDELETE.FORWARD.TTC
 10)
-
-(RPAQQ WORDDELETE.FORWARD.TTC
 11)
-
-(RPAQQ PUNCT.TTC
 20)
-
-(RPAQQ TEXT.TTC
 21)
-
-(RPAQQ WHITESPACE.TTC
 22)
-
-
-(CONSTANTS (NONE.TTC 0)
-       (CHARDELETE.TTC 1)
-       (WORDDELETE.TTC 2)
-       (DELETE.TTC 3)
-       (FUNCTIONCALL.TTC 4)
-       (REDO.TTC 5)
-       (UNDO.TTC 6)
-       (CMD.TTC 7)
-       (NEXT.TTC 8)
-       (EXPAND.TTC 9)
-       (CHARDELETE.FORWARD.TTC 10)
-       (WORDDELETE.FORWARD.TTC 11)
-       (PUNCT.TTC 20)
-       (TEXT.TTC 21)
-       (WHITESPACE.TTC 22))
-)
-(DECLARE%: EVAL@COMPILE 
-
 (PUTPROPS \TEDIT.MOUSESTATE
 MACRO
 (BUTTON 
 
                                  (* ;; "Test to see if only the specified mouse button is down.  DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called.")

@@ -183,39 +49,118 @@
                                                                              (T (KWOTE I]
                                       (T (CONS COMMENTFLG ARGS])
 )
-(DECLARE%: EVAL@COMPILE
-
-(ACCESSFNS TEDITTERMCODE
 ((TTCLASS (LOGAND DATUM 224))
-                          (TTDECODE (LOGAND DATUM 31))))
-)
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ NOTBEFORE.LB
 1)
-
-(RPAQQ NOTAFTER.LB
 2)
-
-(RPAQQ BEFORE.LB
 4)
-
-(RPAQQ AFTER.LB
 8)
-
-(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB
 16)
-
-(RPAQQ NEWCHAR-IF-SPLIT.LB
 32)
-
-
-(CONSTANTS (NOTBEFORE.LB 1)
-       (NOTAFTER.LB 2)
-       (BEFORE.LB 4)
-       (AFTER.LB 8)
-       (DISAPPEAR-IF-NOT-SPLIT.LB 16)
-       (NEWCHAR-IF-SPLIT.LB 32))
-)
 
 (* "END EXPORTED DEFINITIONS")
 
 )
 (DEFINEQ
 
+(\TEDIT.COMMAND.LOOP

+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 23-Mar-2025 09:56 by rmk")


+                                                             (* ; "Edited 16-Mar-2025 14:19 by rmk")


+                                                             (* ; "Edited 17-Feb-2025 12:05 by rmk")


+                                                             (* ; "Edited 28-Nov-2024 10:01 by rmk")


+                                                             (* ; "Edited 21-Nov-2024 11:51 by rmk")


+                                                             (* ; "Edited 13-Sep-2024 22:34 by rmk")


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


+                                                             (* ; "Edited 18-Aug-2024 23:05 by rmk")


+                                                             (* ; "Edited  2-Aug-2024 08:46 by rmk")


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


+                                                             (* ; "Edited 12-Jul-2024 00:39 by rmk")


+                                                             (* ; "Edited  9-Jul-2024 18:02 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 16:24 by rmk")


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


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


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


+                                                             (* ; "Edited 29-Apr-2024 10:58 by rmk")


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


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


+                                                             (* ; "Edited 24-Feb-2024 15:33 by rmk")


+                                                             (* ; "Edited 24-Dec-2023 09:50 by rmk")


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


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

+
+    (* ;; "Main command loop for the TEDIT editor.  Includes keyboard polling and command dispatch")

+
+    (DECLARE
 (SPECVARS TEXTSTREAM))
+    (LET
+     [(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
+     (for
 P inpanes
 TEXTOBJ do
 (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
+                                                             (* ; "Add the process to our panes")

+     (until
 (TTY.PROCESSP) do
                                (* ; 
+
                                               "Wait until we really have the TTY before proceeding.")

+                              (DISMISS 250))
+     (RESETLST
+         (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP
 (LIST TEXTOBJ)
+                           T))
+         (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
+            do
 (ERSETQ (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
+                          do
 (\WAITFORSYSBUFP 25)            (* ; "Await type-in or mouse action")

+                             (while
 (FGETTOBJ TEXTOBJ EDITOPACTIVE) do
 (\TEDIT.FLASHCARET TEXTOBJ) 
+                                                             (* ; 
+
                                                        "Flash caret while other operation completes")

+                                                                       (BLOCK))
+                             (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
+                                 (\TEDIT.FLASHCARET TEXTOBJ) (* ; 
+
                  "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")

+                                 (FSETTOBJ TEXTOBJ EDITOPACTIVE T)
+                                                             (* ; 
+
                                          "Before starting to work, note that we're doing something.")

+
+                                 (* ;; "")

+
+                                 (* ;; 
+
                                 "Handle user type-in. CHARCODE is special so functions can see it.")

+
+                                 [bind
 CHARCODE TCH FN first
 (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ 
+                                                                                      LOOPFN))
+                                                                 (ERSETQ (APPLY* FN TSTREAM)))
+                                    while
 (\SYSBUFP) do
 (SETQ CHARCODE (\GETKEY))
+                                                        (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
+                                                             (* ; 
+
                                                         "The user can control each character typed.")

+                                                            (SETQ TCH (APPLY* FN TSTREAM CHARCODE))
+
+                                                            (* ;; 
+
                                      "Ignore input if TCH=NIL, continue if T, otherwise substitute.")

+
+                                                            (CL:UNLESS (EQ TCH T)
+                                                                   (SETQ CHARCODE TCH)))
+                                                        (CL:WHEN CHARCODE
+                                                            (OR (\TEDIT.COMMAND.FUNCTION? TSTREAM 
+                                                                       CHARCODE)
+                                                                (\TEDIT.INSERT CHARCODE (TEXTSEL
+                                                                                         TEXTOBJ)
+                                                                       TSTREAM NIL T)))])
+                             (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
+               (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
+
+(\TEDIT.COMMAND.FUNCTION?

+  [LAMBDA (TSTREAM CHARCODE)
                                 (* ; "Edited 23-Mar-2025 15:27 by rmk")

+    (DECLARE
 (SPECVARS TSTREAM CHARCODE))
+
+    (* ;; "If CHARCODE is a function in TSTREAM's read table, execute the function.")

+
+    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+          FN)
+         (DECLARE
 (SPECVARS TEXTOBJ))
+         (CL:WHEN [AND (EQ (\TEDIT.TTC FUNCTIONCALL)
+                           (\SYNCODE (fetch
 READSA of
 (FGETTOBJ TEXTOBJ TXTRTBL))
+                                  CHARCODE))
+                       (SETQ FN (CAR (fetch
 MACROFN of
 (GETHASH CHARCODE (fetch
 READMACRODEFS
+                                                                            of
 (FGETTOBJ TEXTOBJ 
+                                                                                      TXTRTBL]
+             (if
 (AND (LISTP FN)
+                      (NOT (FNTYP FN)))
+                 then
 
+                      (* ;; "A form but not a LAMBDA. TSTREAM, TEXTOBJ, and CHARCODE are specvars")

+
+                      (EVAL FN)
+               else
 (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ)))
+             T)])
+)
+(DEFINEQ
+
 (\TEDIT.INTERRUPT.SETUP

   [LAMBDA (PROC FORCEOFF)
                                    (* ; "Edited 27-Mar-2024 15:27 by rmk")


                                                              (* ; "Edited 22-Sep-2023 20:45 by rmk")

@@ -254,133 +199,6 @@
     (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 NIL)
     TEXTOBJ])
 
-(\TEDIT.COMMAND.LOOP

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 28-Nov-2024 10:01 by rmk")


-                                                             (* ; "Edited 21-Nov-2024 11:51 by rmk")


-                                                             (* ; "Edited 13-Sep-2024 22:34 by rmk")


-                                                             (* ; "Edited 26-Aug-2024 23:26 by rmk")


-                                                             (* ; "Edited 18-Aug-2024 23:05 by rmk")


-                                                             (* ; "Edited  2-Aug-2024 08:46 by rmk")


-                                                             (* ; "Edited 13-Jul-2024 23:13 by rmk")


-                                                             (* ; "Edited 12-Jul-2024 00:39 by rmk")


-                                                             (* ; "Edited  9-Jul-2024 18:02 by rmk")


-                                                             (* ; "Edited  7-Jul-2024 16:24 by rmk")


-                                                             (* ; "Edited  3-Jul-2024 12:31 by rmk")


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


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


-                                                             (* ; "Edited 29-Apr-2024 10:58 by rmk")


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


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


-                                                             (* ; "Edited 24-Feb-2024 15:33 by rmk")


-                                                             (* ; "Edited 24-Dec-2023 09:50 by rmk")


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


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

-
-    (* ;; "Main command loop for the TEDIT editor.  Includes keyboard polling and command dispatch")

-
-    (LET
-     [(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
-     (for
 P inpanes
 TEXTOBJ do
 (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
-                                                             (* ; "Add the process to our panes")

-     (until
 (TTY.PROCESSP) do
                                (* ; 
-
                                               "Wait until we really have the TTY before proceeding.")

-                              (DISMISS 250))
-     (RESETLST
-         (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP
 (LIST TEXTOBJ)
-                           T))
-         (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
-            do

-            (ERSETQ
-             (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
-                do

-                (\WAITFORSYSBUFP 25)                         (* ; "Await type-in or mouse action")

-                (while
 (FGETTOBJ TEXTOBJ EDITOPACTIVE) do
 (\TEDIT.FLASHCARET TEXTOBJ) 
-                                                             (* ; 
-
                                                        "Flash caret while other operation completes")

-                                                          (BLOCK))
-                (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
-                    (\TEDIT.FLASHCARET TEXTOBJ)              (* ; 
-
                  "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")

-                    (FSETTOBJ TEXTOBJ EDITOPACTIVE T)        (* ; 
-
                                          "Before starting to work, note that we're doing something.")

-
-                    (* ;; "")

-
-                    (* ;; "Handle user type-in")

-
-                    [bind
 CH TCH FN first
 (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN))
-                                              (ERSETQ (APPLY* FN TSTREAM))) while
 (\SYSBUFP)
-                       do
 (SETQ CH (\GETKEY))
-                          (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
-                                                             (* ; 
-
                                                "Give the OEM user control for each character typed.")

-                              (SETQ TCH (APPLY* FN TSTREAM CH))
-
-                              (* ;; 
-
      "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")

-
-                              (OR (EQ TCH T)
-                                  (SETQ CH TCH)))
-                          (SELECTC (AND CH (\SYNCODE (fetch
 READSA of
 (FGETTOBJ TEXTOBJ TXTRTBL))
-                                                  CH))
-                              (CHARDELETE.TTC 
-                                   (\TEDIT.CHARDELETE TSTREAM))
-                              (CHARDELETE.FORWARD.TTC 
-                                   (\TEDIT.CHARDELETE TSTREAM T))
-                              (WORDDELETE.TTC 
-                                   (\TEDIT.WORDDELETE TSTREAM))
-                              (WORDDELETE.FORWARD.TTC 
-                                   (\TEDIT.WORDDELETE.FORWARD TSTREAM))
-                              (DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
-                              (UNDO.TTC                      (* ; 
-
                                                  "Take off the BPD, the undoing and put it back on.")

-                                        (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
-                                        (TEDIT.UNDO TSTREAM))
-                              (REDO.TTC                      (* ; 
-
                                                          "He hit the REDO key, so go REDO something")

-                                        (TEDIT.REDO TSTREAM)
-                                        (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ))
-                              (FUNCTIONCALL.TTC              (* ; 
-
                                                 "This is a special character -- it calls a function")

-                                   (CL:WHEN [SETQ FN (CAR (fetch
 MACROFN
-                                                             of
 (GETHASH CH (fetch
 READMACRODEFS
-                                                                               of
 (FGETTOBJ TEXTOBJ 
-                                                                                         TXTRTBL]
-                                                             (* ; 
-
                                                          "There IS a command function to be called.")

-                                       (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))
-                                                             (* ; "do it")

-                                                             (* ; 
-
                        "After a user function (that is not wheelscroll) no more blue-pending-delete")

-
-                                       (* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")

-
-                                       (CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
-                                                      (MEMB CH CLIPBOARDCODES))
-                                                             (* ; 
-
                                    "The FNs handled the selection. should preserve the highlighting")

-                                           (\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
-                                           (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
-                                           (\TEDIT.SHOWSEL NIL T TEXTOBJ))))
-                              (NEXT.TTC                      (* ; 
-
                                            "Move to the next blank to fill in, delimited by >>...<<")

-                                        (TEDIT.NEXT TSTREAM))
-                              (EXPAND.TTC                    (* ; "EXPAND AN ABBREVIATION")

-                                          (\TEDIT.ABBREV.EXPAND TSTREAM))
-                              (SELECTC (AND CH (fetch
 TERMCLASS of
 (\SYNCODE (OR (FGETTOBJ TEXTOBJ 
-                                                                                        TXTTERMSA)
-                                                                                 \PRIMTERMSA)
-                                                                          CH)))
-                                  (CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM))
-                                  (WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM))
-                                  (LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ))
-                                  (CL:WHEN CH                (* ; 
-
                                                             "Any other key: insert the character.")

-                                      (\TEDIT.INSERT CH (TEXTSEL TEXTOBJ)
-                                             TSTREAM NIL T))])
-                (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
-            (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
-
 (\TEDIT.COMMAND.RESET.SETUP

   [LAMBDA (ARGS STARTING)
                                    (* ; "Edited 29-Jun-2024 00:10 by rmk")


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


@@ -478,445 +296,17 @@
                           (20 CONTROL-T)))
 
 (RPAQQ ||
 NIL)
+
+
+
+(* ; "Why?")

+
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS || TEDIT.INTERRUPTS)
 )
-
-
-
-(* ; "Read-table Utilities")

-
-(DEFINEQ
-
-(\TEDIT.READTABLE

-  [LAMBDA NIL
                                                (* ; "Edited 24-Dec-2023 09:54 by rmk")


-                                                            (* ; "Edited 20-Apr-2018 07:59 by rmk:")

-                                                             (* jds "12-Sep-86 13:48")

-
-    (* ;; "Create a TEdit read-table, to control which characters have what functions and call which commands.")

-
-    (LET [(RTBL (create
 READTABLEP
-                       READMACRODEFS _ (HASHARRAY 50]
-
-         (* ;; "CHARDELETE.FORWARD replaces WORDDELETE on ^W")

-
-         (for
 CH in
 (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as
 CL
-            in
 (CONSTANT (LIST CHARDELETE.TTC CHARDELETE.TTC CHARDELETE.FORWARD.TTC DELETE.TTC 
-                               UNDO.TTC NEXT.TTC CMD.TTC REDO.TTC))
-            do
                                               (* ; 
-
                                           "Set up the default syntax classes for command characters")

-               (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                      CH CL))
-         (for
 CH in
 (CHARCODE (^X)) as
 FN in
 '(\TEDIT.ABBREV.EXPAND)
-            do
                                               (* ; 
-
                      "Set up the default function-calling characters (^X to expand abbrevs for now)")

-               (TEDIT.SETFUNCTION
 CH FN RTBL))
-         (TEDIT.SETFUNCTION
 (CHARCODE ^O)
-                (FUNCTION GET.OBJ.FROM.USER)
-                RTBL)                                        (* ; "And for image object capture")

-         RTBL])
-
-(\TEDIT.WORDBOUND.READTABLE

-  [LAMBDA NIL
                                                (* ; "Edited 22-May-92 15:10 by jds")

-
-    (* ;; "Create a readtable which will let TEdit find word boundaries.  A word boundary is any point where the SYNCODE of the adjacent characters is different")

-
-    (PROG [(RTBL (create
 READTABLEP
-                        READMACRODEFS _ (HARRAY 50]
-          (for
 CH from
 0 to
 255 do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                                          CH PUNCT.TTC))
-
-     (* ;; "By default, every character except those noted below is a punctuation character")

-
-          (for
 CH from
 (CHARCODE A) to
 (CHARCODE Z) do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                                                              CH TEXT.TTC))
-                                                             (* ; "Upper case alpha")

-          (for
 CH from
 (CHARCODE a) to
 (CHARCODE z) do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                                                              CH TEXT.TTC))
-                                                             (* ; "Lower case alpha")

-          (for
 CH from
 (CHARCODE 0) to
 (CHARCODE 9) do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                                                              CH TEXT.TTC))
-                                                             (* ; "And digits are text characters")

-
-     (* ;; "European chars and accents are text characters:")

-
-          (for
 CH from
 (CHARCODE "361,41") to
 (CHARCODE "361,376")
-             do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                       CH TEXT.TTC))
-          (for
 CH from
 (CHARCODE "0,301") to
 (CHARCODE "0,317")
-             do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                       CH TEXT.TTC))
-          (for
 CH from
 (CHARCODE "0,341") to
 (CHARCODE "0,376")
-             do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                       CH TEXT.TTC))
-          (for
 CH in
 (CHARCODE (CR SPACE TAB ^L)) do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                                                            CH WHITESPACE.TTC))
-                                                             (* ; "And these are white space")

-          (for
 CH in
 (LIST MSPACE NSPACE THINSPACE FIGSPACE)
-             do
 (\SETSYNCODE (fetch
 READSA of
 RTBL)
-                       CH TEXT.TTC))
-          (RETURN RTBL])
-
-(TEDIT.GETSYNTAX

-  [LAMBDA (CH TABLE)
                                         (* ; "Edited 24-Dec-2023 09:47 by rmk")


-                                                             (* ; "Edited 31-Mar-87 10:01 by jds")

-                                                             (* ; 
-
                                                   "Find TEdit's interpretation of a given character")

-    (SELECTC (\SYNCODE [fetch
 READSA of
 (COND
-                                           ((type?
 TEXTOBJ TABLE)
-                                                             (* ; 
-
     "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")

-                                            (OR (fetch
 (TEXTOBJ TXTRTBL) of
 TABLE)
-                                                TEDIT.READTABLE))
-                                           ((type?
 STREAM TABLE)
-                                                             (* ; 
-
     "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")

-                                            (OR (fetch
 (TEXTOBJ TXTRTBL) of
 (fetch
 (TEXTSTREAM 
-                                                                                          TEXTOBJ)
-                                                                               of
 TABLE))
-                                                TEDIT.READTABLE))
-                                           (T (OR TABLE TEDIT.READTABLE]
-                    (COND
-                       ((LITATOM CH)                         (* ; 
-
                                                         "Symbols are converted to numeric charcodes")

-                        (APPLY* 'CHARCODE CH))
-                       ((STRINGP CH)                         (* ; "As are string char-names")

-                        (APPLY* 'CHARCODE CH))
-                       (T CH)))
-        (WORDDELETE.TTC 
-             'WORDDELETE)
-        (WORDDELETE.FORWARD.TTC 
-             'WORDDELETE.FORWARD)
-        (CHARDELETE.TTC 
-             'CHARDELETE)
-        (CHARDELETE.FORWARD.TTC 
-             'CHARDELETE.FORWARD)
-        (DELETE.TTC 'DELETE)
-        (UNDO.TTC 'UNDO)
-        (REDO.TTC 'REDO)
-        (FUNCTIONCALL.TTC 
-             'FN)
-        (CMD.TTC 'CMD)
-        (NEXT.TTC 'NEXT)
-        (EXPAND.TTC 'EXPAND)
-        NIL])
-
-(TEDIT.SETSYNTAX

-  [LAMBDA (CHAR CLASS TABLE)
                                 (* ; "Edited 24-Dec-2023 09:17 by rmk")


-                                                             (* ; "Edited 31-Mar-87 10:00 by jds")

-                                                             (* ; 
-
                                                        "SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE")

-    (PROG1 (TEDIT.GETSYNTAX
 (SETQ CHAR (COND
-                                          ((LITATOM CHAR)
-                                           (APPLY* 'CHARCODE CHAR))
-                                          ((STRINGP CHAR)
-                                           (APPLY* 'CHARCODE CHAR))
-                                          (T CHAR)))
-                  TABLE)
-        (\SETSYNCODE [fetch
 READSA of
 (COND
-                                         ((type?
 TEXTOBJ TABLE)
-                                                             (* ; 
-
     "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")

-                                          (OR (fetch
 (TEXTOBJ TXTRTBL) of
 TABLE)
-                                              TEDIT.READTABLE))
-                                         ((type?
 STREAM TABLE)
-                                                             (* ; 
-
     "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")

-                                          (OR (fetch
 (TEXTOBJ TXTRTBL) of
 (fetch
 (TEXTSTREAM TEXTOBJ)
-                                                                             of
 TABLE))
-                                              TEDIT.READTABLE))
-                                         (T (OR TABLE TEDIT.READTABLE]
-               CHAR
-               (SELECTQ CLASS
-                   (CHARDELETE CHARDELETE.TTC)
-                   (CHARDELETE.FORWARD 
-                        CHARDELETE.FORWARD.TTC)
-                   (WORDDELETE WORDDELETE.TTC)
-                   (WORDDELETE.FORWARD 
-                        WORDDELETE.FORWARD.TTC)
-                   ((DELETE LINEDELETE) 
-                        DELETE.TTC)
-                   (UNDO UNDO.TTC)
-                   (REDO REDO.TTC)
-                   (CMD CMD.TTC)
-                   (FN FUNCTIONCALL.TTC)
-                   (NEXT NEXT.TTC)
-                   (EXPAND EXPAND.TTC)
-                   NONE.TTC)))])
-
-(TEDIT.GETFUNCTION

-  [LAMBDA (CHARCODE TABLE)                                   (* jds "19-Sep-85 17:06")

-                                                             (* Gets the FN that is called when CH 
-
                                                             is hit inside TEDIT.)

-    [SETQ TABLE (COND
-                   ((type?
 TEXTOBJ TABLE)
-
-         (* If given a TEXTOBJ in place of a read table, coerce it to the read table for 
-
         that edit session)

-
-                    (fetch
 (TEXTOBJ TXTRTBL) of
 TABLE))
-                   ((type?
 STREAM TABLE)
-
-         (* If given a TEXTOBJ in place of a read table, coerce it to the read table for 
-
         that edit session)

-
-                    (fetch
 (TEXTOBJ TXTRTBL) of
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 TABLE)))
-                   (T (OR TABLE TEDIT.READTABLE]
-    (SETQ CHARCODE (COND
-                      ((LITATOM CHARCODE)
-                       (APPLY* 'CHARCODE CHARCODE))
-                      (T CHARCODE)))
-    (AND TABLE (type?
 READTABLEP TABLE)
-         (IEQP FUNCTIONCALL.TTC (\SYNCODE (fetch
 READSA of
 TABLE)
-                                       CHARCODE))
-         (fetch
 READMACRODEFS of
 TABLE)
-         (CAR (FETCH
 MACROFN OF
 (GETHASH CHARCODE (fetch
 READMACRODEFS of
 TABLE])
-
-(TEDIT.SETFUNCTION

-  [LAMBDA (CHARCODE FN RTBL)
                                 (* ; "Edited 31-Mar-87 10:58 by jds")

-                                                             (* ; 
-
                           "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.")

-                                                             (* ; 
-
                                                  "If FN is NIL, make the character be normal again.")

-    [SETQ RTBL (COND
-                  ((type?
 TEXTOBJ RTBL)                      (* ; 
-
     "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")

-                   (fetch
 (TEXTOBJ TXTRTBL) of
 RTBL))
-                  ((type?
 STREAM RTBL)                       (* ; 
-
     "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")

-                   (fetch
 (TEXTOBJ TXTRTBL) of
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 RTBL)))
-                  (T (OR RTBL TEDIT.READTABLE]
-    (\SETSYNCODE (fetch
 READSA of
 RTBL)
-           (SETQ CHARCODE (COND
-                             ((LITATOM CHARCODE)
-                              (APPLY* 'CHARCODE CHARCODE))
-                             ((STRINGP CHARCODE)
-                              (APPLY* 'CHARCODE CHARCODE))
-                             (T CHARCODE)))
-           (COND
-              (FN                                            (* ; 
-
                                 "He gave us a function to call.  Set up the syntax so it IS called.")

-                  FUNCTIONCALL.TTC)
-              (T                                             (* ; 
-
      "He gave us a function of NIL, meaning 'turn it off' .  Cause this character to become normal.")

-                 NONE.TTC)))                                 (* ; 
-
                                                          "Mark the character as invoking a function")

-    (OR (fetch
 READMACRODEFS of
 RTBL)
-        (replace
 READMACRODEFS of
 RTBL with
 (HARRAY 50)))    (* ; 
-
                                           "Make sure there's a hash table to store the function in.")

-    (PUTHASH CHARCODE (CREATE
 READMACRODEF
-                             MACROTYPE _ 'TEDIT
-                             MACROFN _ (LIST FN))
-           (fetch
 READMACRODEFS of
 RTBL])
-
-(TEDIT.WORDGET

-  [LAMBDA (CH TABLE)                                         (* jds "27-MAY-83 13:24")

-    (\SYNCODE (fetch
 READSA of
 (OR TABLE TEDIT.WORDBOUND.READTABLE))
-           (COND
-              ((SMALLP CH))
-              (T (CHCON1 CH])
-
-(TEDIT.WORDSET

-  [LAMBDA (CHARCODE CLASS TABLE)                             (* jds " 1-JUN-83 12:23")

-                                                             (* SETS TEDIT-STYLE SYNTAX BITS IN A 
-
                                                             TERMTABLE)

-    (\SETSYNCODE (fetch
 READSA of
 (OR TABLE TEDIT.WORDBOUND.READTABLE))
-           (COND
-              ((SMALLP CHARCODE))
-              (T (CHCON1 CHARCODE)))
-           (COND
-              ((FIXP CLASS))
-              (T (SELECTQ CLASS
-                     (PUNCTUATION PUNCT.TTC)
-                     (WHITESPACE WHITESPACE.TTC)
-                     (TEXT TEXT.TTC)
-                     TEXT.TTC])
-
-(TEDIT.ATOMBOUND.READTABLE

-  [LAMBDA (READTABLE)
                                        (* ; "Edited 25-Dec-2023 13:10 by rmk")


-                                                             (* ; "Edited  5-Dec-2023 23:47 by rmk")

-
-    (* ;; "A wordbound table that approximates the unquoted OTHER characters of Lisp atoms as defined by READTABLE or the current readtable.  This is specified as the BOUNDTABLE for Lisp source code edits.  Not perfect, but not bad.")

-
-    (* ;; "Could cache this for common readtables (interlisp, commonlisp)")

-
-    (LET ((TABLE (\TEDIT.WORDBOUND.READTABLE
)))              (* ; 
-
                                            "\TEDIT.WORDBOUND.READTABLE creates a new one each time.")

-         (for
 CODE IN
 (GETSYNTAX 'OTHER (OR READTABLE *READTABLE*)) do
 (TEDIT.WORDSET
 CODE
-                                                                              'TEXT TABLE))
-         (for
 CODE IN
 (GETSYNTAX 'BREAK (OR READTABLE *READTABLE*)) do
 (TEDIT.WORDSET
 CODE
-                                                                              'PUNCTUATION TABLE))
-         (TEDIT.WORDSET
 (CHARCODE %:)
-                'TEXT TABLE)
-         TABLE])
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(RPAQ TEDIT.READTABLE
 (\TEDIT.READTABLE))
-
-(RPAQ TEDIT.WORDBOUND.READTABLE
 (\TEDIT.WORDBOUND.READTABLE))
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)
-)
-
-
-
-(* ; "Wheelscroll")

-
-
-(FILESLOAD (SYSLOAD FROM LISPUSERS)
-       WHEELSCROLL)
-(DEFINEQ
-
-(\TEDIT.WHEELSCROLL

-  [LAMBDA NIL
                                                (* ; "Edited  2-Oct-2023 23:23 by rmk")

-
-    (* ;; "TEDIT disables interrupts, so it has to deal with wheelscroll behaviors when the caret is in the Tedit window. Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")

-
-    (* ;; "This localizes the behavior inside Tedit, where we also suppress Tedit from thinking that somehow these characters change the selection highlighting.")

-
-    (for
 I in
 WHEELSCROLLINTERRUPTS collect
 (TEDIT.SETFUNCTION
 (CAR I)
-                                                   `[LAMBDA NIL
-                                                      (AND WHEELSCROLLENABLED ,(CADR I]
-                                                   TEDIT.READTABLE)
-                                          (CAR I])
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS WHEELSCROLLCHARCODES)
-)
-
-(RPAQ WHEELSCROLLCHARCODES
 (\TEDIT.WHEELSCROLL))
-
-
-
-(* ; "Clipboard")

-
-(DEFINEQ
-
-(\TEDIT.CLIPBOARD

-  [LAMBDA NIL
                                                (* ; "Edited 21-Apr-2024 09:57 by rmk")


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

-
-    (* ;; "TEDIT disables interrupts, so it has to deal with special interrupt behaviors when the caret is in the Tedit window. This localizes the behavior of WHEELSCROLL and CLIPBOARD inside Tedit.")

-
-    (* ;; "Clipboard paste")

-
-    (TEDIT.SETFUNCTION
 (CHARCODE "Meta,v")
-           (FUNCTION PASTEFROMCLIPBOARD)
-           TEDIT.READTABLE)
-    (TEDIT.SETFUNCTION
 (CHARCODE "Meta,V")
-           (FUNCTION PASTEFROMCLIPBOARD)
-           TEDIT.READTABLE)
-
-    (* ;; "Clipboard copy")

-
-    (TEDIT.SETFUNCTION
 (CHARCODE "Meta,c")
-           (FUNCTION \TEDIT.COPYTOCLIPBOARD)
-           TEDIT.READTABLE)
-    (TEDIT.SETFUNCTION
 (CHARCODE "Meta,C")
-           (FUNCTION \TEDIT.COPYTOCLIPBOARD)
-           TEDIT.READTABLE)
-
-    (* ;; "Clipboard extract")

-
-    (TEDIT.SETFUNCTION
 (CHARCODE "Meta,X")
-           (FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
-           TEDIT.READTABLE)
-    (TEDIT.SETFUNCTION
 (CHARCODE "Meta,x")
-           (FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
-           TEDIT.READTABLE)
-
-    (* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")

-
-    (for
 I in
 WHEELSCROLLINTERRUPTS collect
 (TEDIT.SETFUNCTION
 (CAR I)
-                                                   `[LAMBDA NIL
-                                                      (AND WHEELSCROLLENABLED ,(CADR I]
-                                                   TEDIT.READTABLE)
-                                          (CAR I])
-
-(\TEDIT.COPYTOCLIPBOARD

-  [LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT)
                      (* ; "Edited 21-Apr-2024 11:51 by rmk")


-                                                             (* ; "Edited  2-Apr-2024 17:01 by rmk")


-                                                            (* ; "Edited 18-Apr-2018 00:02 by rmk:")

-
-    (* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored).  .")

-
-    (CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD))
-        (SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS))
-                             T))
-        (CL:WHEN TSTREAM
-            (PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL))
-            (CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))])
-
-(\TEDIT.EXTRACTTOCLIPBOARD

-  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 21-Apr-2024 09:20 by rmk")

-    (\TEDIT.COPYTOCLIPBOARD
 TSTREAM TEXTOBJ SEL T])
-
-(\TEDIT.WRITE.SEL

-  [LAMBDA (TSTREAM STREAM)
                                   (* ; "Edited 21-Apr-2024 11:55 by rmk")

-
-    (* ;; "Writes the selected characters in TSTREAM to STREAM.  ")

-
-    (* ;; "If there are no image objects, this is equivalent to (PRIN3 (TEDIT.SEL.AS.STRING ...)), but that would trip over image objects.  Image objects could be skipped, or as here, represented as the OBJECTBYTE or described in some way.")

-
-    (* ;; "For Medley-to-Medley copy/paste we could also create a local tmp stream that shadows the system clipboard, and apply the PUTFN to that stream.  Then copy/paste could be used to move image objects around with a single Medley or perhaps across Medley's (if the GETFN is available).")

-
-    (LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
-           (SEL (FGETTOBJ TEXTOBJ SEL)))
-          (CL:WHEN (IGREATERP (GETSEL SEL DCH)
-                          0)
-
-              (* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.")

-
-              (for
 I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE))
-                   (NOBJECTS _ 0) from
 (GETSEL SEL CH#) to
 (SUB1 (GETSEL SEL CHLIM))
-                 while
 (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I))
-                 do
 (if
 (CHARCODEP CODE)
-                        then
 (PRINTCCODE CODE STREAM)
-                      elseif
 (IMAGEOBJP CODE)
-                        then
 (add
 NOBJECTS 1)
-                             (if
 OBJECTBYTE
-                                 then
 (PRINTCCODE OBJECTBYTE STREAM)
-                               else
 (PRIN3 "{" STREAM)
-                                    (PRIN4 (IMAGEOBJPROP CODE 'GETFN)
-                                           STREAM)
-                                    (CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN)
-                                                                   (FUNCTION NILL))
-                                                              PRE CODE))
-                                        (PRIN3 " : " STREAM)
-                                        (PRIN4 PRE STREAM))
-                                    (PRIN3 "}" STREAM))
-                      else
 (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE))
-                 finally
 (CL:WHEN (IGREATERP NOBJECTS 0)
-                             (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note:  Selection contains " NOBJECTS
-                                                               " image object"
-                                                               (CL:IF (EQ NOBJECTS 1)
-                                                                   ""
-                                                                   "s"))
-                                    T))))])
-)
-(DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQ CLIPBOARDCODES
 (CHARCODE (meta,C meta,X meta,c meta,X)))
-
-
-[CONSTANTS (CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X]
-)
-)
-
-(\TEDIT.CLIPBOARD
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8312 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
-\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP 
-19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 . 
-31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 . 
-37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) (
-TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441 
-49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) (
-\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019)))))
+  (FILEMAP (NIL (2688 10242 (\TEDIT.COMMAND.LOOP 2698 . 9039) (\TEDIT.COMMAND.FUNCTION? 9041 . 10240)) (
+10243 19041 (\TEDIT.INTERRUPT.SETUP 10253 . 11900) (\TEDIT.MARKACTIVE 11902 . 12231) (
+\TEDIT.MARKINACTIVE 12233 . 12449) (\TEDIT.COMMAND.RESET.SETUP 12451 . 19039)))))
 STOP

library/tedit/TEDIT-FILE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Dec-2024 23:02:54" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;592
 159471 
+
(FILECREATED "28-Mar-2025 14:24:34" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;608
 161966 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.PUT TEDIT.PUT.STREAM)
+      :CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE)
 
-      :PREVIOUS-DATE "16-Dec-2024 11:25:16" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;591)
+      :PREVIOUS-DATE "26-Mar-2025 10:02:49" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;607)
 
 
 (PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -55,6 +55,7 @@
               (FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
         (GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*)
         (FNS TEDITFROMLISPSOURCE SHELLSCRIPTP TEDITFROMSHELLSCRIPT)
+        (INITVARS (TEDIT.SOURCE.LINELENGTH 110))
         (ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
                         (SHELLSCRIPTP TEDITFROMSHELLSCRIPT)))
         (INITVARS                                            (* ; 
@@ -117,7 +118,8 @@
 (DEFINEQ
 
 (TEDIT.GET

-  [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS)
                  (* ; "Edited 26-Aug-2024 16:15 by rmk")


+  [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS)
                  (* ; "Edited 14-Mar-2025 11:52 by rmk")


+                                                             (* ; "Edited 26-Aug-2024 16:15 by rmk")


                                                              (* ; "Edited 11-Aug-2024 12:13 by rmk")


                                                              (* ; "Edited 29-Jun-2024 16:30 by rmk")


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


@@ -151,7 +153,7 @@
               [SETQ FILE (\TEDIT.MAKEFILENAME (OR FILE (TEDIT.GETINPUT TEXTOBJ "GET from: "
                                                               (OR (GETTEXTPROP TEXTOBJ 
                                                                          'LASTGETFILENAME)
-                                                                  (\TEXTSTREAM.FILENAME TEXTOBJ]
+                                                                  (\TEDIT.LIKELY.FILENAME TEXTOBJ]
               (CL:UNLESS FILE
                   (TEDIT.PROMPTPRINT TEXTOBJ "No input file--aborted" T T)
                   (RETURN))
@@ -249,7 +251,8 @@
                  (GDATE IDATE)))])
 
 (TEDIT.INCLUDE

-  [LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT)
            (* ; "Edited 25-Nov-2024 20:17 by rmk")


+  [LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT)
            (* ; "Edited  8-Feb-2025 20:56 by rmk")


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


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


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


                                                              (* ; "Edited  7-Jul-2024 22:03 by rmk")


@@ -364,7 +367,7 @@
               [SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL START END
                                     `(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TOOBJ TSEL)
                                            PARALOOKS
-                                           ,(GETTOBJ TOOBJ FMTSPEC)
+                                           ,(GETTOBJ TOOBJ DEFAULTPARALOOKS)
                                            PLAINTEXT
                                            ,PLAINTEXT]
 
@@ -389,7 +392,9 @@
     (TEDIT.INCLUDE
 TSTREAM INFILE START END SAFE T])
 
 (TEDIT.PUT

-  [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT)
        (* ; "Edited 23-Dec-2024 23:02 by rmk")


+  [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET)
  (* ; "Edited 14-Mar-2025 11:52 by rmk")


+                                                             (* ; "Edited 22-Feb-2025 15:56 by rmk")


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


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


                                                              (* ; "Edited 29-Jun-2024 10:31 by rmk")


                                                              (* ; "Edited 26-Jun-2024 15:46 by rmk")


@@ -450,10 +455,11 @@
                                           (SETQ FORCENEW 'DETEMPLATE)))
                                   [SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Put to: "
                                                                          (CL:UNLESS FORCENEW
-                                                                                (\TEXTSTREAM.FILENAME
+                                                                                (
+                                                                               \TEDIT.LIKELY.FILENAME
                                                                                  TEXTOBJ UNFORMATTED?
                                                                                  ])
-                             (T (SETQ FILE (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED?)))
+                             (T (SETQ FILE (\TEDIT.LIKELY.FILENAME TEXTOBJ UNFORMATTED?)))
                              NIL)
                          (CL:UNLESS FILE                     (* ; "No file to put to.")

                              (TEDIT.PROMPTPRINT TEXTOBJ "No output file--aborted" T T)
@@ -479,9 +485,10 @@
                          '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
                   [RESETSAVE (\TEDIT.PUTRESET
 (CONS (THIS.PROCESS)
                                                     'DON'T]
-                  (SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
-                                         "..."))
-                  (TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T)
+                  (CL:UNLESS QUIET
+                      (SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
+                                             "..."))
+                      (TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T))
 
              (* ;; "")

 
@@ -508,8 +515,9 @@
 
              (* ;; "")

 
-                  (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
-                         T)
+                  (CL:UNLESS QUIET
+                      (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
+                             T))
 
              (* ;; "")

 
@@ -572,7 +580,9 @@
 (DEFINEQ
 
 (\TEDIT.GET.FOREIGN.FILE

-  [LAMBDA (TEXT TSTREAM START END PROPS)
                     (* ; "Edited 17-Mar-2024 00:21 by rmk")


+  [LAMBDA (TEXT TSTREAM START END PROPS)
                     (* ; "Edited  8-Feb-2025 20:20 by rmk")


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


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


                                                              (* ; "Edited 22-Oct-2023 20:40 by rmk")


                                                              (* ; "Edited 18-Sep-2023 16:40 by rmk")


                                                              (* ; "Edited 10-Aug-2023 17:26 by rmk")


@@ -606,15 +616,16 @@
                  (SETQ FTEXTOBJ (TEXTOBJ FSTREAM))
                  (\TEDIT.INSERTPIECES (\TEDIT.FIRSTPIECE FTEXTOBJ)
                         NIL TTEXTOBJ)
-                 (FSETTOBJ TTEXTOBJ LASTPIECE (FGETTOBJ FTEXTOBJ LASTPIECE))
+                 (FSETTOBJ TTEXTOBJ SUFFIXPIECE (FGETTOBJ FTEXTOBJ SUFFIXPIECE))
                                                              (* ; "Last piece  have different looks")

                  (FSETTOBJ TTEXTOBJ TXTPAGEFRAMES (FGETTOBJ FTEXTOBJ TXTPAGEFRAMES))
-                 (FSETTOBJ TTEXTOBJ FMTSPEC (FGETTOBJ FTEXTOBJ FMTSPEC))
+                 (FSETTOBJ TTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ FTEXTOBJ DEFAULTPARALOOKS))
                  (FSETTOBJ TTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FTEXTOBJ DEFAULTCHARLOOKS)))
              TSTREAM)])
 
 (\TEDIT.GET.UNFORMATTED.FILE

-  [LAMBDA (STREAM TSTREAM START END PROPS)
                   (* ; "Edited 17-Mar-2024 00:21 by rmk")


+  [LAMBDA (STREAM TSTREAM START END PROPS)
                   (* ; "Edited  8-Feb-2025 20:21 by rmk")


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


                                                              (* ; "Edited  5-Feb-2024 09:26 by rmk")


                                                              (* ; "Edited 21-Jan-2024 09:42 by rmk")


                                                              (* ; "Edited 29-Dec-2023 11:52 by rmk")


@@ -633,7 +644,7 @@
               DEFAULTCHARLOOKS DEFAULTPARALOOKS PIECES)
              (PUTTEXTPROP TEXTOBJ 'CLEARGET T)
              (SETQ DEFAULTCHARLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-             (SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ FMTSPEC))
+             (SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ DEFAULTPARALOOKS))
              (CL:WHEN (AND (EQ FORMAT :STRING)
                            (\IOMODEP STREAM 'OUTPUT T))
                  (SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
@@ -675,7 +686,9 @@
              (\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
 
 (\TEDIT.GET.FORMATTED.FILE

-  [LAMBDA (TEXT TSTREAM START END PROPS)
                     (* ; "Edited 28-Oct-2024 17:48 by rmk")


+  [LAMBDA (TEXT TSTREAM START END PROPS)
                     (* ; "Edited 28-Mar-2025 14:15 by rmk")


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


+                                                             (* ; "Edited 28-Oct-2024 17:48 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:25 by rmk")


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


@@ -709,13 +722,14 @@
                     (\TEDIT.GET.PCTB0 TEXT TSTREAM (CADR PCCOUNT)
                            PCCOUNT START END))
                  (\TEDIT.THELP "File format version incompatible with this version of TEdit."))
-             (CL:WHEN (SETQ PC (PREVPIECE (\TEDIT.LASTPIECE TEXTOBJ)))
+             (CL:WHEN (SETQ PC (\TEDIT.LASTPIECE TEXTOBJ))
                     (FSETPC PC PPARALAST T))
-             (\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL)
+             (\TEDIT.TRANSLATE.ASCIICHARS TSTREAM NIL)
              TEXTOBJ)])
 
 (\TEDIT.FORMATTEDSTREAMP

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 16-Mar-2024 10:03 by rmk")


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


+                                                             (* ; "Edited 16-Mar-2024 10:03 by rmk")


                                                              (* ; "Edited 22-Sep-2023 20:17 by rmk")


                                                              (* ; "Edited 15-Sep-2023 00:09 by rmk")


                                                              (* ; "Edited 15-Aug-2023 17:35 by rmk")


@@ -729,7 +743,7 @@
     (LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
          (for
 PC (FORMATLEVEL _ 0)
               (DEFAULTCLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-              (DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
+              (DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
               (TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces
 (\TEDIT.FIRSTPIECE 
                                                                                    TEXTOBJ)
             do
 [COND
@@ -890,7 +904,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PIECES3

-  [LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END)
            (* ; "Edited 30-Aug-2024 15:44 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END)
            (* ; "Edited  8-Feb-2025 20:21 by rmk")


+                                                             (* ; "Edited 30-Aug-2024 15:44 by rmk")


                                                              (* ; "Edited 11-Jul-2024 13:20 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:37 by rmk")


                                                              (* ; "Edited  7-Apr-2024 17:20 by rmk")


@@ -914,7 +929,8 @@
                                                                                      DEFAULTCHARLOOKS
                                                                                           ))
                                                             (SETQ OLDPARALOOKS (FGETTOBJ TEXTOBJ 
-                                                                                      FMTSPEC))
+                                                                                     DEFAULTPARALOOKS
+                                                                                      ))
                                                             (SETQ FIRSTPC (CREATE
 PIECE)) 
                                                              (* ; "Throw away at the end")

                                                             (SETQ PREVPC FIRSTPC)
@@ -1399,7 +1415,8 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.CHARLOOKS
 FILE TEXTOBJ])
 
 (\TEDIT.GET.SINGLE.CHARLOOKS

-  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited 11-Dec-2024 22:59 by rmk")


+  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited  2-Jan-2025 11:08 by rmk")


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


                                                              (* ; "Edited  9-Dec-2024 20:11 by rmk")


                                                              (* ; "Edited 13-Aug-2024 08:49 by rmk")


                                                              (* ; "Edited 31-Jul-2024 00:04 by rmk")


@@ -1419,7 +1436,7 @@
     (PROG* ((LOOKS (create
 CHARLOOKS))
             (FILEPOS (GETFILEPTR FILE))
             (LOOKSLEN (\WIN FILE))
-            FONT NAME FACE SIZE SUPER PROPS STYLESTR)
+            FONT NAME SIZE SUPER PROPS STYLESTR BOLD ITALIC)
            (SETQ NAME (\ARBIN
 FILE))                         (* ; "The font name")

            (SETQ SIZE (\WIN FILE))                           (* ; "Size of the type, in points")

            (SETQ SUPER (\SMALLPIN FILE))                     (* ; 
@@ -1428,12 +1445,12 @@
                                          0))
            (FSETCLOOKS LOOKS CLUSERINFO (\ARBIN
 FILE))
            (SETQ PROPS (\WIN FILE))
+           [SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
+           [SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
            (with
 CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS]
                  [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS]
                  [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
                  [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
-                 [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
-                 [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
                  [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
                  [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
                  [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
@@ -1442,31 +1459,24 @@
                  [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
                  [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                  [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
-                 (SETQ CLSIZE SIZE)
                  (SETQ CLOFFSET SUPER))
-           (SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD)
-                                 'B
-                                 'M)
-                             (CL:IF (FGETCLOOKS LOOKS CLITAL)
-                                 'I
-                                 'R)
-                             'R))
-           (SETQ FONT (if
 (LISTP NAME)
-                          then
                               (* ; 
+           [if
 (LISTP NAME)
+               then
                                          (* ; 
 
                                                             "This was a font class.  Restore it.")

-                               (FONTCLASS (pop
 NAME)
-                                      NAME)
-                        else
 (FONTCREATE NAME SIZE FACE)))
-           (FSETCLOOKS LOOKS CLNAME (if
 (type?
 FONTCLASS FONT)
-                                        then
 
-                                             (* ;; 
-
                                       "Put the display family in the CLNAME spot.  Better than NIL.")

-
-                                             (CL:WHEN [SETQ NAME (FONTCOPY FONT
-                                                                        '(DEVICE DISPLAY NOERROR T]
-                                                 (FONTPROP NAME 'FAMILY))
-                                      else
 NAME))
+                    (SETQ FONT (FONTCLASS (pop
 NAME)
+                                      NAME))                 (* ; 
+
                                            "But don't maintain original names, for equality testing")

+                    (replace
 (FONTCLASS FONTCLASSNAME) of
 FONT with
 'TEDIT-FONTCLASS)
+                    (replace
 (FONTCLASS PRETTYFONT#) of
 FONT with
 0)
+             else
 (SETQ FONT (FONTCREATE NAME SIZE (PACK* (CL:IF BOLD
+                                                              'B
+                                                              'M)
+                                                          (CL:IF ITALIC
+                                                              'I
+                                                              'R)
+                                                          'R]
            (FSETCLOOKS LOOKS CLFONT FONT)
+           (FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
            (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
            (RETURN LOOKS])
 
@@ -1536,7 +1546,9 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.PARALOOKS
 FILE TEXTOBJ])
 
 (\TEDIT.GET.SINGLE.PARALOOKS

-  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited 22-Nov-2024 23:55 by rmk")


+  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited 19-Feb-2025 12:10 by rmk")


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


+                                                             (* ; "Edited 22-Nov-2024 23:55 by rmk")


                                                              (* ; "Edited 23-Oct-2024 16:03 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited  5-Aug-2024 09:47 by rmk")


@@ -1551,31 +1563,31 @@
 
                                                        "Edited  2-Jul-93 21:31 by sybalskY:MV:ENVOS")

                                                              (* ; 
 
                           "Read a paragraph format spec from the FILE, and return it for later use.")

-    (LET ((FMT (create
 FMTSPEC))
+    (LET ((PARALOOKS (create
 PARALOOKS))
           (FILEPOS (GETFILEPTR FILE))
           (LOOKSLEN (\WIN FILE))
           TABFLG DEFTAB TABS)
-         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
+         (FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE))  (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
+         (FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE))     (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

-         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

-         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

-         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

+         (FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE))    (* ; "Right margin for the paragraph")

+         (FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE))  (* ; "Leading before the paragraph")

+         (FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE))   (* ; "Lead after the paragraph")

+         (FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE))    (* ; "inter-line leading")

          (SETQ TABFLG (BIN FILE))
-         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
-                                (1 'LEFT)
-                                (2 'RIGHT)
-                                (3 'CENTERED)
-                                (4 'JUSTIFIED)
-                                (\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
+         (FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
+                                        (1 'LEFT)
+                                        (2 'RIGHT)
+                                        (3 'CENTERED)
+                                        (4 'JUSTIFIED)
+                                        (\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 1))                (* ; "There are tabs to read")

              (SETQ DEFTAB (\SMALLPIN FILE))
              (CL:WHEN (ILEQ DEFTAB 1)                        (* ; 
 
                                                       "0/1 don't make sense, seemed to code default")

                  (SETQ DEFTAB DEFAULTTAB))
-             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
+             (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
              [SETQ TABS (for
 TAB# from
 1 to
 (BIN FILE) collect
 (create
 TAB
                                                                       TABX _ (\SMALLPIN FILE)
                                                                       TABKIND _
@@ -1589,41 +1601,42 @@
                                                                           (6 'DOTTEDCENTERED)
                                                                           (7 'DOTTEDDECIMAL)
                                                                           (\TEDIT.THELP]
-             (FSETPARA FMT FMTTABS TABS))
-         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
-                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
+             (FSETPLOOKS PARALOOKS FMTTABS TABS))
+         (CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
+                (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 2))                (* ; 
 
                                                   "There are other paragraph parameters to be read.")

-             (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE))     (* ; 
+             (FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
+                                                             (* ; 
 
                                                      "Special X location on page for this paragraph")

-             (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
-             (FSETPARA FMT FMTUSERINFO (\ARBIN
 FILE))
-             (FSETPARA FMT FMTPARATYPE (\ATMIN
 FILE))
-             (FSETPARA FMT FMTPARASUBTYPE (\ATMIN
 FILE))
-             (FSETPARA FMT FMTSTYLE (\ARBIN
 FILE))
-             (FSETPARA FMT FMTCHARSTYLES (\ARBIN
 FILE))
-             (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN
 FILE))
-             (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN
 FILE))
-             (FSETPARA FMT FMTHEADINGKEEP (\ARBIN
 FILE))
-             (FSETPARA FMT FMTKEEP (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
+             (FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTHEADINGKEEP (\ARBIN
 FILE))
+             (FSETPLOOKS PARALOOKS FMTKEEP (\ARBIN
 FILE))
              (CL:WHEN (ILESSP (GETFILEPTR FILE)
                              (IPLUS FILEPOS LOOKSLEN))
-                 (FSETPARA FMT FMTBASETOBASE (\ARBIN
 FILE)))
+                 (FSETPLOOKS PARALOOKS FMTBASETOBASE (\ARBIN
 FILE)))
              (CL:WHEN (ILESSP (GETFILEPTR FILE)
                              (IPLUS FILEPOS LOOKSLEN))
-                 (FSETPARA FMT FMTREVISED (\ARBIN
 FILE)))
+                 (FSETPLOOKS PARALOOKS FMTREVISED (\ARBIN
 FILE)))
              (CL:WHEN (ILESSP (GETFILEPTR FILE)
                              (IPLUS FILEPOS LOOKSLEN))
-                 (FSETPARA FMT FMTCOLUMN (\ARBIN
 FILE)))
+                 (FSETPLOOKS PARALOOKS FMTCOLUMN (\ARBIN
 FILE)))
              (CL:WHEN (ILESSP (GETFILEPTR FILE)
                              (IPLUS FILEPOS LOOKSLEN))
-                 (FSETPARA FMT FMTCHARSTYLES (\ARBIN
 FILE))))
+                 (FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN
 FILE))))
          (CL:WHEN (ILESSP (GETFILEPTR FILE)
                          (IPLUS FILEPOS LOOKSLEN))           (* ; 
 
                               "There is more PARALOOKS info in this piece -- we probably lost data.")

              (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T)
              (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)))
-         FMT])
+         PARALOOKS])
 )
 (DEFINEQ
 
@@ -1929,7 +1942,8 @@
                                      (CHARCODE (EOL LF])])])
 
 (\TEDIT.PUT.UTF8.SPLITPIECES

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


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 19-Jan-2025 15:02 by rmk")


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


                                                              (* ; "Edited  3-Feb-2024 14:52 by rmk")


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


                                                              (* ; "Edited  5-Jan-2024 11:37 by rmk")


@@ -1946,13 +1960,11 @@
                                  (* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.")

 
                                    (if
 (EQ I 1)
-                                       then
 (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH 
-                                                                               *XCCSTOUNICODE*)))
+                                       then
 (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
                                             (FSETPC PC PUTF8BYTESPERCHAR BPC) 
                                                              (* ; 
 
                                                             "The first character defines the piece")

-                                     elseif
 (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH 
-                                                                             *XCCSTOUNICODE*)))
+                                     elseif
 (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
                                      else
 (\TEDIT.SPLITPIECE PC (SUB1 I)
                                                  TEXTOBJ)
                                           (SETQ PC (PREVPIECE PC)) 
@@ -1968,11 +1980,9 @@
                        (for
 I BPC (PFILE _ (PCONTENTS PC)) from
 1 to
 (PLEN PC)
                           first
 (\SETFILEPTR PFILE (PFPOS PC))
                           do
 (if
 (EQ I 1)
-                                 then
 (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
-                                                                         *XCCSTOUNICODE*)))
+                                 then
 [SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
                                       (FSETPC PC PUTF8BYTESPERCHAR BPC)
-                               elseif
 (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
-                                                                       *XCCSTOUNICODE*)))
+                               elseif
 [EQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
                                else
 (\TEDIT.SPLITPIECE PC (SUB1 I)
                                            TEXTOBJ)
                                     (SETQ PC (PREVPIECE PC))
@@ -1987,10 +1997,9 @@
                                                8)
                                          (BIN PFILE)))
                          (if
 (EQ I 1)
-                             then
 (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*))
-                                   )
+                             then
 (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
                                   (FSETPC PC PUTF8BYTESPERCHAR BPC)
-                           elseif
 (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*)))
+                           elseif
 (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
                            else
 (\TEDIT.SPLITPIECE PC (SUB1 I)
                                        TEXTOBJ)
                                 (SETQ PC (PREVPIECE PC))
@@ -2000,6 +2009,7 @@
 
 (\TEDIT.PUT.PCTB.NEXTNEW

   [LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)

+                                                             (* ; "Edited 26-Mar-2025 09:27 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:26 by rmk")


                                                              (* ; "Edited 14-May-2024 18:54 by rmk")


                                                              (* ; "Edited 13-May-2024 08:27 by rmk")


@@ -2032,8 +2042,9 @@
                                          (THINSTRING.PTYPE 
                                               THINFILE.PTYPE)
                                          ((LIST FATSTRING.PTYPE FATFILE1.PTYPE) 
+                                                             (* ; 
+
                                                             "PCHARSET is not relevant for FILEFILE2")

                                               (FSETPC NEXTNEW PBYTESPERCHAR 2)
-                                              (FSETPC NEXTNEW PCHARSET \NORUNCODE)
                                               FATFILE2.PTYPE)
                                          (PTYPE PC))))
         (\TEDIT.THELP "EXTERNAL FORMAT NOT RECOGNIZED" EXTFORMAT))
@@ -2174,7 +2185,8 @@
                                            (PUTHASH LOOKS I LOOKSHASH])
 
 (\TEDIT.PUT.SINGLE.CHARLOOKS

-  [LAMBDA (FORMATSTREAM LOOKS)
                               (* ; "Edited 13-Aug-2024 08:47 by rmk")


+  [LAMBDA (FORMATSTREAM LOOKS)
                               (* ; "Edited  2-Jan-2025 10:43 by rmk")


+                                                             (* ; "Edited 13-Aug-2024 08:47 by rmk")


                                                              (* ; "Edited 31-Jul-2024 00:05 by rmk")


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


                                                              (* ; "Edited 21-Dec-2023 23:54 by rmk")


@@ -2222,10 +2234,10 @@
                                     (CL:IF (fetch
 (CHARLOOKS CLINVERTED) of
 LOOKS)
                                         1024
                                         0)
-                                    (CL:IF (fetch
 (CHARLOOKS CLBOLD) of
 LOOKS)
+                                    (CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
                                         512
                                         0)
-                                    (CL:IF (fetch
 (CHARLOOKS CLITAL) of
 LOOKS)
+                                    (CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
                                         256
                                         0)
                                     (CL:IF (fetch
 (CHARLOOKS CLULINE) of
 LOOKS)
@@ -2349,7 +2361,8 @@
                                         (PUTHASH PL I PARAHASH])
 
 (\TEDIT.PUT.SINGLE.PARALOOKS

-  [LAMBDA (FONTFILE LOOKS)
                                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (FONTFILE LOOKS)
                                   (* ; "Edited 19-Feb-2025 12:11 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 28-Jul-2024 21:29 by rmk")


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


                                                              (* ; "Edited 19-Dec-2023 10:14 by rmk")


@@ -2364,23 +2377,23 @@
           DEFTAB TABS LEN)
          (\SMALLPOUT FONTFILE 0)                             (* ; 
 
                                                             "Reserve space to store the look length")

-         (\SMALLPOUT FONTFILE (FGETPARA LOOKS 1STLEFTMAR))   (* ; 
+         (\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-         (\SMALLPOUT FONTFILE (FGETPARA LOOKS LEFTMAR))      (* ; 
+         (\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEFTMAR))    (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-         (\SMALLPOUT FONTFILE (FGETPARA LOOKS RIGHTMAR))     (* ; "Right margin for the paragraph")

-         (\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADBEFORE))   (* ; "Leading before the paragraph")

-         (\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADAFTER))    (* ; "Lead after the paragraph")

-         (\SMALLPOUT FONTFILE (FGETPARA LOOKS LINELEAD))     (* ; "inter-line leading")

-         (SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
-         (SETQ TABS (FGETPARA LOOKS FMTTABS))
+         (\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS RIGHTMAR))   (* ; "Right margin for the paragraph")

+         (\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")

+         (\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEADAFTER))  (* ; "Lead after the paragraph")

+         (\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LINELEAD))   (* ; "inter-line leading")

+         (SETQ DEFTAB (FGETPLOOKS LOOKS FMTDEFAULTTAB))
+         (SETQ TABS (FGETPLOOKS LOOKS FMTTABS))
 
          (* ;; "Indicate whether there are tab specs  or a default tab setting to save")

 
          (\BOUT FONTFILE (CL:IF (OR DEFTAB TABS)
                              3
                              2))
-         (\BOUT FONTFILE (SELECTQ (FGETPARA LOOKS QUAD)
+         (\BOUT FONTFILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
                              (LEFT 1)
                              (RIGHT 2)
                              ((CENTER CENTERED) 
@@ -2407,23 +2420,23 @@
                                                           6)
                                                      (DOTTEDDECIMAL 7)
                                                      (\TEDIT.THELP])
-         (\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALX)
+         (\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
                                   0))
-         (\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALY)
+         (\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
                                   0))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTUSERINFO))
-         (\ATMOUT
 FONTFILE (FGETPARA LOOKS FMTPARATYPE))
-         (\ATMOUT
 FONTFILE (FGETPARA LOOKS FMTPARASUBTYPE))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTSTYLE))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTCHARSTYLES))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTNEWPAGEAFTER))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTHEADINGKEEP))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTKEEP))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTBASETOBASE))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTREVISED))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTCOLUMN))
-         (\ARBOUT
 FONTFILE (FGETPARA LOOKS FMTCHARSTYLES))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTUSERINFO))
+         (\ATMOUT
 FONTFILE (FGETPLOOKS LOOKS FMTPARATYPE))
+         (\ATMOUT
 FONTFILE (FGETPLOOKS LOOKS FMTPARASUBTYPE))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTSTYLE))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTNEWPAGEBEFORE))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTNEWPAGEAFTER))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTHEADINGKEEP))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTKEEP))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTBASETOBASE))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTREVISED))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTCOLUMN))
+         (\ARBOUT
 FONTFILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
 
 (* ;;; "Now go fill in the length field at the front of the LOOKS.  (ALL looks info should be written out BEFORE this comment.)")

 
@@ -2457,7 +2470,9 @@
 (DEFINEQ
 
 (TEDITFROMLISPSOURCE

-  [LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END)
      (* ; "Edited 17-Nov-2024 10:03 by rmk")


+  [LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END)
      (* ; "Edited 26-Mar-2025 10:02 by rmk")


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


+                                                             (* ; "Edited 17-Nov-2024 10:03 by rmk")


                                                              (* ; "Edited 25-Dec-2023 12:28 by rmk")


                                                              (* ; "Edited  5-Dec-2023 23:46 by rmk")


                                                              (* ; "Edited 26-Oct-2023 11:22 by rmk")


@@ -2471,19 +2486,22 @@
 
     (* ;; "USERTEMP is the reader environment returned by LISPSOURCEFILEP")

 
+    (DECLARE
 (USEDFREE TEDIT.SOURCE.LINELENGTH))
     (CL:UNLESS TSTREAM
         (SETQ TSTREAM (OPENTEXTSTREAM)))
 
-    (* ;; "An empty window for TSTREAM may already be up on the screen.  Since this conversion can take awhile, we tell the user what's going on")

+    (* ;; "Estimate 110 characters per line in the default font?")

 
-    (TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
-    (TEXTPROP TSTREAM 'BOUNDTABLE (TEDIT.ATOMBOUND.READTABLE (fetch
 (READER-ENVIRONMENT REREADTABLE)
-                                                                of
 USERTEMP)))
+    [PUTTEXTPROPS TSTREAM `(PARABREAKCHARS NIL OPENWIDTH ,(TIMES TEDIT.SOURCE.LINELENGTH
+                                                                 (CHARWIDTH (CHARCODE SPACE)
+                                                                        DEFAULTFONT))
+                                  BOUNDTABLE
+                                  ,(TEDIT.ATOMBOUND.READTABLE (fetch
 (READER-ENVIRONMENT REREADTABLE)
+                                                                 of
 USERTEMP]
     (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Fetching " (FULLNAME SOURCEFILE)
                                       " ...")
            T)
     (COPY.TEXT.TO.IMAGE SOURCEFILE TSTREAM)
-    (TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
     TSTREAM])
 
 (SHELLSCRIPTP

@@ -2506,33 +2524,35 @@
     TSTREAM])
 )
 
+(RPAQ? TEDIT.SOURCE.LINELENGTH
 110)
+
 (ADDTOVAR TEDIT.INPUT.FORMATS
 (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
                               (SHELLSCRIPTP TEDITFROMSHELLSCRIPT))
 
 (RPAQ? *TEDIT-FILE-READTABLE*
 (COPYREADTABLE \ORIGREADTABLE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5016 33941 (TEDIT.GET 5026 . 11035) (TEDIT.FORMATTEDFILEP 11037 . 12353) (
-TEDIT.FILEDATE 12355 . 13526) (TEDIT.INCLUDE 13528 . 21439) (TEDIT.RAW.INCLUDE 21441 . 22249) (
-TEDIT.PUT 22251 . 30106) (TEDIT.PUT.STREAM 30108 . 33939)) (33942 53139 (\TEDIT.GET.FOREIGN.FILE 33952
- . 37137) (\TEDIT.GET.UNFORMATTED.FILE 37139 . 41013) (\TEDIT.GET.FORMATTED.FILE 41015 . 43836) (
-\TEDIT.FORMATTEDSTREAMP 43838 . 46738) (\ARBIN 46740 . 47460) (\ATMIN 47462 . 47999) (\DWIN 48001 . 
-48380) (\STRINGIN 48382 . 49090) (\TEDIT.GET.TRAILER 49092 . 51608) (\TEDIT.CACHEFILE 51610 . 53137)) 
-(53305 66855 (\TEDIT.GET.PIECES3 53315 . 63617) (\TEDIT.GET.IDATE3 63619 . 65014) (
-\TEDIT.MAKE.STRINGPIECE 65016 . 66853)) (66856 79231 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66866 . 72982) 
-(\TEDIT.INTERPRET.XCCS.SHIFTS 72984 . 79229)) (79253 85275 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79263 . 
-85273)) (85298 93989 (\TEDIT.GET.CHARLOOKS.LIST 85308 . 86039) (\TEDIT.GET.SINGLE.CHARLOOKS 86041 . 
-90801) (\TEDIT.GET.CHARLOOKS 90803 . 92133) (\TEDIT.GET.PARALOOKS.INDEX 92135 . 92679) (
-\TEDIT.GET.CHARLOOKS.INDEX 92681 . 93987)) (93990 101158 (\TEDIT.GET.PARALOOKS.LIST 94000 . 94622) (
-\TEDIT.GET.SINGLE.PARALOOKS 94624 . 101156)) (101159 104749 (\TEDIT.GET.OBJECT 101169 . 104747)) (
-104811 137073 (\TEDIT.PUT.PCTB 104821 . 114471) (\TEDIT.PUT.PCTB.PIECEDATA 114473 . 117671) (
-\TEDIT.PUT.TRAILER 117673 . 118440) (\TEDIT.PUT.PCTB.MERGEABLE 118442 . 121876) (
-\TEDIT.PUT.UTF8.SPLITPIECES 121878 . 126965) (\TEDIT.PUT.PCTB.NEXTNEW 126967 . 131234) (
-\TEDIT.INSERT.NEWPIECES 131236 . 134671) (\TEDIT.PUTRESET 134673 . 134915) (\ARBOUT 134917 . 135641) (
-\ATMOUT 135643 . 136248) (\DWOUT 136250 . 136529) (\STRINGOUT 136531 . 137071)) (137074 149057 (
-\TEDIT.PUT.CHARLOOKS.LIST 137084 . 138756) (\TEDIT.PUT.SINGLE.CHARLOOKS 138758 . 144401) (
-\TEDIT.PUT.CHARLOOKS 144403 . 145628) (\TEDIT.PUT.CHARLOOKS1 145630 . 146681) (\TEDIT.PUT.OBJECT 
-146683 . 149055)) (149058 156552 (\TEDIT.PUT.PARALOOKS.LIST 149068 . 149970) (
-\TEDIT.PUT.SINGLE.PARALOOKS 149972 . 155411) (\TEDIT.PUT.PARALOOKS 155413 . 156550)) (156647 159241 (
-TEDITFROMLISPSOURCE 156657 . 158490) (SHELLSCRIPTP 158492 . 158721) (TEDITFROMSHELLSCRIPT 158723 . 
-159239)))))
+  (FILEMAP (NIL (5064 34612 (TEDIT.GET 5074 . 11194) (TEDIT.FORMATTEDFILEP 11196 . 12512) (
+TEDIT.FILEDATE 12514 . 13685) (TEDIT.INCLUDE 13687 . 21716) (TEDIT.RAW.INCLUDE 21718 . 22526) (
+TEDIT.PUT 22528 . 30777) (TEDIT.PUT.STREAM 30779 . 34610)) (34613 54492 (\TEDIT.GET.FOREIGN.FILE 34623
+ . 38048) (\TEDIT.GET.UNFORMATTED.FILE 38050 . 42042) (\TEDIT.GET.FORMATTED.FILE 42044 . 45071) (
+\TEDIT.FORMATTEDSTREAMP 45073 . 48091) (\ARBIN 48093 . 48813) (\ATMIN 48815 . 49352) (\DWIN 49354 . 
+49733) (\STRINGIN 49735 . 50443) (\TEDIT.GET.TRAILER 50445 . 52961) (\TEDIT.CACHEFILE 52963 . 54490)) 
+(54658 68412 (\TEDIT.GET.PIECES3 54668 . 65174) (\TEDIT.GET.IDATE3 65176 . 66571) (
+\TEDIT.MAKE.STRINGPIECE 66573 . 68410)) (68413 80788 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 68423 . 74539) 
+(\TEDIT.INTERPRET.XCCS.SHIFTS 74541 . 80786)) (80810 86832 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80820 . 
+86830)) (86855 95480 (\TEDIT.GET.CHARLOOKS.LIST 86865 . 87596) (\TEDIT.GET.SINGLE.CHARLOOKS 87598 . 
+92292) (\TEDIT.GET.CHARLOOKS 92294 . 93624) (\TEDIT.GET.PARALOOKS.INDEX 93626 . 94170) (
+\TEDIT.GET.CHARLOOKS.INDEX 94172 . 95478)) (95481 103138 (\TEDIT.GET.PARALOOKS.LIST 95491 . 96113) (
+\TEDIT.GET.SINGLE.PARALOOKS 96115 . 103136)) (103139 106729 (\TEDIT.GET.OBJECT 103149 . 106727)) (
+106791 138872 (\TEDIT.PUT.PCTB 106801 . 116451) (\TEDIT.PUT.PCTB.PIECEDATA 116453 . 119651) (
+\TEDIT.PUT.TRAILER 119653 . 120420) (\TEDIT.PUT.PCTB.MERGEABLE 120422 . 123856) (
+\TEDIT.PUT.UTF8.SPLITPIECES 123858 . 128560) (\TEDIT.PUT.PCTB.NEXTNEW 128562 . 133033) (
+\TEDIT.INSERT.NEWPIECES 133035 . 136470) (\TEDIT.PUTRESET 136472 . 136714) (\ARBOUT 136716 . 137440) (
+\ATMOUT 137442 . 138047) (\DWOUT 138049 . 138328) (\STRINGOUT 138330 . 138870)) (138873 150948 (
+\TEDIT.PUT.CHARLOOKS.LIST 138883 . 140555) (\TEDIT.PUT.SINGLE.CHARLOOKS 140557 . 146292) (
+\TEDIT.PUT.CHARLOOKS 146294 . 147519) (\TEDIT.PUT.CHARLOOKS1 147521 . 148572) (\TEDIT.PUT.OBJECT 
+148574 . 150946)) (150949 158588 (\TEDIT.PUT.PARALOOKS.LIST 150959 . 151861) (
+\TEDIT.PUT.SINGLE.PARALOOKS 151863 . 157447) (\TEDIT.PUT.PARALOOKS 157449 . 158586)) (158683 161695 (
+TEDITFROMLISPSOURCE 158693 . 160944) (SHELLSCRIPTP 160946 . 161175) (TEDITFROMSHELLSCRIPT 161177 . 
+161693)))))
 STOP

library/tedit/TEDIT-FIND

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134
 36434  
+
(FILECREATED "28-Mar-2025 14:07:00" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;155
 43772  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.SUBSTITUTE)
+      :CHANGES-TO (FNS TEDIT.NEXT)
 
-      :PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
+      :PREVIOUS-DATE "19-Mar-2025 11:25:45" {WMEDLEY}<library>tedit>TEDIT-FIND.;153)
 
 
 (PRETTYCOMPRINT TEDIT-FINDCOMS)
@@ -14,12 +14,15 @@
 (RPAQQ TEDIT-FINDCOMS
 (
                        (* ;; "User entries")

 
-                       (FNS TEDIT.FIND TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE TEDIT.NEXT)
+                       (FNS TEDIT.FIND TEDIT.FIND.SETSEL TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE 
+                            TEDIT.NEXT)
+                       (FNS TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD)
                        
                        (* ;; "Implementation")

 
-                       (FNS \TEDIT.WCFIND \TEDIT.BASICFIND \TEDIT.WCFIND.BACKWARD 
-                            \TEDIT.BASICFIND.BACKWARD \TEDIT.PARSE.SEARCHSTRING)))
+                       (FNS \TEDIT.FIND \TEDIT.FIND.BACKWARD \TEDIT.WCFIND \TEDIT.BASICFIND 
+                            \TEDIT.WCFIND.BACKWARD \TEDIT.BASICFIND.BACKWARD 
+                            \TEDIT.PARSE.SEARCHSTRING)))
 
 
 
@@ -28,80 +31,50 @@
 (DEFINEQ
 
 (TEDIT.FIND

-  [LAMBDA (TSTREAM TARGET START END WILDCARDS?)
              (* ; "Edited 10-May-2024 21:55 by rmk")


-                                                             (* ; "Edited 24-Apr-2024 23:47 by rmk")


-                                                             (* ; "Edited 19-Jun-2023 22:27 by rmk")


-                                                            (* ; "Edited  6-May-2018 17:34 by rmk:")


-                                                             (* ; "Edited 30-May-91 20:56 by jds")

+  [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN)
        (* ; "Edited 14-Mar-2025 23:39 by rmk")


+                                                             (* ; "Edited 11-Mar-2025 12:33 by rmk")

 
-    (* ;; "If WILDCARDS?  is NIL then TEDIT.FIND returns just the start of a basic string-match.")

+    (* ;; "This is the documented user interface that does the silly thing with the return value--caller must know whether WILCARD? was true or not.")

 
-    (* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")

+    (LET ((RESULT (\TEDIT.FIND
 TSTREAM TARGET WILDCARDS? AGAIN START END)))
+         (CL:WHEN RESULT
+             (CL:IF WILDCARDS?
+                 RESULT
+                 (CAR RESULT)))])
 
-    (* ;; "RMK:  FIND isn't undoable, FIND-AGAIN is armed on meta-g.  No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")

+(TEDIT.FIND.SETSEL

+  [LAMBDA (TSTREAM TARGET START END WILDCARDS?)
              (* ; "Edited 11-Mar-2025 15:29 by rmk")

 
-    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
-    (CL:WHEN TARGET
+    (* ;; "Sets the selection to the result of a successful FIND.")

 
-        (* ;; "* and # are implicitly quoted if not WILDCARDS?  This could be handled simply by calling CONS  instead of  \TEDIT.PARSE.SEARCHSTRING")

-
-        [if
 (IMAGEOBJP TARGET)
-            then
 (TEDIT.FIND.OBJECT TSTREAM TARGET START END)
-          elseif
 [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
-            then
 (CL:UNLESS END
-                     (SETQ END (FGETTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)
-                                      TEXTLEN)))
-                 (CL:UNLESS START
-                     (SETQ START (TEDIT.GETPOINT TSTREAM)))
-                 (CL:WHEN (ILEQ START END)
-                     (CL:IF WILDCARDS?
-                         (\TEDIT.WCFIND
 TSTREAM (\TEDIT.PARSE.SEARCHSTRING
 TARGET)
-                                START END)
-                         (CAR (\TEDIT.BASICFIND
 TSTREAM TARGET START END))))])])
+    (LET ((RESULT (\TEDIT.FIND
 TSTREAM TARGET WILDCARDS? NIL START END)))
+         (CL:WHEN RESULT
+             (TEDIT.SETSEL TSTREAM (CAR RESULT)
+                    (CADR RESULT)
+                    'RIGHT)
+             (TEDIT.NORMALIZECARET TSTREAM))])
 
 (TEDIT.FIND.BACKWARD

-  [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN)
        (* ; "Edited 19-May-2024 12:07 by rmk")


-                                                             (* ; "Edited 10-May-2024 22:00 by rmk")


-                                                             (* ; "Edited 24-Apr-2024 23:43 by rmk")


-                                                             (* ; "Edited 12-Jul-2023 08:24 by rmk")


-                                                             (* ; "Edited 20-Jun-2023 12:12 by rmk")


-                                                             (* ; "Edited 18-Jun-2023 23:43 by rmk")


+  [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN)
        (* ; "Edited 11-Mar-2025 15:06 by rmk")


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

 
-    (* ;; "The search is confined to the characters between START and END.  It runs backwards from END looking for the nearest match, and returns the character positions of that match.")

+    (* ;; "This is a new function that preserves the silly interface of  TEDIT.FIND--caller must know whether WILCARD? was true or not.")

 
-    (* ;; "If WILDCARDS?, the value is the pair (MATCHSTART  MATCHEND) for that match, since the caller doesn't know the length.  But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long.  This is quirky, but that's the way it is documented.")

-
-    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
-    (CL:WHEN TARGET
-        [if
 (IMAGEOBJP TARGET)
-            then
 (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN)
-          elseif
 [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
-            then
 (SETQ START (IMAX 1 (OR START 1)))
-                 (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
-                                 (FGETTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)
-                                        TEXTLEN)))
-                 (CL:WHEN AGAIN
-
-                     (* ;; 
-
                     "Assume that we aren't interested in another match at the current position.")

-
-                     (ADD
 END -1))
-                 (CL:WHEN (ILEQ START END)
-                     (CL:IF WILDCARDS?
-                         (\TEDIT.WCFIND.BACKWARD
 TSTREAM (\TEDIT.PARSE.SEARCHSTRING
 TARGET T)
-                                START END)
-                         (CAR (\TEDIT.BASICFIND.BACKWARD
 TSTREAM TARGET START END))))])])
+    (LET ((RESULT (\TEDIT.FIND.BACKWARD
 TARGET WILDCARDS? AGAIN START END)))
+         (CL:WHEN RESULT
+             (CL:IF WILDCARDS?
+                 RESULT
+                 (CAR RESULT)))])
 
 (TEDIT.SUBSTITUTE

-  [LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?)
             (* ; "Edited  8-Dec-2024 15:47 by rmk")


+  [LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM? NEWCHARLOOKS)
(* ; "Edited 19-Mar-2025 11:20 by rmk")


+                                                             (* ; "Edited 15-Mar-2025 00:23 by rmk")


+                                                             (* ; "Edited  6-Mar-2025 20:17 by rmk")


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


                                                              (* ; "Edited 26-Nov-2024 23:49 by rmk")


                                                              (* ; "Edited 15-Aug-2024 09:20 by rmk")


                                                              (* ; "Edited 14-Jul-2024 00:24 by rmk")


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


-                                                             (* ; "Edited 29-Jun-2024 10:49 by rmk")


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


-                                                             (* ; "Edited  9-Mar-2024 11:36 by rmk")


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


                                                              (* ; "Edited 15-Mar-2024 14:09 by rmk")


                                                              (* ; "Edited  6-Jan-2024 11:09 by rmk")


@@ -118,16 +91,15 @@
             (PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
                    (NREPLACEMENTS 0)
                    (YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
-                   SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
-                   ACTIONSTRING)
+                   SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# CONFIRMFLG SEL REPLACE-LEN ACTIONSTRING
+                   CHARLOOKS)
 
              (* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string.  If the search pattern is empty, bail out.")

 
-                  [CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
-                                                                   (GETTEXTPROP TEXTOBJ 
-                                                                          '
-                                                                         TEDIT.LAST.SUBSTITUTE.STRING
-                                                                          ]
+                  (CL:UNLESS SEARCHSTRING
+                      [SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
+                                                            (GETTEXTPROP TEXTOBJ 
+                                                                   'TEDIT.LAST.SUBSTITUTE.STRING])
                   (CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ 
                                                                       "Replace string:"
                                                                       (GETTEXTPROP TEXTOBJ
@@ -137,16 +109,17 @@
                                                                              ]
                       (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
                       (RETURN))
-                  [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
+                  [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Substitute")
                          '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
                   (if
 (type?
 SELPIECES REPLACEMENT)
                     elseif
 (OR (STRINGP REPLACEMENT)
                                (LITATOM REPLACEMENT))
-                      then
 (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
+                      then
 (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
+                    else
 (RETURN NIL))
 
              (* ;; "Could be NIL or empty string, meaning just delete all occurrences.")

 
-                  (SETQ REPLACE-LEN (fetch
 (SELPIECES SPLEN) of
 REPLACEMENT))
+                  (SETQ REPLACE-LEN (GETSPC REPLACEMENT SPLEN))
                   (SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
                                          "delet"
                                          "substitut"))
@@ -163,8 +136,7 @@
                   (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
                                                     "ing...")
                          T)
-                  (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-                  (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                  (SETQ SEL (FGETTOBJ TEXTOBJ SEL))
                   (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
                                                              (* ; "Turn off any blue pending delete")

 
@@ -174,58 +146,67 @@
                   [SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH))
                                      (GETTOBJ TEXTOBJ TEXTLEN)
                                      (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))]
+
+             (* ;; 
+
             "NOTE:  SEARCHSTRING may contain wild cards, so the hits may be of different lengths.")

+
                   [if
 CONFIRMFLG
                       then
 
                            (* ;; "In this case the selection moves along, ending up at the last hit.")

 
-                           [bind
 PENDING.SEL CHOICE while
 (SETQ RANGE (TEDIT.FIND
 TEXTOBJ 
-                                                                             SEARCHSTRING STARTCHAR#
-                                                                             ENDCHAR# T))
+                           (bind
 HIT (LASTSEL _ (\TEDIT.COPYSEL SEL))
+                              while
 (SETQ HIT (\TEDIT.FIND
 TEXTOBJ SEARCHSTRING T NIL STARTCHAR# 
+                                                     ENDCHAR#))
                               do
                             (* ; 
 
                                                 "Show each substitution site and ask for permission")

-                                 (SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
-                                                          (ADD1 (IDIFFERENCE (CADR RANGE)
-                                                                       (CAR RANGE)))
-                                                          'RIGHT T))
-                                 (\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ)
-                                 (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
-                                 (SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ 
+                                 (\TEDIT.UPDATE.SEL SEL (CAR HIT)
+                                        (CADR HIT)
+                                        'RIGHT
+                                        'PENDINGDEL)
+                                 (\TEDIT.FIXSEL SEL TEXTOBJ)
+                                 (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                                 (TEDIT.NORMALIZECARET TEXTOBJ SEL)
+                                 [SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ 
                                                                   "OK to replace? ['q' quits]" "Yes")
                                                          1))
-                                     (Q (RETURN))
+                                     (Q (GO $$OUT))
                                      (Y                      (* ; "Do this one")

+                                        (CL:UNLESS NEWCHARLOOKS
+                                            (SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
+                                                                               TEXTOBJ))))
                                         (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
                                                                          'COPY TEXTOBJ)
-                                               TEXTOBJ PENDING.SEL)
+                                               TEXTOBJ SEL)
+                                        (\TEDIT.COPYSEL SEL LASTSEL)
+                                                             (* ; "This may be where we end up")

                                         (add
 NREPLACEMENTS 1)
-                                        (SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
+                                        (SETQ STARTCHAR# (GETSEL SEL CHLIM))
                                                              (* ; "Next start, compensate for end")

-                                        [add
 ENDCHAR# (IDIFFERENCE REPLACE-LEN
-                                                             (ADD1 (IDIFFERENCE (CADR RANGE)
-                                                                          (CAR RANGE])
+                                        (add
 ENDCHAR# (IDIFFERENCE REPLACE-LEN (CADR HIT))))
                                      (PROGN 
                                             (* ;; 
 
    "Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")

 
-                                            (\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
-                                            (SETQ STARTCHAR# (ADD1 (CAR RANGE]
+                                            (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                                            (SETQ STARTCHAR# (ADD1 (CAR HIT]
+                              finally
 (\TEDIT.COPYSEL LASTSEL SEL))
                     else
 
                          (* ;; "No confirmation required.  Do the substitutions without showing intermediate work, collect all of the replacement events")

 
-                         (bind
 FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
-                               (SAVESEL _ (\TEDIT.COPYSEL SEL))
-                               EVENTS while
 (SETQ RANGE (TEDIT.FIND
 TEXTOBJ SEARCHSTRING STARTCHAR# 
-                                                               ENDCHAR# T))
+                         (bind
 FIRSTHIT HIT HITLAST HITDIFF CHARLOOKS (TOTALDIFF _ 0)
+                               EVENTS while
 (SETQ HIT (\TEDIT.FIND
 TEXTOBJ SEARCHSTRING T NIL 
+                                                             STARTCHAR# ENDCHAR#))
                             do
 (CL:UNLESS FIRSTHIT           (* ; "For final line updating.")

-                                   (SETQ FIRSTHIT (CAR RANGE)))
-                               [SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
-                                                         (CAR RANGE]
-                               (\TEDIT.UPDATE.SEL SEL (CAR RANGE)
-                                      HITLEN
+                                   (SETQ FIRSTHIT (CAR HIT)))
+                               (CL:UNLESS NEWCHARLOOKS
+                                   (SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
+                                                                      TEXTOBJ))))
+                               (\TEDIT.UPDATE.SEL SEL (CAR HIT)
+                                      (CADR HIT)
                                       'RIGHT)
                                (\TEDIT.FIXSEL SEL TEXTOBJ)
                                (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
-                                                                'COPY TEXTOBJ)
+                                                                'COPY TEXTOBJ NIL CHARLOOKS)
                                       TEXTOBJ SEL)
                                (push
 EVENTS (\TEDIT.POPEVENT TEXTOBJ)) 
                                                              (* ; 
@@ -233,16 +214,16 @@
                                (add
 NREPLACEMENTS 1)
                                (SETQ STARTCHAR# (GETSEL SEL CHLIM))
                                (SETQ HITLAST STARTCHAR#)
-                               (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
+                               (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN (CADR HIT)))
                                (add
 ENDCHAR# HITDIFF)
                                (add
 TOTALDIFF HITDIFF)
                             finally
 (CL:UNLESS (EQ NREPLACEMENTS 0)
 
-                                        (* ;; 
-
                                      "At least one replacement, update the lines that have changed.")

+                                 (* ;; "At least one replacement, update the lines that have changed.  We have to calculate how many of the original characters have %"changed%" by adding the TOTALDIFF to the final position of the last character of the last hit.  ")

 
                                         (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
-                                               (IDIFFERENCE (GETSEL SEL CHLIM)
+                                               (IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM)
+                                                                   TOTALDIFF)
                                                       FIRSTHIT))
 
                                  (* ;; "Not clear what the final selection should be, if there are multiple changes.  The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)?  Or just the selection of the last substitution?")

@@ -251,6 +232,7 @@
                                         (\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
                                                                                )
                                                'RIGHT)
+                                        (\TEDIT.FIXSEL SEL TEXTOBJ)
                                         (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))]
 
              (* ;; "Save the search & replacement strings to offer for next time:")

@@ -269,7 +251,12 @@
                   (RETURN NREPLACEMENTS))))])
 
 (TEDIT.NEXT

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 21-Oct-2024 00:40 by rmk")


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


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


+                                                             (* ; "Edited 11-Mar-2025 15:35 by rmk")


+                                                             (* ; "Edited  9-Mar-2025 11:31 by rmk")


+                                                             (* ; "Edited 15-Feb-2025 18:08 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:40 by rmk")


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


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


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


@@ -278,57 +265,109 @@
                                                              (* ; "Edited 14-Dec-2023 21:20 by rmk")


                                                              (* ; "Edited 20-Jun-2023 00:05 by rmk")


                                                              (* ; "Edited  3-May-2023 23:47 by rmk")


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


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


                                                              (* ; "Edited 30-May-91 20:57 by jds")

-    (LET ((TEXTOBJ (TEXTOBJ TSTREAM))
-          TARGET SEL OPTION FIELDSEL)
-         (SETQ SEL (TEXTSEL TEXTOBJ))
-         (SETQ TARGET (TEDIT.FIND
 TEXTOBJ ">>*<<" NIL NIL T))(* ; 
-
                                                             "find the first >>delimited<< field")

-         (SETQ FIELDSEL (TEDIT.FIND
 TEXTOBJ "{*}" NIL NIL T))(* ; 
-
                                "find the first menu-type insertion field, usually delimited with {}")

-         [SETQ OPTION (COND
-                         [(AND TARGET FIELDSEL)              (* ; "take the first one")

-                          (COND
-                             ((IGREATERP (CAR TARGET)
-                                     (GETSEL FIELDSEL CH#))  (* ; "use the {} selection")

-                              'FIELD)
-                             (T 'TARGET]
-                         (TARGET 'TARGET)
-                         (FIELDSEL 'FIELD)
-                         (T 'NEITHER]
-         (SELECTQ OPTION
-             (TARGET                                         (* ; "Found another fill-in")

-                     (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 T)
-                                                             (* ; 
-
                                         "Original comment: %"never pending a deletion%", but it is!")

-                     (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)        (* ; 
-
                                                             "Set up SELECTION to be the found text")

-                     (\TEDIT.UPDATE.SEL SEL (CAR TARGET)
-                            (IDIFFERENCE (ADD1 (CADR TARGET))
-                                   (CAR TARGET))
-                            'RIGHT
-                            'PENDINGDEL)
-                     (\TEDIT.FIXSEL SEL TEXTOBJ)             (* ; "Always selected normally")

-                     (TEDIT.NORMALIZECARET TEXTOBJ)          (* ; "And get it into the window")

-                     (\TEDIT.SHOWSEL SEL T TEXTOBJ))
-             (FIELD                                          (* ; 
-
   "Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")

-                    (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
-                    (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)         (* ; 
-
                                                             "Set SELECTION to be the found text")

-                    (\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
-                           (GETSEL FIELDSEL DCH)
-                           'LEFT
-                           'PENDINGDEL)                      (* ; "And get it into the window")

-                    (\TEDIT.FIXSEL SEL TEXTOBJ)
-                    (TEDIT.NORMALIZECARET TEXTOBJ))
-             (NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
-                      (SETQ SEL NIL))
-             (\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT"))
-         (CL:WHEN SEL                                        (* ; 
-
                    "There really IS a selection made here, so set up the charlooks for it properly.")

-             (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))])
+
+    (* ;; "Finds/selects the next   >>*<<  or   {*}   or   menu field after the current selection")

+
+    (LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
+           (SEL (TEXTSEL TEXTOBJ))
+           CH CHNO DCH)
+
+          (* ;; "One pass, search in parallel")

+
+          (if
 [for
 old
 CHNO HIT from
 (FGETSEL SEL CHLIM) while
 (SETQ CH (\TEDIT.NTHCHARCODE TSTREAM 
+                                                                               CHNO))
+                 do
 (SELCHARQ CH
+                         (> (CL:WHEN (SETQ HIT (\TEDIT.FIND
 TEXTOBJ ">>*<<" T NIL CHNO))
+                                (SETQ CHNO (CAR HIT))
+                                (SETQ DCH (CADR HIT))
+                                (RETURN T)))
+                         ({ (CL:WHEN (SETQ HIT (\TEDIT.FIND
 TEXTOBJ "{*}" T NIL CHNO))
+                                (SETQ CHNO (CAR HIT))        (* ; "Shouldn't include the { and }")

+                                (SETQ DCH (IDIFFERENCE (CADR HIT)
+                                                 2))
+                                (CL:UNLESS (EQ 0 DCH)        (* ; 
+
                                                             "Right of {, if empty. to put it inside")

+                                    (add
 CHNO 1))
+                                (RETURN T)))
+                         (CL:WHEN (AND (IMAGEOBJP CH)
+                                       (IMAGEOBJPROP CH 'FIELDPREFIX))
+                                                             (* ; "Menu fields")

+                             (add
 CHNO 1)
+                             (RETURN (for
 ENDCHNO FCH from
 CHNO while
 (SETQ FCH (\TEDIT.NTHCHARCODE
+                                                                                 TSTREAM ENDCHNO))
+                                        when
 (AND (IMAGEOBJP FCH)
+                                                  (IMAGEOBJPROP FCH 'FIELDSUFFIX))
+                                        do
 (SETQ DCH (IDIFFERENCE ENDCHNO CHNO))
+                                           (CL:WHEN (EQ 0 DCH)
+                                                             (* ; "RIGHT of prefix, if empty")

+                                               (add
 CHNO -1))
+                                           (RETURN T))))]
+              then
 
+                   (* ;; "CHNO is the beginning of the located blank, DCH is its length")

+
+                   (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                   (\TEDIT.UPDATE.SEL SEL CHNO DCH 'RIGHT 'PENDINGDEL)
+                   (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
+                   (\TEDIT.FIXSEL SEL TEXTOBJ)
+                   (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                   (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
+                   (TEDIT.NORMALIZECARET TEXTOBJ)
+            else
 (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in" T])
+)
+(DEFINEQ
+
+(TEDIT.FIND.OBJECT

+  [LAMBDA (TSTREAM OBJ START END)
                            (* ; "Edited 20-Oct-2024 12:07 by rmk")


+                                                             (* ; "Edited 10-May-2024 21:58 by rmk")


+                                                             (* ; "Edited 16-Mar-2024 10:03 by rmk")


+                                                             (* ; "Edited  6-Nov-2022 11:12 by rmk")


+                                                             (* ; "Edited  3-May-93 12:52 by jds")

+
+    (* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END.  We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece.  We also don't need to test PTYPE, just look at PCONTENTS.")

+
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:WHEN (IMAGEOBJP OBJ)
+        [LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
+             (CL:UNLESS END
+                 (SETQ END (FGETTOBJ TEXTOBJ TEXTLEN)))
+             (CL:UNLESS START
+                 (SETQ START (TEDIT.GETPOINT TSTREAM)))
+             (CL:WHEN (AND (ILEQ START END)
+                           (SETQ START (\TEDIT.CHTOPC START TEXTOBJ)))
+                 (SETQ END (\TEDIT.CHTOPC END TEXTOBJ))
+                 (for
 PC inpieces
 START when
 (EQ OBJ (PCONTENTS PC))
+                    do
 (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil
 (EQ PC END)))])])
+
+(TEDIT.FIND.OBJECT.BACKWARD

+  [LAMBDA (TSTREAM OBJ START END AGAIN)
                      (* ; "Edited 10-May-2024 22:06 by rmk")


+                                                             (* ; "Edited 16-Mar-2024 10:03 by rmk")


+                                                             (* ; "Edited  6-Nov-2022 11:12 by rmk")


+                                                             (* ; "Edited  3-May-93 12:52 by jds")

+
+    (* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and  END and is the occurrence closest to END.  START defaults to 1, END defaults to current caret position (or one before, if AGAIN).")

+
+    (* ;; "If we were sure that a given object can appear only once in a document, we could just run the TEDIT.FIND.OBJECT with different defaults for START and END, but...")

+
+    (* ;; "We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece.  We also don't need to test PTYPE, just look at PCONTENTS.")

+
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:WHEN (IMAGEOBJP OBJ)
+        [LET [(TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM]
+             (SETQ START (IMAX 1 (OR START 1)))
+             (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
+                             (FGETTOBJ TEXTOBJ TEXTLEN)))
+             (CL:WHEN AGAIN
+
+                 (* ;; "Assume that we aren't interested in another match at the current position.")

+
+                 (ADD
 END -1))
+             (CL:WHEN (ILEQ START END)
+                 (SETQ START (\TEDIT.CHTOPC START TEXTOBJ))
+                 (SETQ END (\TEDIT.CHTOPC END TEXTOBJ))
+                 (for
 PC backpieces
 END when
 (EQ OBJ (PCONTENTS PC))
+                    do
 (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil
 (EQ PC START)))])])
 )
 
 
@@ -337,6 +376,95 @@
 
 (DEFINEQ
 
+(\TEDIT.FIND

+  [LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END)
        (* ; "Edited 14-Mar-2025 18:42 by rmk")


+                                                             (* ; "Edited 11-Mar-2025 15:04 by rmk")


+                                                             (* ; "Edited 10-May-2024 21:55 by rmk")


+                                                             (* ; "Edited 24-Apr-2024 23:47 by rmk")


+                                                             (* ; "Edited 19-Jun-2023 22:27 by rmk")


+                                                            (* ; "Edited  6-May-2018 17:34 by rmk:")


+                                                             (* ; "Edited 30-May-91 20:56 by jds")

+
+    (* ;; "This returns the hit's (CH# DCL)  or NIL.")

+
+    (* ;; "If WILDCARDS?  is NIL then TEDIT.FIND returns just the start of a basic string-match.")

+
+    (* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")

+
+    (* ;; "RMK:  FIND isn't undoable, FIND-AGAIN is armed on meta-g.  No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")

+
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:WHEN TARGET
+
+        (* ;; "* and # are implicitly quoted if not WILDCARDS?  This could be handled simply by calling CONS  instead of  \TEDIT.PARSE.SEARCHSTRING")

+
+        (CL:UNLESS END
+            (SETQ END (TEXTLEN (GETTSTR TSTREAM TEXTOBJ))))
+        (CL:UNLESS START
+            (SETQ START (TEDIT.GETPOINT TSTREAM)))
+        (CL:WHEN AGAIN                                       (* ; 
+
                                                             "We aren't interested in the same hit")

+            (add
 START 1))
+        (CL:WHEN (ILEQ START END)
+            [LET (RESULT)
+                 (if
 (IMAGEOBJP TARGET)
+                     then
 (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT
 TSTREAM TARGET START END))
+                                 (LIST RESULT 1))
+                   elseif
 [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
+                     then
 (CL:WHEN (SETQ RESULT (CL:IF WILDCARDS?
+                                                    (\TEDIT.WCFIND
 TSTREAM (\TEDIT.PARSE.SEARCHSTRING

+                                                                            TARGET NIL)
+                                                           START END)
+                                                    (\TEDIT.BASICFIND
 TSTREAM TARGET START END)))
+
+                              (* ;; "Switch from CHLAST to DCH")

+
+                              [LIST (CAR RESULT)
+                                    (ADD1 (IDIFFERENCE (CADR RESULT)
+                                                 (CAR RESULT])]))])
+
+(\TEDIT.FIND.BACKWARD

+  [LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END)
        (* ; "Edited 11-Mar-2025 15:07 by rmk")

+
+    (* ;; "This returns the hit's (CH# DCL)  or NIL.")

+
+    (* ;; "The search is confined to the characters between START and END.  It runs backwards from END looking for the nearest match, and returns the character positions of that match.")

+
+    (* ;; "If WILDCARDS?, the value is the pair (MATCHSTART  MATCHEND) for that match, since the caller doesn't know the length.  But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long.  This is quirky, but that's the way it is documented.")

+
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:WHEN TARGET
+        [LET (RESULT)
+             (if
 (IMAGEOBJP TARGET)
+                 then
 (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT.BACKWARD
 TSTREAM TARGET START END 
+                                                   AGAIN))
+                             (LIST RESULT 1))
+               elseif
 [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
+                 then
 (SETQ START (IMAX 1 (OR START 1)))
+                      (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
+                                      (FGETTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)
+                                             TEXTLEN)))
+                      (CL:WHEN AGAIN
+
+                          (* ;; 
+
                         "Assume that we aren't interested in another match at the current position.")

+
+                          (ADD
 END -1))
+                      (CL:WHEN (ILEQ START END)
+                          (CL:WHEN (SETQ RESULT (CL:IF WILDCARDS?
+                                                    (\TEDIT.WCFIND.BACKWARD
 TSTREAM (
+
                                                                            \TEDIT.PARSE.SEARCHSTRING

+                                                                                     TARGET T)
+                                                           START END)
+                                                    (\TEDIT.BASICFIND.BACKWARD
 TSTREAM TARGET START 
+                                                           END)))
+
+                              (* ;; "Switch from CHLAST to DCH")

+
+                              [LIST (CAR RESULT)
+                                    (ADD1 (IDIFFERENCE (CADR RESULT)
+                                                 (CAR RESULT]))])])
+
 (\TEDIT.WCFIND

   [LAMBDA (TSTREAM TARGETLIST START END)
                     (* ; "Edited 26-Jun-2024 08:04 by rmk")


                                                              (* ; "Edited 23-Jun-2024 12:00 by rmk")


@@ -391,7 +519,8 @@
                       then
 (RETURN NIL])])
 
 (\TEDIT.BASICFIND

-  [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED)
          (* ; "Edited 23-Jun-2024 12:03 by rmk")


+  [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED)
          (* ; "Edited 17-Feb-2025 12:24 by rmk")


+                                                             (* ; "Edited 23-Jun-2024 12:03 by rmk")


                                                              (* ; "Edited 22-Jun-2024 12:01 by rmk")


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


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


@@ -421,7 +550,9 @@
                                              (BIN TSTREAM))
                                      (RETURN NIL))
                               (CL:WHEN (EQ I NCHARS)         (* ; "Matched the last char")

-                                  (RETURN T))) do
 (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
+                                  (RETURN T))) do
 (FSETTOBJ (GETTSTR TSTREAM TEXTOBJ)
+                                                         LASTARROWX NIL)
+                                                  (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
 
 (\TEDIT.WCFIND.BACKWARD

   [LAMBDA (TSTREAM TARGETLIST START END)
                     (* ; "Edited 26-Jun-2024 08:05 by rmk")


@@ -557,8 +688,10 @@
                                                     (DREVERSE $$VAL))])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (784 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE 
-5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND
- 25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) (
-\TEDIT.PARSE.SEARCHSTRING 33332 . 36409)))))
+  (FILEMAP (NIL (961 20132 (TEDIT.FIND 971 . 1555) (TEDIT.FIND.SETSEL 1557 . 2022) (TEDIT.FIND.BACKWARD 
+2024 . 2603) (TEDIT.SUBSTITUTE 2605 . 15424) (TEDIT.NEXT 15426 . 20130)) (20133 23562 (
+TEDIT.FIND.OBJECT 20143 . 21643) (TEDIT.FIND.OBJECT.BACKWARD 21645 . 23560)) (23595 43749 (\TEDIT.FIND
+ 23605 . 26541) (\TEDIT.FIND.BACKWARD 26543 . 29061) (\TEDIT.WCFIND 29063 . 32582) (\TEDIT.BASICFIND 
+32584 . 34943) (\TEDIT.WCFIND.BACKWARD 34945 . 38409) (\TEDIT.BASICFIND.BACKWARD 38411 . 40668) (
+\TEDIT.PARSE.SEARCHSTRING 40670 . 43747)))))
 STOP

library/tedit/TEDIT-HCPY

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164
 32996  
+
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170
 33842  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
+      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS 
+                       \TEDIT.HCPYFMTSPEC)
 
-      :PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
+      :PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
 
 
 (PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -133,7 +134,9 @@
                else
 (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
 
 (\TEDIT.HARDCOPY.DISPLAYLINE

-  [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE)
     (* ; "Edited 13-Dec-2024 23:49 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")


@@ -267,16 +270,18 @@
                                                           (\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")


@@ -284,20 +289,20 @@
 
     (* ;; "Return setup LINE to skip a sequence of heading pieces STATE")

 
-    (SELECTQ (GETPARA FMTSPEC FMTPARATYPE)
+    (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])
 
@@ -343,7 +348,9 @@
     (MOVETO CURX CURY PRSTREAM])
 
 (\TEDIT.HCPYFMTSPEC

-  [LAMBDA (DISPLAYFMT IMAGESTREAM)
                           (* ; "Edited 28-Jul-2024 22:25 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")


@@ -351,33 +358,34 @@
                                                              (* ; "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)))
-          (create
 FMTSPEC using
 DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
-                                (HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR))
-                                LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR))
-                                RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR))
-                                QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT)
-                                FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB))
-                                FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS)
-                                                 SCALE)
-                                FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX)
-                                                   (HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA 
-                                                                                         DISPLAYFMT 
-                                                                                         FMTSPECIALX)
-                                                                         1.0 NIL)))
-                                FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY)
-                                                   (HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA 
-                                                                                         DISPLAYFMT 
-                                                                                         FMTSPECIALY)
-                                                                         1.0 NIL)))
-                                LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE))
-                                LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER))
-                                LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD))
-                                FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE)
-                                                     (HCSCALE SCALE (FGETPARA DISPLAYFMT 
-                                                                           FMTBASETOBASE])
+          (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")

@@ -555,11 +563,11 @@
          (CLOSEF DOC])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE
- 5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 . 
-19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) (
-\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 (
-\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) (
-\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY
- 30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971)))))
+  (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,16 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219
 53094  
+
(FILECREATED "28-Mar-2025 14:23:18" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;227
 53951  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO 
-                       TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE
-                       \TEDIT.COMPOSITE.EVENT)
-                  (VARS TEDIT-HISTORYCOMS)
-                  (MACROS \TEDIT.HISTORYADD1)
+      :CHANGES-TO (FNS \TEDIT.UNDO.REPLACECODE \TEDIT.UNDO1)
 
-      :PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
+      :PREVIOUS-DATE "16-Mar-2025 18:50:43" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;225)
 
 
 (PRETTYCOMPRINT TEDIT-HISTORYCOMS)
@@ -229,10 +225,12 @@
     EVENT])
 
 (\TEDIT.HISTORYADD.COMPOSITE

-  [LAMBDA (TEXTOBJ EVENTS)
                                   (* ; "Edited  8-Dec-2024 19:31 by rmk")


+  [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 
@@ -328,7 +326,8 @@
 (DEFINEQ
 
 (TEDIT.UNDO

-  [LAMBDA (TSTREAM NOUNDOUNDO)
                               (* ; "Edited  8-Dec-2024 19:41 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")


@@ -374,6 +373,7 @@
 
      (* ;; "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.")

 
+           (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
            (TEDIT.PROMPTCLEAR TSTREAM)
            (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
            (\TEDIT.UNDO1
 TSTREAM EVENT)
@@ -396,7 +396,9 @@
            (\TEDIT.SHOWSEL SEL T TEXTOBJ])
 
 (\TEDIT.UNDO1

-  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited 25-Nov-2024 13:56 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")


@@ -425,12 +427,12 @@
                                 (\TEDIT.UNDO.PARALOOKS
 TEXTOBJ EVENT))
                     (:PageFormat                             (* ; "Pageframe change")

                                  (\TEDIT.UNDO.PAGELOOKS
 TEXTOBJ EVENT))
-                    ((LIST :Replace :LowerCase :UpperCase) 
+                    ((LIST :Replace :Transform) 
 
-                                                 (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")

+                                               (* ;; "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
 TEXTOBJ EVENT))
+                    (:ReplaceCode (\TEDIT.UNDO.REPLACECODE
 TSTREAM EVENT))
                     (:Closefile                              (* ; "Closes an included file")

                                 (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
                                     (CLOSEF? (GETTH EVENT THOLDINFO))))
@@ -456,7 +458,9 @@
                                       T])
 
 (TEDIT.REDO

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited  8-Dec-2024 17:53 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")


@@ -498,15 +502,17 @@
                (:Replace                                     (* ; 
 
                                                          "It was a replacement (a del/insert combo)")

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

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

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

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

-                           (\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
+                           (\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")

@@ -636,14 +642,15 @@
           (\TEDIT.SHOWSEL SEL T TSTREAM])
 
 (\TEDIT.UNDO.REPLACE

-  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 13-Sep-2024 23:50 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)
@@ -799,8 +806,9 @@
     (\TEDIT.SCROLL.CARET TSTREAM])
 
 (\TEDIT.UNDO.REPLACECODE

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

-    (TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
+  [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
@@ -840,14 +848,14 @@
     (\TEDIT.THELP 'Redo-composite])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD 
-7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) (
-\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635
- . 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199
- . 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 (
-\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934) 
-(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610
- . 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) (
-\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) (
-\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069)))))
+  (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-OLDFILE

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27
 72985  
+
(FILECREATED "19-Feb-2025 12:09:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;33
 72260  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
+      :CHANGES-TO (FNS \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.GET.SINGLE.PARALOOKS2 
+                       \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
 
-      :PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
+      :PREVIOUS-DATE " 8-Feb-2025 22:08:39" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;31)
 
 
 (PRETTYCOMPRINT TEDIT-OLDFILECOMS)
@@ -46,7 +47,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB2

-  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited  8-Feb-2025 20:21 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:28 by rmk")


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


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


@@ -76,7 +78,7 @@
          (SETQ PIECEINFOCH# (\DWIN TEXT))
          (SETFILEPTR TEXT PIECEINFOCH#)
          (bind
 PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
+               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
                (SBINABLE _ (fetch
 (STREAM BINABLE) of
 TEXT)) for
 I from
 1 to
 PCCOUNT
             do
 (SETQ PC NIL)                                 (* ; 
 
                        "This loop may not really read a piece, so we have to distinguish that case.")

@@ -275,7 +277,9 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.CHARLOOKS2
 FILE])
 
 (\TEDIT.GET.SINGLE.CHARLOOKS2

-  [LAMBDA (FILE)
                                             (* ; "Edited 31-Jul-2024 00:05 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited  7-Jan-2025 12:29 by rmk")


+                                                             (* ; "Edited  2-Jan-2025 11:09 by rmk")


+                                                             (* ; "Edited 31-Jul-2024 00:05 by rmk")


                                                              (* ; "Edited 16-Jan-2024 22:53 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited 25-Nov-2023 23:22 by rmk")


@@ -283,18 +287,18 @@
                                                              (* ; "Edited 30-May-91 20:26 by jds")

                                                              (* ; "Read a set of CHARLOOKS from FILE")

     (PROG* ((LOOKS (create
 CHARLOOKS))
-            FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR)
+            FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC)
            (SETQ NAME (\ARBIN FILE))                         (* ; "The font name")

            (SETQ SIZE (\WIN FILE))                           (* ; "Size of the type, in points")

            (SETQ SUPER (\SMALLPIN FILE))                     (* ; "Superscripting distance")

-           (replace
 (CHARLOOKS CLSTYLE) of
 LOOKS with
 (OR (\ARBIN FILE)
-                                                          0))
-           (replace
 (CHARLOOKS CLUSERINFO) of
 LOOKS with
 (\ARBIN FILE))
+           (FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
+                                         0))
+           (FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
            (SETQ PROPS (\WIN FILE))
+           [SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
+           [SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
            (with
 CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
                  [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
-                 [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
-                 [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
                  [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
                  [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
                  [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
@@ -303,7 +307,6 @@
                  [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
                  [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                  [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
-                 (SETQ CLSIZE SIZE)
                  (SETQ CLOFFSET SUPER))
            [SETQ FONT (COND
                          ((LISTP NAME)                       (* ; 
@@ -312,26 +315,17 @@
                                  NAME))
                          ((AND NAME (NOT (ZEROP SIZE)))
                           (FONTCREATE NAME SIZE (COND
-                                                   ((AND (fetch
 (CHARLOOKS CLBOLD) of
 LOOKS)
-                                                         (fetch
 (CHARLOOKS CLITAL) of
 LOOKS))
+                                                   ((AND BOLD ITALIC)
                                                     'BOLDITALIC)
-                                                   ((fetch
 (CHARLOOKS CLBOLD) of
 LOOKS)
-                                                    'BOLD)
-                                                   ((fetch
 (CHARLOOKS CLITAL) of
 LOOKS)
-                                                    'ITALIC]
-           (replace
 (CHARLOOKS CLNAME) of
 LOOKS
-              with
 (if
 (type?
 FONTCLASS FONT)
-                       then
 
-                            (* ;; "Put the display family in the CLNAME spot.  Better than NIL.")

-
-                            (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T]
-                                (FONTPROP NAME 'FAMILY))
-                     else
 NAME))
-           (replace
 (CHARLOOKS CLFONT) of
 LOOKS with
 FONT)
+                                                   (BOLD 'BOLD)
+                                                   (ITALIC 'ITALIC]
+           (FSETCLOOKS LOOKS CLFONT FONT)
+           (FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
            (RETURN LOOKS])
 
 (\TEDIT.PUT.SINGLE.PARALOOKS2

-  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 19-Feb-2025 12:09 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


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


                                                              (* ; "Edited 28-Jul-2024 16:07 by rmk")


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


@@ -341,16 +335,16 @@
                                                              (* ; 
 
                  "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")

     (PROG (DEFTAB TABS OUTPUTFORMAT LEN)
-          (\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR))      (* ; 
+          (\SMALLPOUT FILE (FGETPLOOKS LOOKS 1STLEFTMAR))    (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-          (\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR))         (* ; 
+          (\SMALLPOUT FILE (FGETPLOOKS LOOKS LEFTMAR))       (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-          (\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR))        (* ; "Right margin for the paragraph")

-          (\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE))      (* ; "Leading before the paragraph")

-          (\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER))       (* ; "Lead after the paragraph")

-          (\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD))        (* ; "inter-line leading")

-          (SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
-          (SETQ TABS (FGETPARA LOOKS FMTTABS))
+          (\SMALLPOUT FILE (FGETPLOOKS LOOKS RIGHTMAR))      (* ; "Right margin for the paragraph")

+          (\SMALLPOUT FILE (FGETPLOOKS LOOKS LEADBEFORE))    (* ; "Leading before the paragraph")

+          (\SMALLPOUT FILE (FGETPLOOKS LOOKS LEADAFTER))     (* ; "Lead after the paragraph")

+          (\SMALLPOUT FILE (FGETPLOOKS LOOKS LINELEAD))      (* ; "inter-line leading")

+          (SETQ DEFTAB (FGETPLOOKS LOOKS FMTDEFAULTTAB))
+          (SETQ TABS (FGETPLOOKS LOOKS FMTTABS))
           (COND
              ((AND (OR DEFTAB TABS))                         (* ; 
 
                             "There are tab specs to save, or there is a default tab setting to save")

@@ -358,7 +352,7 @@
              (T                                              (* ; 
 
                                                          "There are no tab looks.  Just let him go.")

                 (\BOUT FILE 2)))
-          (\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
+          (\BOUT FILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
                           (LEFT 1)
                           (RIGHT 2)
                           ((CENTER CENTERED) 
@@ -378,26 +372,27 @@
                                                       (CENTERED 2)
                                                       (DECIMAL 3)
                                                       (\TEDIT.THELP]))
-          (\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
+          (\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
                                0))
-          (\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
+          (\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
                                0))
-          (\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO))
-          (\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE))
-          (\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE))
-          (\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE))
-          (\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES))
-          (\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
-          (\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
+          (\ARBOUT FILE (FGETPLOOKS LOOKS FMTUSERINFO))
+          (\ATMOUT FILE (FGETPLOOKS LOOKS FMTPARATYPE))
+          (\ATMOUT FILE (FGETPLOOKS LOOKS FMTPARASUBTYPE))
+          (\ARBOUT FILE (FGETPLOOKS LOOKS FMTSTYLE))
+          (\ARBOUT FILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
+          (\ARBOUT FILE (FGETPLOOKS LOOKS FMTNEWPAGEBEFORE))
+          (\ARBOUT FILE (FGETPLOOKS LOOKS FMTNEWPAGEAFTER])
 
 (\TEDIT.PUT.SINGLE.CHARLOOKS2

-  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 31-Jul-2024 00:05 by rmk")


+  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited  2-Jan-2025 10:51 by rmk")


+                                                             (* ; "Edited 31-Jul-2024 00:05 by rmk")


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


                                                              (* ; "Edited 19-Dec-2023 10:14 by rmk")


                                                              (* ; "Edited 30-May-91 20:26 by jds")

                                                              (* ; 
 
                                                            "Put out a single CHARLOOKS description.")

-    (PROG ((FONT (fetch
 (CHARLOOKS CLFONT) of
 LOOKS))
+    (PROG ((FONT (GETCLOOKS LOOKS CLFONT))
            STR LEN)
           [COND
              ((type?
 FONTCLASS FONT)                         (* ; 
@@ -408,68 +403,54 @@
                 (\ATMOUT FILE (FONTPROP FONT 'FAMILY]        (* ; "The font family")

           (\WOUT FILE (OR (FONTPROP FONT 'SIZE)
                           0))                                (* ; "Size of the type, in points")

-          (\SMALLPOUT FILE (OR (fetch
 (CHARLOOKS CLOFFSET) of
 LOOKS)
+          (\SMALLPOUT FILE (OR (GETCLOOKS LOOKS CLOFFSET)
                                0))                           (* ; "Super/subscripting distance")

           (COND
-             ([AND (fetch
 (CHARLOOKS CLSTYLE) of
 LOOKS)
-                   (NOT (ZEROP (fetch
 (CHARLOOKS CLSTYLE) of
 LOOKS]
-              (\ARBOUT FILE (fetch
 (CHARLOOKS CLSTYLE) of
 LOOKS)))
+             ([AND (GETCLOOKS LOOKS CLSTYLE)
+                   (NOT (ZEROP (GETCLOOKS LOOKS CLSTYLE]
+              (\ARBOUT FILE (GETCLOOKS LOOKS CLSTYLE)))
              (T (\WOUT FILE 0)))
           (COND
-             ((fetch
 (CHARLOOKS CLUSERINFO) of
 LOOKS)
-              (\ARBOUT FILE (fetch
 (CHARLOOKS CLUSERINFO) of
 LOOKS)))
+             ((GETCLOOKS LOOKS CLUSERINFO)
+              (\ARBOUT FILE (GETCLOOKS LOOKS CLUSERINFO LOOKS)))
              (T (\WOUT FILE 0)))
-          (\WOUT FILE (LOGOR (COND
-                                ((fetch
 (CHARLOOKS CLLEADER) of
 LOOKS)
-                                                             (* ; 
-
                                                             "Dotted-leader;  relevant only to TABs")

-                                 2048)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLINVERTED) of
 LOOKS)
-                                                             (* ; "Inverse-video")

-                                 1024)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLBOLD) of
 LOOKS)
-                                 512)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLITAL) of
 LOOKS)
-                                 256)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLULINE) of
 LOOKS)
-                                 128)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLOLINE) of
 LOOKS)
-                                 64)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLSTRIKE) of
 LOOKS)
-                                 32)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLSMALLCAP) of
 LOOKS)
-                                 16)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLPROTECTED) of
 LOOKS)
-                                 8)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLINVISIBLE) of
 LOOKS)
-                                 NIL 4)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLSELAFTER) of
 LOOKS)
-                                 2)
-                                (T 0))
-                             (COND
-                                ((fetch
 (CHARLOOKS CLCANCOPY) of
 LOOKS)
-                                 1)
-                                (T 0])
+          (\WOUT FILE (LOGOR (CL:IF (GETCLOOKS LOOKS CLLEADER LOOKS)
+                                 2048
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLINVERTED LOOKS)
+                                 1024
+                                 0)
+                             (CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
+                                 512
+                                 0)
+                             (CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
+                                 512
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLULINE)
+                                 128
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLOLINE)
+                                 64
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLSTRIKE)
+                                 32
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLSMALLCAP)
+                                 16
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLPROTECTED)
+                                 8
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLINVISIBLE)
+                                 NIL
+                                 4
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLSELAFTER)
+                                 2
+                                 0)
+                             (CL:IF (GETCLOOKS LOOKS CLCANCOPY)
+                                 1
+                                 0)])
 
 (\TEDIT.GET.PARALOOKS.LIST2

   [LAMBDA (FILE)
                                             (* ; "Edited 19-Dec-2023 10:13 by rmk")

@@ -479,7 +460,9 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.PARALOOKS2
 FILE])
 
 (\TEDIT.GET.SINGLE.PARALOOKS2

-  [LAMBDA (FILE)
                                             (* ; "Edited 23-Oct-2024 16:07 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 19-Feb-2025 12:09 by rmk")


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


+                                                             (* ; "Edited 23-Oct-2024 16:07 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited  5-Aug-2024 09:48 by rmk")


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


@@ -491,28 +474,28 @@
                                                              (* ; "Edited 30-May-91 20:33 by jds")

                                                              (* ; 
 
                           "Read a paragraph format spec from the FILE, and return it for later use.")

-    (LET ((FMT (create
 FMTSPEC))
+    (LET ((PARALOOKS (create
 PARALOOKS))
           TABFLG DEFTAB TABS)
-         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
+         (FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE))  (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
+         (FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE))     (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

-         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

-         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

-         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

+         (FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE))    (* ; "Right margin for the paragraph")

+         (FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE))  (* ; "Leading before the paragraph")

+         (FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE))   (* ; "Lead after the paragraph")

+         (FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE))    (* ; "inter-line leading")

          (SETQ TABFLG (BIN FILE))
-         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
-                                (1 'LEFT)
-                                (2 'RIGHT)
-                                (3 'CENTERED)
-                                (4 'JUSTIFIED)
-                                (\TEDIT.THELP)))
+         (FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
+                                        (1 'LEFT)
+                                        (2 'RIGHT)
+                                        (3 'CENTERED)
+                                        (4 'JUSTIFIED)
+                                        (\TEDIT.THELP)))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 1))                (* ; "There are tabs to read")

              (SETQ DEFTAB (\SMALLPIN FILE))
              (CL:WHEN (ILEQ DEFTAB 1)
                     (SETQ DEFTAB DEFAULTTAB))
-             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
+             (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
              [SETQ TABS (for
 TAB# from
 1 to
 (BIN FILE) collect
 (create
 TAB
                                                                       TABX _ (\SMALLPIN FILE)
                                                                       TABKIND _
@@ -522,22 +505,23 @@
                                                                           (2 'CENTERED)
                                                                           (3 'DECIMAL)
                                                                           (\TEDIT.THELP]
-             (FSETPARA FMT FMTTABS TABS))
-         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
-                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
+             (FSETPLOOKS PARALOOKS FMTTABS TABS))
+         (CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
+                (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 2))                (* ; 
 
                                                   "There are other paragraph parameters to be read.")

-             (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE))     (* ; 
+             (FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
+                                                             (* ; 
 
                                                      "Special X location on page for this paragraph")

-             (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
-             (FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
-             (FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
-             (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
-             (FSETPARA FMT FMTSTYLE (\ARBIN FILE))
-             (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
-             (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
-             (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
-         FMT])
+             (FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
+             (FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
+             (FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
+             (FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE)))
+         PARALOOKS])
 
 (\TEDIT.PUT.CHARLOOKS.LIST2

   [LAMBDA (FILE LOOKSLIST)
                                   (* ; "Edited 16-Jan-2024 23:02 by rmk")


@@ -591,7 +575,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB1

-  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited  8-Feb-2025 20:22 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:28 by rmk")


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


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


@@ -620,7 +605,7 @@
          (SETQ PIECEINFOCH# (\DWIN TEXT))
          (SETFILEPTR TEXT PIECEINFOCH#)
          (bind
 PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
+               (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
                (SBINABLE _ (fetch
 (STREAM BINABLE) of
 TEXT)) for
 I from
 1 to
 PCCOUNT
             do
 (SETQ PC NIL)                                 (* ; 
 
                        "This loop may not really read a piece, so we have to distinguish that case.")

@@ -736,7 +721,8 @@
                       (\TEDIT.PARSE.PAGEFRAMES1
 (pop
 PAGELIST])
 
 (\TEDIT.GET.CHARLOOKS1

-  [LAMBDA (PC FILE)
                                          (* ; "Edited 31-Jul-2024 00:05 by rmk")


+  [LAMBDA (PC FILE)
                                          (* ; "Edited  2-Jan-2025 11:09 by rmk")


+                                                             (* ; "Edited 31-Jul-2024 00:05 by rmk")


                                                              (* ; "Edited 16-Jan-2024 22:55 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited 25-Nov-2023 23:21 by rmk")


@@ -747,7 +733,9 @@
 
     (* ;; "Read a description of PC's CHARLOOKS from FILE. The looks are here stored in PC, not in the TEXTOBJ (uniquify later?)")

 
-    (LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create
 CHARLOOKS)))
+    (LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC (LOOKS (create

+                                                                                          CHARLOOKS))
+               )
          (FSETPC PC PLOOKS LOOKS)
          (SETQ NAME (\ARBIN FILE))                           (* ; "The font name")

          (SETQ SIZE (\WIN FILE))                             (* ; "Size of the type, in points")

@@ -762,13 +750,13 @@
              (FSETPC PC PNEW T))
          (CL:UNLESS (ZEROP (BIN FILE))                       (* ; 
 
                                                      "There is style or user information to be read")

-             (replace
 (CHARLOOKS CLSTYLE) of
 LOOKS with
 (OR (\ARBIN FILE)
-                                                            0))
-             (replace
 (CHARLOOKS CLUSERINFO) of
 LOOKS with
 (\ARBIN FILE)))
+             (FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
+                                           0))
+             (FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE)))
          (SETQ PROPS (\WIN FILE))
-         (with
 CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
-               [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
-               [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
+         [SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
+         [SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
+         (with
 CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
                [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
                [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
                [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
@@ -776,34 +764,27 @@
                [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
                [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
-               (SETQ CLSIZE SIZE)
                (SETQ CLOFFSET SUPER))
          [SETQ FONT (COND
                        ((LISTP NAME)                         (* ; 
 
                                                             "This was a font class.  Restore it.")

-                        (FONTCLASS (pop
 NAME)
-                               NAME))
-                       ((AND NAME (NOT (ZEROP SIZE)))
+                        (FONTCLASS (CONS 0 (CDDR NAME))
+                               'TEDIT-FONTCLASS))
+                       [(AND NAME (NOT (ZEROP SIZE)))
                         (FONTCREATE NAME SIZE (COND
-                                                 ((AND (fetch
 (CHARLOOKS CLBOLD) of
 LOOKS)
-                                                       (fetch
 (CHARLOOKS CLITAL) of
 LOOKS))
+                                                 ((AND BOLD ITALIC)
                                                   'BOLDITALIC)
-                                                 ((fetch
 (CHARLOOKS CLBOLD) of
 LOOKS)
-                                                  'BOLD)
-                                                 ((fetch
 (CHARLOOKS CLITAL) of
 LOOKS)
-                                                  'ITALIC]
-         (replace
 (CHARLOOKS CLNAME) of
 LOOKS
-            with
 (if
 (type?
 FONTCLASS FONT)
-                     then
 
-                          (* ;; "Put the display family in the CLNAME spot.  Better than NIL.")

-
-                          (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T]
-                              (FONTPROP NAME 'FAMILY))
-                   else
 NAME))
-         (replace
 (CHARLOOKS CLFONT) of
 LOOKS with
 FONT])
+                                                 (BOLD 'BOLD)
+                                                 (ITALIC 'ITALIC]
+                       (T                                    (* ; "Should never happen")

+                          (FONTCREATE DEFAULTFONT]
+         (FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
+         (FSETCLOOKS LOOKS CLFONT FONT])
 
 (\TEDIT.GET.PARALOOKS1

-  [LAMBDA (FILE)
                                             (* ; "Edited 23-Oct-2024 16:08 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 19-Feb-2025 12:09 by rmk")


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


+                                                             (* ; "Edited 23-Oct-2024 16:08 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited  5-Aug-2024 09:48 by rmk")


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


@@ -815,53 +796,54 @@
                                                              (* ; "Edited 30-May-91 20:34 by jds")

                                                              (* ; 
 
                           "Read a paragraph format spec from the FILE, and return it for later use.")

-    (LET ((FMT (create
 FMTSPEC))
+    (LET ((PARALOOKS (create
 PARALOOKS))
           TABFLG DEFTAB)
-         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
+         (FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE))  (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
+         (FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE))     (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

-         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

-         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

-         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

+         (FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE))    (* ; "Right margin for the paragraph")

+         (FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE))  (* ; "Leading before the paragraph")

+         (FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE))   (* ; "Lead after the paragraph")

+         (FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE))    (* ; "inter-line leading")

                                                              (* ; "Will be tab specs")

          (SETQ TABFLG (BIN FILE))
-         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
-                                (1 'LEFT)
-                                (2 'RIGHT)
-                                (3 'CENTERED)
-                                (4 'JUSTIFIED)
-                                (\TEDIT.THELP)))
+         (FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
+                                        (1 'LEFT)
+                                        (2 'RIGHT)
+                                        (3 'CENTERED)
+                                        (4 'JUSTIFIED)
+                                        (\TEDIT.THELP)))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 1))                (* ; "There are tabs to read")

              (SETQ DEFTAB (\SMALLPIN FILE))
              (CL:WHEN (ILEQ DEFTAB 1)
                     (SETQ DEFTAB DEFAULTTAB))
-             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
-             [FSETPARA FMT FMTTABS (for
 TAB# from
 1 to
 (BIN FILE)
-                                      collect
 (create
 TAB
-                                                     TABX _ (\SMALLPIN FILE)
-                                                     TABKIND _ (SELECTQ (BIN FILE)
-                                                                   (0 'LEFT)
-                                                                   (1 'RIGHT)
-                                                                   (2 'CENTERED)
-                                                                   (3 'DECIMAL)
-                                                                   (\TEDIT.THELP])
-         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
-                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
+             (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
+             [FSETPLOOKS PARALOOKS FMTTABS (for
 TAB# from
 1 to
 (BIN FILE)
+                                              collect
 (create
 TAB
+                                                             TABX _ (\SMALLPIN FILE)
+                                                             TABKIND _ (SELECTQ (BIN FILE)
+                                                                           (0 'LEFT)
+                                                                           (1 'RIGHT)
+                                                                           (2 'CENTERED)
+                                                                           (3 'DECIMAL)
+                                                                           (\TEDIT.THELP])
+         (CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
+                (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 2))                (* ; 
 
                                                   "There are other paragraph parameters to be read.")

-             (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE))     (* ; 
+             (FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
+                                                             (* ; 
 
                                                      "Special X location on page for this paragraph")

-             (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
-             (FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
-             (FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
-             (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
-             (FSETPARA FMT FMTSTYLE (\ARBIN FILE))
-             (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
-             (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
-             (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
-         FMT])
+             (FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
+             (FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
+             (FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
+             (FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
+             (FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE)))
+         PARALOOKS])
 
 (TEDIT.GET.OBJECT1

   [LAMBDA (STREAM PIECE FILE CURCH#)
                         (* ; "Edited 31-Jul-2024 12:09 by rmk")


@@ -900,7 +882,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB0

-  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited  8-Feb-2025 20:22 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 29-Apr-2024 10:27 by rmk")


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


                                                              (* ; "Edited 15-Mar-2024 14:47 by rmk")


@@ -921,8 +904,8 @@
                                  8))
          (SETQ PIECEINFOCH# (\DWIN TEXT))
          (SETFILEPTR TEXT PIECEINFOCH#)
-         (bind
 PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) for
 I
-            from
 1 to
 PCCOUNT
+         (bind
 PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
+            for
 I from
 1 to
 PCCOUNT
             do
 (SETQ PCLEN (\DWIN TEXT))
                (SETQ PC
                 (create
 PIECE
@@ -962,15 +945,17 @@
                (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally
 (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
 
 (\TEDIT.GET.CHARLOOKS0

-  [LAMBDA (PC FILE)
                                          (* ; "Edited 31-Jul-2024 00:05 by rmk")


+  [LAMBDA (PC FILE)
                                          (* ; "Edited  2-Jan-2025 11:09 by rmk")


+                                                             (* ; "Edited 31-Jul-2024 00:05 by rmk")


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


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


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


                                                              (* ; "Edited 30-May-91 20:26 by jds")

                                                              (* ; 
 
                  "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")

-    (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create
 CHARLOOKS)))
-          (replace
 (PIECE PLOOKS) of
 PC with
 LOOKS)
+    (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC
+                (LOOKS (create
 CHARLOOKS)))
+          (SETPC PC PLOOKS LOOKS)
           (SETQ NAMELEN (\WIN FILE))                         (* ; 
 
                                                        "The length of the description which follows")

           [SETQ NAME (PACK (for
 I from
 1 to
 NAMELEN collect
 (CHARACTER (BIN FILE]
@@ -985,7 +970,7 @@
 
           (COND
              ((NOT (ZEROP (BIN FILE)))                       (* ; "This text is NEW.  Mark it so.")

-              (replace
 (PIECE PNEW) of
 PC with
 T)))
+              (FSETPC PC PNEW T)))
           [COND
              ((NOT (ZEROP (BIN FILE)))                       (* ; 
 
                                                      "There is style or user information to be read")

@@ -993,15 +978,15 @@
               (SETQ USERSTR (\STRINGIN FILE))
               (COND
                  ((NOT (ZEROP (NCHARS STYLESTR)))            (* ; "There IS style info")

-                  (replace
 (CHARLOOKS CLSTYLE) of
 LOOKS with
 (READ STYLESTR)))
-                 (T (replace
 (CHARLOOKS CLSTYLE) of
 LOOKS with
 0)))
+                  (FSETCLOOKS LOOKS CLSTYLE (READ STYLESTR)))
+                 (T (FSETCLOOKS LOOKS CLSTYLE 0)))
               (COND
                  ((NOT (ZEROP (NCHARS USERSTR)))             (* ; "There IS user info")

-                  (replace
 (CHARLOOKS CLUSERINFO) of
 LOOKS with
 (READ USERSTR]
+                  (FSETCLOOKS LOOKS CLUSERINFO (READ USERSTR]
           (SETQ PROPS (\WIN FILE))
-          (with
 CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
-                [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
-                [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
+          [SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
+          [SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
+          (with
 CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
                 [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
                 [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
                 [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
@@ -1009,22 +994,18 @@
                 [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
                 [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                 [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
-                (SETQ CLSIZE SIZE)
                 (SETQ CLOFFSET SUPER))
-          (replace
 (CHARLOOKS CLFONT) of
 LOOKS with
 (AND NAME (NOT (ZEROP SIZE))
-                                                         (FONTCREATE NAME SIZE
-                                                                (COND
-                                                                   ((AND (fetch
 (CHARLOOKS CLBOLD)
-                                                                            of
 LOOKS)
-                                                                         (fetch
 (CHARLOOKS CLITAL)
-                                                                            of
 LOOKS))
-                                                                    'BOLDITALIC)
-                                                                   ((fetch
 (CHARLOOKS CLBOLD)
-                                                                       of
 LOOKS)
-                                                                    'BOLD)
-                                                                   ((fetch
 (CHARLOOKS CLITAL)
-                                                                       of
 LOOKS)
-                                                                    'ITALIC])
+          (SETQ FONT (if
 (AND NAME (NOT (ZEROP SIZE)))
+                         then
 [FONTCREATE NAME SIZE (COND
+                                                       ((AND BOLD ITALIC ITALIC)
+                                                        'BOLDITALIC)
+                                                       (BOLD 'BOLD)
+                                                       (ITALIC 'ITALIC]
+                       else
                                  (* ; "Should never happen")

+                            (FONTCREATE DEFAULTFONT)))
+          (FSETCLOOKS LOOKS CLFONT FONT)
+          (FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
+          (RETURN LOOKS])
 
 (\TEDIT.GET.OBJECT0

   [LAMBDA (STREAM PIECE FILE CURCH#)
                         (* ; "Edited 31-Jul-2024 12:09 by rmk")


@@ -1058,7 +1039,9 @@
          OBJ])
 
 (\TEDIT.GET.PARALOOKS0

-  [LAMBDA (PC FILE)
                                          (* ; "Edited 23-Oct-2024 16:09 by rmk")


+  [LAMBDA (PC FILE)
                                          (* ; "Edited 19-Feb-2025 12:09 by rmk")


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


+                                                             (* ; "Edited 23-Oct-2024 16:09 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited  5-Aug-2024 09:47 by rmk")


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


@@ -1070,29 +1053,29 @@
                                                              (* ; "Edited 30-May-91 20:34 by jds")

                                                              (* ; 
 
                  "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")

-    (LET ((FMT (create
 FMTSPEC))
+    (LET ((PARALOOKS (create
 PARALOOKS))
           TABFLG DEFTAB TABS)
-         (SETPC PC PPARALOOKS FMT)
-         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
+         (SETPC PC PPARALOOKS PARALOOKS)
+         (FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE))  (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
+         (FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE))     (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

-         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

-         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

-         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

+         (FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE))    (* ; "Right margin for the paragraph")

+         (FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE))  (* ; "Leading before the paragraph")

+         (FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE))   (* ; "Lead after the paragraph")

+         (FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE))    (* ; "inter-line leading")

          (SETQ TABFLG (BIN FILE))
-         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
-                                (1 'LEFT)
-                                (2 'RIGHT)
-                                (3 'CENTERED)
-                                (4 'JUSTIFIED)
-                                (\TEDIT.THELP)))
+         (FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
+                                        (1 'LEFT)
+                                        (2 'RIGHT)
+                                        (3 'CENTERED)
+                                        (4 'JUSTIFIED)
+                                        (\TEDIT.THELP)))
          (CL:UNLESS (ZEROP TABFLG)                           (* ; "There are tabs to read")

              (SETQ DEFTAB (\SMALLPIN FILE))
              (CL:WHEN (ILEQ DEFTAB 1)
                     (SETQ DEFTAB DEFAULTTAB))
-             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
+             (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
              [SETQ TABS (for
 TAB# from
 1 to
 (BIN FILE) collect
 (create
 TAB
                                                                       TABX _ (\SMALLPIN FILE)
                                                                       TABKIND _
@@ -1102,20 +1085,20 @@
                                                                           (2 'CENTERED)
                                                                           (3 'DECIMAL)
                                                                           (\TEDIT.THELP]
-             (FSETPARA FMT FMTTABS TABS))
-         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
-                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
-         FMT])
+             (FSETPLOOKS PARALOOKS FMTTABS TABS))
+         (CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
+                (FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
+         PARALOOKS])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) (
-\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) (
-\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) (
-\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) (
-\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) (
-\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 (
-\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203
- . 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) (
-TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0
- 62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960)))))
+  (FILEMAP (NIL (1758 37224 (\TEDIT.GET.PCTB2 1768 . 12181) (\TEDIT.GET.PARALOOKS2 12183 . 12772) (
+\TEDIT.GET.CHARLOOKS2 12774 . 14105) (\TEDIT.PARSE.PAGEFRAMES2 14107 . 16846) (
+\TEDIT.GET.CHARLOOKS.LIST2 16848 . 17355) (\TEDIT.GET.SINGLE.CHARLOOKS2 17357 . 20568) (
+\TEDIT.PUT.SINGLE.PARALOOKS2 20570 . 24820) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24822 . 28532) (
+\TEDIT.GET.PARALOOKS.LIST2 28534 . 29041) (\TEDIT.GET.SINGLE.PARALOOKS2 29043 . 33942) (
+\TEDIT.PUT.CHARLOOKS.LIST2 33944 . 36023) (\TEDIT.PUT.PARALOOKS.LIST2 36025 . 37222)) (37301 57923 (
+\TEDIT.GET.PCTB1 37311 . 44120) (\TEDIT.GET.PAGEFRAMES1 44122 . 44574) (\TEDIT.PARSE.PAGEFRAMES1 44576
+ . 47229) (\TEDIT.GET.CHARLOOKS1 47231 . 51276) (\TEDIT.GET.PARALOOKS1 51278 . 56189) (
+TEDIT.GET.OBJECT1 56191 . 57921)) (57983 72237 (\TEDIT.GET.PCTB0 57993 . 62074) (\TEDIT.GET.CHARLOOKS0
+ 62076 . 66171) (\TEDIT.GET.OBJECT0 66173 . 68232) (\TEDIT.GET.PARALOOKS0 68234 . 72235)))))
 STOP

library/tedit/TEDIT-PAGE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Dec-2024 21:32:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;200
 121366 
+
(FILECREATED "23-Feb-2025 10:06:16" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;208
 133418 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
+      :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
 
-      :PREVIOUS-DATE "11-Dec-2024 22:39:52" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;198)
+      :PREVIOUS-DATE "19-Feb-2025 13:33:12" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;207)
 
 
 (PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -85,6 +85,11 @@
                                          (B5 499 709]
         (COMS                                                (* ; "Page numbering option support")

               (FNS ROMANNUMERALS))
+        (COMS                                                (* ; "Page number image obj")

+              (FNS TEDIT.PAGENO.CREATE \TEDIT.PAGENO.OBJINIT \TEDIT.PAGENO.BUTTONEVENTINFN 
+                   \TEDIT.PAGENO.IMAGEBOXFN \TEDIT.PAGENO.DISPLAYFN \TEDIT.PAGENO.GETFN 
+                   \TEDIT.PAGENO.PUTFN)
+              (P (\TEDIT.PAGENO.OBJINIT)))
         (COMS 
               (* ;; "Foot note support")

 
@@ -180,10 +185,9 @@
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \FIRST-COLUMN-START
 MACRO
 [(LINE FMTSPEC)
+(PUTPROPS \FIRST-COLUMN-START
 MACRO
 [(LINE PARALOOKS)
                                      (AND (FGETLD LINE 1STLN)
-                                          (EQ (FFETCH
 (FMTSPEC FMTCOLUMN) OF
 FMTSPEC)
-                                              'FIRST])
+                                          (EQ 'FIRST (FGETPLOOKS PARALOOKS FMTCOLUMN])
 )
 
 (DECLARE%: EVAL@COMPILE 
@@ -307,7 +311,8 @@
 
 (TEDIT.SINGLE.PAGEFORMAT

   [LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS 
-                 PAGEPROPS PAPERSIZE)
                        (* ; "Edited 24-Dec-2024 21:20 by rmk")


+                 PAGEPROPS PAPERSIZE)
                        (* ; "Edited 10-Jan-2025 11:41 by rmk")


+                                                             (* ; "Edited 24-Dec-2024 21:20 by rmk")


                                                              (* ; "Edited 15-Aug-2024 23:01 by rmk")


                                                              (* ; "Edited  6-Aug-2024 12:06 by rmk")


                                                              (* ; "Edited 13-Nov-2023 08:59 by rmk")


@@ -349,22 +354,27 @@
           (SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
                                  LEFT))
           (CL:WHEN PAGE#S?
+
+              (* ;; "This asserts that the page number's region is 4 inches wide.  Why?  What if the pretext/posttext is longer?")

+
               (SELECTQ (U-CASE PQUAD)
                   (LEFT                                      (* ; 
 
                   "If the page number is flush left, set up the region to start where he specified.")

                         (SETQ FOLIOLEFT PX))
                   (RIGHT                                     (* ; 
 
                                                "If it's flush right, set up the region to END there")

-                         (SETQ FOLIOLEFT (IDIFFERENCE PX 288)))
+                         (SETQ FOLIOLEFT (IDIFFERENCE PX (ITIMES 4 PTSPERINCH))))
                   ((CENTERED CENTER NIL)                     (* ; 
 
                                    "Otherwise, center the page number around the point he specifies")

-                       (SETQ FOLIOLEFT (IDIFFERENCE PX 144)))
+                       (SETQ FOLIOLEFT (IDIFFERENCE PX (ITIMES 2 PTSPERINCH))))
                   (ERROR "Invalid  page number alignment" PQUAD))
 
               (* ;; "Note that the folio charlooks is a charlooks spec-list, not a CHARLOOKS.  The parse/unparse is just to get the priority union of PFONT with  the defaults.")

 
               (* ;; "RMK:   Very odd to default here 4 inches and 1/2 for the folio region.  ")

 
+              (* ;; "PY is described as the baseline of the page numbers, measured from the bottom of the page.  So the page numbers and pre/posttext sit above.")

+
               [SETQ SUBREGIONS (LIST (create
 PAGEREGION
                                             REGIONFILLMETHOD _ 'FOLIO
                                             REGIONSPEC _
@@ -388,7 +398,7 @@
                (for
 HDG LEFT in
 HEADINGS when
 (CAR HDG)
                   collect
 
 
-                        (* ;; "Run thru the list of headings, building a box for each.  By default, a heading will have the same width right margin as the left margin that was specified.")

+                        (* ;; "Run thru the list of headings, building a box for each.  By default the heading's width runs up to the right margin on the page.  X/LEFT is the left end of the top line, Y is the %"position of the top line%"--it's YTOP, baseline, or YBOT?  But SPECIALX and SPECIALY are described as %"the distances from the lower-left corner of the paper:  the lower-left corner of the paragraph's top line is placed at the specified position, so this suggests YBOT.")

 
                         (if
 (AND (NUMBERP (CADR HDG))
                                  (NUMBERP (CADDR HDG)))
@@ -620,7 +630,8 @@
 
 (TEDIT.FORMAT.HARDCOPY

   [LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG 
-                 ENDPG)
                                      (* ; "Edited 30-Aug-2024 15:45 by rmk")


+                 ENDPG QUIET)
                                (* ; "Edited 23-Feb-2025 09:59 by rmk")


+                                                             (* ; "Edited 30-Aug-2024 15:45 by rmk")


                                                              (* ; "Edited 10-Jul-2024 23:34 by rmk")


                                                              (* ; "Edited 29-Jun-2024 10:32 by rmk")


                                                              (* ; "Edited  5-Apr-2024 08:01 by rmk")


@@ -690,7 +701,7 @@
               [SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM TEXTSTREAM]
               (RESETLST                                      (* ; 
 
                                           "Set up to do the user's cleanup on the way out, as well.")

-                  (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
+                  (CL:UNLESS QUIET (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T))
                   [COND
                      ((AND FILE (OPENP FILE)
                            (IMAGESTREAMTYPE FILE))           (* ; 
@@ -747,15 +758,16 @@
                               (FUNCTION NILL))
                          TEXTSTREAM))
               (SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT))
-              (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
-                                                                    ""
-                                                                    "s")
-                                                " printed"
-                                                (CL:IF (EQ FILE SCRATCHFILE)
-                                                    (CONCAT " to " (OR TARGETFILENAME (FULLNAME
-                                                                                       FILE)))
-                                                    ""))
-                     T)
+              (CL:UNLESS QUIET
+                  (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
+                                                                        ""
+                                                                        "s")
+                                                    " printed"
+                                                    (CL:IF (EQ FILE SCRATCHFILE)
+                                                        (CONCAT " to " (OR TARGETFILENAME
+                                                                           (FULLNAME FILE)))
+                                                        ""))
+                         T))
               (RETURN NPAGES)))])
 )
 
@@ -925,7 +937,9 @@
                   (SETPFS FORMATTINGSTATE CHNO CHNO])
 
 (\TEDIT.FORMATHEADING

-  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)
      (* ; "Edited 24-Nov-2024 11:46 by rmk")


+  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)
      (* ; "Edited  9-Jan-2025 22:27 by rmk")


+                                                             (* ; "Edited  3-Jan-2025 14:29 by rmk")


+                                                             (* ; "Edited 24-Nov-2024 11:46 by rmk")


                                                              (* ; "Edited 20-Nov-2024 12:37 by rmk")


                                                              (* ; "Edited 17-Nov-2024 19:10 by rmk")


                                                              (* ; "Edited 26-Oct-2024 10:43 by rmk")


@@ -941,26 +955,26 @@
                                                              (* ; "Edited  9-May-2023 20:30 by rmk")


                                                              (* ; "Edited  9-Oct-90 13:24 by jds")

 
-    (* ;; "Grab heading pieces from the FORMATTINGSTATE and use them to fill REGION on a page.  Return a list of line descriptors which fill the region.")

+    (* ;; "Grab heading SELPIECES from the FORMATTINGSTATE and use them to fill REGION on a page.  Return a list of line descriptors which fill the region.  The SELPIECES are constructed by \TEDIT.HARDCOPY.PAGEHEADINGS")

 
     (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
                          (fetch
 (PAGEREGION REGIONSPEC) of
 PAGEREGION)))
           (LOCALINFO (fetch
 (PAGEREGION REGIONLOCALINFO) of
 PAGEREGION))
-          HEADINGTEXTOBJ HEADINGSTREAM FORCENEXTPAGE HEADING)
-         (CL:WHEN [AND (for
 FORM inside
 (LISTGET LOCALINFO 'PRECONDITIONS) always
 (EVAL FORM))
-                       (SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
-                                            (LISTGET LOCALINFO 'HEADINGTYPE]
+          (PAGE# (GETPFS FORMATTINGSTATE PAGE#))
+          HEADINGTEXTOBJ HEADINGSTREAM HEADING)
+         (DECLARE
 (SPECVARS PAGE#))
+         (CL:WHEN [SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
+                                       (LISTGET LOCALINFO 'HEADINGTYPE]
 
              (* ;; "Bind the stream to make sure it isn't collected.")

 
              [SETQ HEADINGSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
-                                        `(PARALOOKS ,(PPARALOOKS (fetch
 (SELPIECES SPFIRST)
-                                                                    of
 HEADING]
-             (SETQ HEADINGTEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 HEADINGSTREAM))
+                                        `(PARALOOKS ,(PPARALOOKS (GETSPC HEADING SPFIRST]
+             (SETQ HEADINGTEXTOBJ (GETTSTR HEADINGSTREAM TEXTOBJ))
 
              (* ;; "Insert the heading pieces into HEADINGTEXTOBJ")

 
-             (\TEDIT.INSERTPIECES (fetch
 (SELPIECES SPFIRST) of
 HEADING)
+             (\TEDIT.INSERTPIECES (GETSPC HEADING SPFIRST)
                     (\TEDIT.ALIGNEDPIECE 1 HEADINGTEXTOBJ)
                     HEADINGTEXTOBJ)
 
@@ -968,30 +982,32 @@
 
              (* ;; "Why is BOTTOM said to be the %"top%" of the region to be filled?")

 
-             (bind
 LINE YBOT (BOTTOM _ (fetch
 (REGION BOTTOM) of
 REGION))
-                   (LEN _ (TEXTLEN HEADINGTEXTOBJ))
-                   (CHNO _ 1) while
 (ILESSP CHNO LEN) until
 FORCENEXTPAGE
+             (bind
 LINE YBOT FORCENEXTPAGE (BOTTOM _ (fetch
 (REGION BOTTOM) of
 REGION))
+                   (TEXTLEN _ (TEXTLEN HEADINGTEXTOBJ))
+                   (CHNO _ 1) while
 (ILESSP CHNO TEXTLEN) until
 FORCENEXTPAGE
                 collect
 
 
                       (* ;; "Format the next line from HEADINGTEXTOBJ pieces")

 
-                      (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ HEADINGTEXTOBJ STREAMHINT)
-                                        CHNO NIL REGION PRSTREAM FORMATTINGSTATE))
+                      (SETQ LINE (\TEDIT.FORMATLINE HEADINGSTREAM CHNO NIL REGION PRSTREAM 
+                                        FORMATTINGSTATE))
                       (SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
-                                              (GETLD LINE FORCED-END)))
-                      [SETQ YBOT (COND
-                                    (YBOT                    (* ; 
+                                              (FGETLD LINE FORCED-END)))
+                      [SETQ YBOT (if
 YBOT
+                                     then
                    (* ; 
 
                                                             "Take account of this line's height")

-                                          (IDIFFERENCE YBOT (FGETLD LINE LHEIGHT)))
-                                    (T                       (* ; 
+                                          (IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))
+                                   else
                      (* ; 
 
                                                 "First line:  position it at the top of the region.")

-                                       (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
+                                        (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
                       (SETYBOT LINE YBOT)
                       (SETQ CHNO (FGETLD LINE LCHARLIM))     (* ; "Set the start of the next line")

                       LINE))])
 
 (\TEDIT.FORMATPAGE

-  [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE)
 (* ; "Edited 11-Dec-2024 22:39 by rmk")


+  [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE)
 (* ; "Edited 19-Feb-2025 13:32 by rmk")


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


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


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


                                                              (* ; "Edited 13-Mar-2024 10:28 by rmk")


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


@@ -1036,7 +1052,7 @@
               (SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC)
                                         PC TEXTOBJ))         (* ; 
 
                                                "RMK: Why both 'NEWPAGELAYOUT and :NEW-PAGE-LAYOUT ?")

-              (CL:WHEN (EQ 'NEWPAGELAYOUT (fetch
 (FMTSPEC FMTPARATYPE) of
 NEWPARALOOKS))
+              (CL:WHEN (EQ 'NEWPAGELAYOUT (GETPLOOKS NEWPARALOOKS FMTPARATYPE))
 
                   (* ;; "The first paragra ph on this page starts a new page layout.")

 
@@ -1045,10 +1061,11 @@
                   (* ;; "The first character of the paragraph after the one containing PC:")

 
                   [SETPFS FORMATTINGSTATE CHNO (ADD1 (CAR (\TEDIT.PARA.LAST TEXTOBJ PC]
-                  [SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES

-                                                         (LISTGET (fetch
 (FMTSPEC FMTUSERINFO)
-                                                                     of
 NEWPARALOOKS)
-                                                                'NEWPAGELAYOUT]
+                  [SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES
 (LISTGET
+                                                                                  (GETPLOOKS 
+                                                                                         NEWPARALOOKS
+                                                                                         FMTUSERINFO)
+                                                                                  'NEWPAGELAYOUT]
                   (RETURN))
 
          (* ;; "")

@@ -1128,7 +1145,9 @@
          1])
 
 (\TEDIT.FORMATTEXTBOX

-  [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE)
 (* ; "Edited 11-Dec-2024 22:37 by rmk")


+  [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE)
 (* ; "Edited 19-Feb-2025 13:32 by rmk")


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


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


                                                              (* ; "Edited 24-Nov-2024 11:46 by rmk")


                                                              (* ; "Edited 20-Nov-2024 12:37 by rmk")


                                                              (* ; "Edited 17-Nov-2024 19:16 by rmk")


@@ -1187,7 +1206,7 @@
               (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES FOOTNOTELINES)
                                                              (* ; "Remember any remaining footnotes")

               [SETQ LINES
-               (bind
 LINE FMTSPEC LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE 
+               (bind
 LINE PARALOOKS LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE
                      COLUMN-YBASE (TEXTLEN _ (TEXTLEN TEXTOBJ)) while
 (AND (ILEQ CHNO TEXTLEN)
                                                                            (NOT FORCENEXTPAGE))
                   collect
 (BLOCK) 
@@ -1203,7 +1222,7 @@
                                                      (FGETLD LINE FORCED-END))
                                                  'USERBREAK))
                         (SETQ LHEIGHT (FGETLD LINE LHEIGHT))
-                        (SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
+                        (SETQ PARALOOKS (FGETLD LINE LPARALOOKS))
                         (COND
                            ((FGETLD LINE LMARK)
 
@@ -1211,7 +1230,7 @@
 
                             (SETQ CHNO (FGETLD LINE LCHARLIM))
                             LINE)
-                           ((LISTGET (FGETPARA FMTSPEC FMTUSERINFO)
+                           ((LISTGET (FGETPLOOKS PARALOOKS FMTUSERINFO)
                                    'FOOTNOTE)
 
                             (* ;; "This paragraph is a footnote para.")

@@ -1265,14 +1284,14 @@
                               (* ;; "So that only the first line of a specially-placed paragraph is guaranteed to appear in the current box.")

 
                               [SETQ YBOT (COND
-                                            ((AND (FGETPARA FMTSPEC FMTSPECIALY)
-                                                  (NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY)))
+                                            ((AND (FGETPLOOKS PARALOOKS FMTSPECIALY)
+                                                  (NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALY)))
                                                   (FGETLD LINE 1STLN))
                                                              (* ; 
 
                                      "There is a special Y location for this paragraph.  Move there")

-                                             (SETQ SPECIALYPOS (FGETPARA FMTSPEC FMTSPECIALY)))
+                                             (SETQ SPECIALYPOS (FGETPLOOKS PARALOOKS FMTSPECIALY)))
                                             ((AND COLUMN-YBASE (FGETLD LINE 1STLN)
-                                                  (EQ (FGETPARA FMTSPEC FMTCOLUMN)
+                                                  (EQ (FGETPLOOKS PARALOOKS FMTCOLUMN)
                                                       'NEXT))
 
                                              (* ;; 
@@ -1283,20 +1302,22 @@
 
                                  (* ;; "We're into it;  take account of this line's height. Original code did the complicated LHEIGHT calculation and threw it away.  I assume that that was an error, that the new setting of LHEIGHT is for the benefit of the new YBOT value (which I pulled out of an alternative branch of a COND.")

 
-                                                  (CL:WHEN (FGETPARA FMTSPEC FMTBASETOBASE)
+                                                  (CL:WHEN (FGETPLOOKS PARALOOKS FMTBASETOBASE)
                                                       [SETQ LHEIGHT
                                                        (IPLUS (FGETLD LINE LDESCENT)
-                                                              (FGETPARA FMTSPEC FMTBASETOBASE)
+                                                              (FGETPLOOKS PARALOOKS FMTBASETOBASE)
                                                               (COND
                                                                  ((FGETLD LINE 1STLN)
-                                                                  (IPLUS (FGETPARA FMTSPEC LEADBEFORE
-                                                                                )
-                                                                         (FGETPARA (GETLD PREVLINE 
-                                                                                          LFMTSPEC)
+                                                                  (IPLUS (FGETPLOOKS PARALOOKS 
+                                                                                LEADBEFORE)
+                                                                         (FGETPLOOKS (GETLD PREVLINE
+                                                                                            
+                                                                                           LPARALOOKS
+                                                                                            )
                                                                                 LEADAFTER)))
                                                                  (T 0])
                                                   (COND
-                                                     ((\FIRST-COLUMN-START LINE FMTSPEC)
+                                                     ((\FIRST-COLUMN-START LINE PARALOOKS)
                                                       (IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT)
                                                              LHEIGHT))
                                                      (T (IDIFFERENCE YBOT LHEIGHT]
@@ -1315,7 +1336,7 @@
                                   NIL)
                                  ((AND (NOT FIRSTLINE)
                                        (FGETLD LINE 1STLN)
-                                       (SETQ NEWPAGETYPE (OR (FGETPARA (FGETLD LINE LFMTSPEC)
+                                       (SETQ NEWPAGETYPE (OR (FGETPLOOKS (FGETLD LINE LPARALOOKS)
                                                                     FMTNEWPAGEBEFORE)
                                                              BREAKAFTERLASTPARA)))
 
@@ -1332,7 +1353,7 @@
                                       (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE NEWPAGETYPE))
                                   NIL)
                                  (T                          (* ; "This line is good;  use it.")

-                                    (CL:WHEN (AND (FGETPARA FMTSPEC FMTNEWPAGEAFTER))
+                                    (CL:WHEN (AND (FGETPLOOKS PARALOOKS FMTNEWPAGEAFTER))
                                                              (* ; 
 
   "We're supposed to put the line after this one at the start of a new page/column (any box, later)")

                                         (SETQ BREAKAFTERLASTPARA T))
@@ -1340,7 +1361,7 @@
                                                                 (IMIN PRIOR-COLUMN-YBOT YBOT)
                                                                 YBOT))
                                     (SETYBOT LINE YBOT)
-                                    (CL:WHEN (\FIRST-COLUMN-START LINE FMTSPEC)
+                                    (CL:WHEN (\FIRST-COLUMN-START LINE PARALOOKS)
 
                                    (* ;; "This is the start of a new group of paragraphs to be lined up in columns.  Save the YBASE for these guys for the other columns.")

 
@@ -1358,7 +1379,9 @@
                      TEXTOBJ FORMATTINGSTATE FINAL-CHNO)))])
 
 (\TEDIT.FORMATFOLIO

-  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)
      (* ; "Edited 24-Nov-2024 11:46 by rmk")


+  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)
      (* ; "Edited  9-Jan-2025 21:52 by rmk")


+                                                             (* ; "Edited  3-Jan-2025 14:28 by rmk")


+                                                             (* ; "Edited 24-Nov-2024 11:46 by rmk")


                                                              (* ; "Edited 20-Nov-2024 12:37 by rmk")


                                                              (* ; "Edited 17-Nov-2024 19:16 by rmk")


                                                              (* ; "Edited 26-Oct-2024 10:46 by rmk")


@@ -1378,7 +1401,8 @@
     (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
                          (fetch
 (PAGEREGION REGIONSPEC) of
 PAGEREGION)))
           (FOLIOINFO (fetch
 (PAGEREGION REGIONLOCALINFO) of
 PAGEREGION))
-          FOLIOSTREAM FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
+          FOLIOSTREAM PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
+         (DECLARE
 (SPECVARS PAGE#))
          (CL:UNLESS (AND (GETPFS FORMATTINGSTATE FIRSTPAGE)
                          (LISTGET FOLIOINFO 'NOFIRSTPAGE))   (* ; 
 
       "If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")

@@ -1404,29 +1428,25 @@
                                       `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
                                               LOOKS
                                               ,(LISTGET FOLIOINFO 'CHARLOOKS]
-             (SETQ FOLIOTEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 FOLIOSTREAM))
              (TEDIT.INSERT FOLIOSTREAM (CONCAT PRETEXT PAGE# POSTTEXT)
                     1 NIL T)
-             (bind
 LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ))
+             (bind
 LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN (GETTSTR FOLIOSTREAM TEXTOBJ)))
                    (BOTTOM _ (fetch
 (REGION BOTTOM) of
 REGION))
                    (CHNO _ 1) while
 (ILEQ CHNO TEXTLEN) until
 FORCENEXTPAGE
-                collect
 (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ FOLIOTEXTOBJ STREAMHINT)
-                                          CHNO NIL REGION PRSTREAM FORMATTINGSTATE))
+                collect
 (SETQ LINE (\TEDIT.FORMATLINE FOLIOSTREAM CHNO NIL REGION PRSTREAM 
+                                          FORMATTINGSTATE))
                       (SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
-                                              (GETLD LINE FORCED-END))) 
+                                              (FGETLD LINE FORCED-END))) 
                                                              (* ; "Format the next possible line")

-                      (SETQ CHNO (FGETLD LINE LCHARLIM))     (* ; 
-
                                                             "Keep track of the next character...")

-                      [SETQ YBOT (COND
-                                    (YBOT                    (* ; 
-
                                                 "We're into it;  take account of this line's height")

-                                          (IDIFFERENCE YBOT (FGETLD LINE LHEIGHT)))
-                                    (T                       (* ; 
-
   "Just starting out;  find the line's position with respect to the top of the region to be filled.")

-                                       (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
-                      (CL:WHEN (ILESSP YBOT (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT)))
-                             (GO $$ITERATE))
+                      [SETQ YBOT (if
 YBOT
+                                     then
                    (* ; 
+
                                                             " Take account of this line's height")

+                                          (IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))
+                                   else
                      (* ; 
+
                                                 "First line:  position it at the top of the region.")

+                                        (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
                       (SETYBOT LINE YBOT)                    (* ; "This line is still good")

+                      (SETQ CHNO (FGETLD LINE LCHARLIM))     (* ; "Set the start of the next line")

                       LINE))])
 
 (\TEDIT.FORMAT.FOUNDBOX?

@@ -1461,7 +1481,8 @@
         T])
 
 (\TEDIT.SKIP.SPECIALCOND

-  [LAMBDA (TSTREAM LINE PARALOOKS CHNO)
                      (* ; "Edited 20-Nov-2024 12:37 by rmk")


+  [LAMBDA (TSTREAM LINE PARALOOKS CHNO)
                      (* ; "Edited 19-Feb-2025 13:32 by rmk")


+                                                             (* ; "Edited 20-Nov-2024 12:37 by rmk")


                                                              (* ; "Edited 17-Nov-2024 19:35 by rmk")


                                                              (* ; "Edited 26-Oct-2024 10:27 by rmk")


                                                              (* ; "Edited  5-Jul-2023 14:19 by rmk")


@@ -1480,11 +1501,11 @@
     (FSETLD LINE LDESCENT 0)
     (FSETLD LINE LTRUEASCENT 0)
     (FSETLD LINE LTRUEDESCENT 0)
-    (FSETLD LINE LCHARLIM (IPLUS CHNO (for
 PC (HEADINGTYPE _ (GETPARA PARALOOKS FMTPARASUBTYPE))
+    (FSETLD LINE LCHARLIM (IPLUS CHNO (for
 PC (HEADINGTYPE _ (GETPLOOKS PARALOOKS FMTPARASUBTYPE))
                                          inpieces
 (fetch
 (TEXTSTREAM PIECE) of
 TSTREAM)
-                                         while
 (AND (EQ 'PAGEHEADING (GETPARA (PPARALOOKS PC)
+                                         while
 (AND (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS PC)
                                                                             FMTPARATYPE))
-                                                    (EQ HEADINGTYPE (GETPARA (PPARALOOKS PC)
+                                                    (EQ HEADINGTYPE (GETPLOOKS (PPARALOOKS PC)
                                                                            FMTPARASUBTYPE)))
                                          sum
 (PLEN PC])
 )
@@ -1496,27 +1517,33 @@
 (DEFINEQ
 
 (\TEDIT.HARDCOPY.PAGEHEADINGS

-  [LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE)
                     (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE)
                     (* ; "Edited 19-Feb-2025 13:32 by rmk")


+                                                             (* ; "Edited 12-Jan-2025 17:31 by rmk")


+                                                             (* ; "Edited 10-Jan-2025 15:42 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


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


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


                                                              (* ; "Edited  9-May-2023 17:46 by rmk")


                                                              (* ; "Edited  7-May-2023 23:45 by rmk")


                                                              (* ; "Edited  9-Oct-2022 17:12 by rmk")

 
-    (* ;; "This runs thru all the headings starting at CHNO, copying the pieces of the different heading types into FORMATTINGSTATE, and returning the  starting CHNO of the first non-heading piece.  ")

+    (* ;; "This runs thru all the headings starting at CHNO in TEXTOBJ, copying the pieces of the different heading types into SELPIECES in FORMATTINGSTATE, and returning the  starting CHNO of the first non-heading piece.  ")

 
     (CL:UNLESS FORMATTINGSTATE                               (* ; 
 
                                                     "If it isn't there, we would loose the headings")

         (\TEDIT.THELP "NIL FORMATTINGSTATE"))
     (bind
 HEADINGSUBTYPE (PC _ (\TEDIT.CHTOPC CHNO TEXTOBJ))
-       while
 [AND PC (EQ 'PAGEHEADING (fetch
 FMTPARATYPE of
 (PPARALOOKS PC]
-       do
 (SETQ HEADINGSUBTYPE (fetch
 FMTPARASUBTYPE of
 (PPARALOOKS PC)))
-          (for
 P (START _ CHNO) inpieces
 PC while
 [AND (EQ 'PAGEHEADING (fetch
 FMTPARATYPE
-                                                                           of
 (PPARALOOKS P)))
-                                                       (EQ HEADINGSUBTYPE (fetch
 FMTPARASUBTYPE
-                                                                             of
 (PPARALOOKS P]
+       while
 (AND PC (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS PC)
+                                             FMTPARATYPE)))
+       do
 (SETQ HEADINGSUBTYPE (GETPLOOKS (PPARALOOKS PC)
+                                      FMTPARASUBTYPE))
+          (for
 P (START _ CHNO) inpieces
 PC while
 (AND (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS P)
+                                                                               FMTPARATYPE))
+                                                       (EQ HEADINGSUBTYPE (GETPLOOKS (PPARALOOKS
+                                                                                      P)
+                                                                                 FMTPARASUBTYPE)))
              do
 
-                (* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the piecerange")

+                (* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the selpieces")

 
                 (add
 CHNO (PLEN P)) finally
 (LISTPUT (fetch
 PAGEHEADINGS of
 FORMATTINGSTATE)
                                                    HEADINGSUBTYPE
@@ -1527,6 +1554,30 @@
 
                                          "Set PC to continue looking for the next headingtype.")

 
                                           (SETQ PC P)))
+
+    (* ;; "For backward compatibility, this uses the information in the pageformat to create SELPIECES covering the pretext, pageno, and posttest, where the pageno is produced by the PAGENO image object.  We create a scratch textstream so that we can use the standard TEDIT.INSERT and TEDIT.INSERT.OBJECT, then throw it away.  This only happens once, when this heading is encountered, even if the pieces are rendered on multiple pages.")

+
+    [LET ((FOLIOINFO (fetch
 (PAGEREGION REGIONLOCALINFO) of
 PAGEREGION))
+          INFOLIST FOLIOSTREAM FOLIOTEXTOBJ)
+
+         (* ;; "Have to set the SPECIALX and SPECIALY according to the PX and PY. And PQUAD")

+
+         (CL:WHEN FOLIOINFO
+             (SETQ INFOLIST (LISTGET FOLIOINFO 'FORMATINFO))
+             [SETQ FOLIOSTREAM (OPENTEXTSTREAM NIL NIL `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
+                                                               LOOKS
+                                                               ,(LISTGET FOLIOINFO 'CHARLOOKS]
+             (SETQ FOLIOTEXTOBJ (GETTSTR FOLIOSTREAM TEXTOBJ))
+             (CL:WHEN (CADR INFOLIST)
+                 (TEDIT.INSERT FOLIOSTREAM (MKSTRING (CADR INFOLIST))))
+             (TEDIT.INSERT.OBJECT (TEDIT.PAGENO.CREATE
 (CAR INFOLIST))
+                    FOLIOSTREAM)
+             (CL:WHEN (CADDR INFOLIST)
+                 (TEDIT.INSERT FOLIOSTREAM (MKSTRING (CADDR INFOLIST))))
+             (LISTPUT (fetch
 PAGEHEADINGS of
 FORMATTINGSTATE)
+                    '\TEDIT.PAGENO
+                    (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES 1 (TEXTLEN FOLIOTEXTOBJ)
+                                                  FOLIOTEXTOBJ))))]
     CHNO])
 )
 
@@ -1538,7 +1589,9 @@
 
 (\TEDIT.HARDCOPY-COLUMN-END

   [LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE 
-                 FINAL-CHNO DONT-KEEP-SINGLE-LINE)
           (* ; "Edited 11-Dec-2024 20:52 by rmk")


+                 FINAL-CHNO DONT-KEEP-SINGLE-LINE)
           (* ; "Edited 19-Feb-2025 13:32 by rmk")


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


+                                                             (* ; "Edited 11-Dec-2024 20:52 by rmk")


                                                              (* ; "Edited 24-Nov-2024 11:46 by rmk")


                                                              (* ; "Edited 20-Nov-2024 12:37 by rmk")


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


@@ -1601,23 +1654,24 @@
                                              LCHARLIM))]
                 ([AND (NEQ FORCENEXTPAGE 'USERBREAK)
                       (ILEQ CHNO (TEXTLEN TEXTOBJ))
-                      (OR (GETPARA (GETLD LASTLINE LFMTSPEC)
+                      (OR (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
                                  FMTHEADINGKEEP)
-                          (AND (GETPARA (GETLD LASTLINE LFMTSPEC)
+                          (AND (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
                                       FMTKEEP)
                                (NOT (GETLD LASTLINE LSTLN]
 
                  (* ;; "Only do widow/orphan detection if this is NOT a page break the user asked for.  And this isn't the end of the document.")

 
-                 (for
 LASTLINE in
 (REVERSE LINES) while
 [OR (GETPARA (GETLD LASTLINE LFMTSPEC)
+                 (for
 LASTLINE in
 (REVERSE LINES) while
 [OR (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
                                                                    FMTHEADINGKEEP)
-                                                            (AND (GETPARA (GETLD LASTLINE LFMTSPEC)
+                                                            (AND (GETPLOOKS (GETLD LASTLINE 
+                                                                                   LPARALOOKS)
                                                                         FMTKEEP)
                                                                  (NOT (GETLD LASTLINE LSTLN]
                     do
 
                        (* ;; "Run thru, removing any trailing headings.  However, assure that there's at least one line on a page.")

  finally
 (COND
-            ((AND LASTLINE (AND (NOT (GETPARA (GETLD LASTLINE LFMTSPEC)
+            ((AND LASTLINE (AND (NOT (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
                                             FMTHEADINGKEEP))
                                 (GETLD LASTLINE LSTLN)))
 
@@ -1850,6 +1904,141 @@
 
 
 
+(* ; "Page number image obj")

+
+(DEFINEQ
+
+(TEDIT.PAGENO.CREATE

+  [LAMBDA (FORMAT)
                                           (* ; "Edited  7-Jan-2025 14:14 by rmk")


+                                                             (* ; "Edited  3-Jan-2025 14:44 by rmk")

+    (LET ((OBJ (IMAGEOBJCREATE NIL TEDIT.PAGENOOBJ.IMAGEFNS)))
+         (IMAGEOBJPROP OBJ 'FORMAT (OR FORMAT 'ARABIC))
+         OBJ])
+
+(\TEDIT.PAGENO.OBJINIT

+  [LAMBDA NIL
                                                (* ; "Edited  7-Jan-2025 22:54 by rmk")


+                                                             (* ; "Edited  3-Jan-2025 15:01 by rmk")

+                                                             (* jds " 9-Feb-86 15:17")

+
+    (* ;; "Initialize the IMAGEFNS for a page-number image object")

+
+    (DECLARE
 (GLOBALVARS TEDIT.PAGENOOBJ.IMAGEFNS))
+    (SETQ TEDIT.PAGENOOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEDIT.PAGENO.DISPLAYFN)
+                                          (FUNCTION \TEDIT.PAGENO.IMAGEBOXFN)
+                                          (FUNCTION \TEDIT.PAGENO.PUTBOXFN)
+                                          (FUNCTION \TEDIT.PAGENO.GETFN)
+                                          [FUNCTION (LAMBDA (OBJ)
+                                                      (create
 IMAGEOBJ copying
 OBJ]
+                                          (FUNCTION \TEDIT.PAGENO.BUTTONEVENTINFN)
+                                          'NILL
+                                          'NILL
+                                          'NILL
+                                          'NILL
+                                          'NILL NIL 'NILL 'PageNumber])
+
+(\TEDIT.PAGENO.BUTTONEVENTINFN

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

+                                                             (* ; "Edited  3-Jan-2025 14:32 by rmk")


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

+
+    (* ;; "Allow the user to change the page-number printed format.")

+
+(* ;;; "the user has pressed a button inside the bitmap object IMAGEOBJ.  Bring up a menu of bitmap edit operations.")

+
+    (CL:WHEN (AND (EQ BUTTON 'LEFT)
+                  (EQ OPERATION 'NORMAL))
+        (LET (FORMAT)
+             [SETQ FORMAT (MENU (create
 MENU
+                                       ITEMS _ '((Arabic 'ARABIC)
+                                                 ("Lower Roman" 'LOWERROMAN)
+                                                 (" Upper Roman" 'UPPERROMAN]
+             (CL:WHEN [AND FORMAT (NEQ FORMAT (IMAGEOBJPROP IMAGEOBJ 'FORMAT]
+                 (IMAGEOBJPROP IMAGEOBJ 'FORMAT FORMAT)
+                 'CHANGED)))])
+
+(\TEDIT.PAGENO.IMAGEBOXFN

+  [LAMBDA (OBJ IMAGESTREAM)
                                  (* ; "Edited  3-Jan-2025 14:30 by rmk")


+                                                             (* ; "Edited 26-Aug-2024 09:36 by rmk")


+                                                             (* ; "Edited  3-Aug-2024 13:10 by rmk")


+                                                             (* ; "Edited 19-Jul-2024 23:26 by rmk")


+                                                             (* ; "Edited 11-Oct-2022 22:51 by rmk")


+                                                             (* ; "Edited  4-Oct-2022 11:59 by rmk")

+
+    (* ;; "Creates the box for a page number, a place holder on the display, otherwise the properly formatted number.  Looks come from the font.")

+
+    (* ;; 
+
    "Create the box for a menu button containing LABEL in font FONT on STREAM (NIL means display).")

+
+    (DECLARE
 (USEDFREE PAGE#))
+    (LET ((FONT (DSPFONT NIL IMAGESTREAM))
+          (FORMAT (IMAGEOBJPROP OBJ 'FORMAT))
+          YSIZE XSIZE)
+         (SETQ YSIZE (FONTPROP FONT 'HEIGHT))
+         (SETQ XSIZE (STRINGWIDTH (if
 (DISPLAYSTREAMP IMAGESTREAM)
+                                      then
 (CONCAT "[P#" (SELECTQ FORMAT
+                                                             (SELECTQ FORMAT
+                                                                 (LOWERROMAN "x")
+                                                                 (UPPERROMAN "X")
+                                                                 (MKSTRING "1")))
+                                                  "]")
+                                    else
 (SELECTQ FORMAT
+                                             (LOWERROMAN (ROMANNUMERALS
 PAGE#))
+                                             (UPPERROMAN (ROMANNUMERALS
 PAGE# T))
+                                             (MKSTRING PAGE#)))
+                            FONT))
+         (create
 IMAGEBOX
+                XSIZE _ XSIZE
+                YSIZE _ YSIZE
+                YDESC _ 0
+                XKERN _ 0])
+
+(\TEDIT.PAGENO.DISPLAYFN

+  [LAMBDA (OBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM)
       (* ; "Edited  3-Jan-2025 14:30 by rmk")


+                                                             (* ; "Edited 26-Aug-2024 09:36 by rmk")


+                                                             (* ; "Edited  3-Aug-2024 13:10 by rmk")


+                                                             (* ; "Edited 19-Jul-2024 23:26 by rmk")


+                                                             (* ; "Edited 11-Oct-2022 22:51 by rmk")


+                                                             (* ; "Edited  4-Oct-2022 11:59 by rmk")

+                                                             (* jds "30-Aug-84 11:24")

+
+    (* ;; "Display the page number on IMAGESTREAM, a place holder for display, otherwise a formatted number.  Looks come from the font.")

+
+    (DECLARE
 (USEDFREE PAGE#))
+    (LET [(FORMAT (IMAGEOBJPROP OBJ 'FORMAT]
+         (PRIN3 (if
 (DISPLAYSTREAMP IMAGESTREAM)
+                    then
 (CONCAT "[P#" (SELECTQ FORMAT
+                                           (SELECTQ FORMAT
+                                               (LOWERROMAN "x")
+                                               (UPPERROMAN "X")
+                                               (MKSTRING "1")))
+                                "]")
+                  else
 (SELECTQ FORMAT
+                           (LOWERROMAN (ROMANNUMERALS
 PAGE#))
+                           (UPPERROMAN (ROMANNUMERALS
 PAGE# T))
+                           (MKSTRING PAGE#)))
+                IMAGESTREAM])
+
+(\TEDIT.PAGENO.GETFN

+  [LAMBDA (FILESTREAM)
                                       (* ; "Edited  3-Jan-2025 14:13 by rmk")

+    (LET ((X (READ FILESTREAM (FIND-READTABLE "INTERLISP" T)))
+          OBJ)
+         (SETQ OBJ (IMAGEOBJCREATE (CAR X)
+                          PAGENOOBJ.IMAGEFNS))
+         (replace
 (IMAGEOBJ IMAGEOBJPLIST) of
 OBJ with
 (CDR X))
+         OBJ])
+
+(\TEDIT.PAGENO.PUTFN

+  [LAMBDA (OBJ FILESTREAM)
                                   (* ; "Edited  3-Jan-2025 15:01 by rmk")

+    (PRINT (CONS (fetch
 (IMAGEOBJ OBJECTDATUM) of
 OBJ)
+                 (fetch
 (IMAGEOBJ IMAGEOBJPLIST) of
 OBJ))
+           FILESTREAM
+           (FIND-READTABLE "INTERLISP"])
+)
+
+(\TEDIT.PAGENO.OBJINIT
)
+
+
+
 (* ;; "Foot note support")

 
 (DEFINEQ
@@ -1895,15 +2084,18 @@
                         (RETURN (DREMOVE NIL $$VAL])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (11801 15413 (\TEDIT.PARSE.PAGEFRAMES 11811 . 13590) (\TEDIT.PUT.PAGEFRAMES 13592 . 
-14416) (\TEDIT.UNPARSE.PAGEFRAMES 14418 . 15411)) (15476 36629 (TEDIT.SINGLE.PAGEFORMAT 15486 . 25615)
- (TEDIT.COMPOUND.PAGEFORMAT 25617 . 26596) (TEDIT.PAGEFORMAT 26598 . 33887) (TEDIT.GET.PAGEFORMAT 
-33889 . 36627)) (36916 47418 (TEDIT.FORMAT.HARDCOPY 36926 . 47416)) (47505 98986 (\TEDIT.FORMATBOX 
-47515 . 60618) (\TEDIT.FORMATHEADING 60620 . 65142) (\TEDIT.FORMATPAGE 65144 . 73674) (
-\TEDIT.FORMATTEXTBOX 73676 . 89600) (\TEDIT.FORMATFOLIO 89602 . 94956) (\TEDIT.FORMAT.FOUNDBOX? 94958
- . 96997) (\TEDIT.SKIP.SPECIALCOND 96999 . 98984)) (99066 101596 (\TEDIT.HARDCOPY.PAGEHEADINGS 99076
- . 101594)) (101705 109434 (\TEDIT.HARDCOPY-COLUMN-END 101715 . 109432)) (109479 114420 (
-SCALEPAGEUNITS 109489 . 110630) (SCALEPAGEXUNITS 110632 . 111402) (SCALEPAGEYUNITS 111404 . 112175) (
-\TEDIT.PAPERHEIGHT 112177 . 113112) (\TEDIT.PAPERWIDTH 113114 . 114418)) (114836 118404 (ROMANNUMERALS
- 114846 . 118402)) (118440 121343 (\TEDIT.FORMAT.FOOTNOTE 118450 . 121341)))))
+  (FILEMAP (NIL (12098 15710 (\TEDIT.PARSE.PAGEFRAMES 12108 . 13887) (\TEDIT.PUT.PAGEFRAMES 13889 . 
+14713) (\TEDIT.UNPARSE.PAGEFRAMES 14715 . 15708)) (15773 37671 (TEDIT.SINGLE.PAGEFORMAT 15783 . 26657)
+ (TEDIT.COMPOUND.PAGEFORMAT 26659 . 27638) (TEDIT.PAGEFORMAT 27640 . 34929) (TEDIT.GET.PAGEFORMAT 
+34931 . 37669)) (37958 48639 (TEDIT.FORMAT.HARDCOPY 37968 . 48637)) (48726 101203 (\TEDIT.FORMATBOX 
+48736 . 61839) (\TEDIT.FORMATHEADING 61841 . 66487) (\TEDIT.FORMATPAGE 66489 . 75356) (
+\TEDIT.FORMATTEXTBOX 75358 . 91739) (\TEDIT.FORMATFOLIO 91741 . 97058) (\TEDIT.FORMAT.FOUNDBOX? 97060
+ . 99099) (\TEDIT.SKIP.SPECIALCOND 99101 . 101201)) (101283 105992 (\TEDIT.HARDCOPY.PAGEHEADINGS 
+101293 . 105990)) (106101 114152 (\TEDIT.HARDCOPY-COLUMN-END 106111 . 114150)) (114197 119138 (
+SCALEPAGEUNITS 114207 . 115348) (SCALEPAGEXUNITS 115350 . 116120) (SCALEPAGEYUNITS 116122 . 116893) (
+\TEDIT.PAPERHEIGHT 116895 . 117830) (\TEDIT.PAPERWIDTH 117832 . 119136)) (119554 123122 (ROMANNUMERALS
+ 119564 . 123120)) (123161 130427 (TEDIT.PAGENO.CREATE 123171 . 123547) (\TEDIT.PAGENO.OBJINIT 123549
+ . 124832) (\TEDIT.PAGENO.BUTTONEVENTINFN 124834 . 125900) (\TEDIT.PAGENO.IMAGEBOXFN 125902 . 128052) 
+(\TEDIT.PAGENO.DISPLAYFN 128054 . 129704) (\TEDIT.PAGENO.GETFN 129706 . 130098) (\TEDIT.PAGENO.PUTFN 
+130100 . 130425)) (130492 133395 (\TEDIT.FORMAT.FOOTNOTE 130502 . 133393)))))
 STOP

library/tedit/TEDIT-PCTREE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243
 67795  
+
(FILECREATED " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248
 68998  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.DELETEPIECES)
+      :CHANGES-TO (FNS \TEDIT.MAKEPCTB)
 
-      :PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
+      :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,7 +274,8 @@
                     DELTA])
 
 (\TEDIT.FIRSTPIECE

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 21-Aug-2024 16:07 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")

@@ -285,7 +288,7 @@
 
                                  (* ;; "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

@@ -383,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")


@@ -421,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")


@@ -435,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.")

 
@@ -447,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)
@@ -463,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)))
@@ -628,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)   (* ; 
@@ -651,7 +656,8 @@
          NEW])
 
 (\TEDIT.UNLINKPIECE

-  [LAMBDA (PREV PC TEXTOBJ)
                                  (* ; "Edited 21-Oct-2024 00:26 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")

 
@@ -661,7 +667,7 @@
     (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 21-Oct-2024 00:33 by rmk")


@@ -732,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")


@@ -741,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)
@@ -785,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")


@@ -803,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. ")

@@ -819,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))
@@ -827,7 +835,8 @@
     PIECES])
 
 (\TEDIT.DELETEPIECES

-  [LAMBDA (SELPIECES TEXTOBJ)
                                (* ; "Edited 26-Nov-2024 10:50 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")


@@ -840,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.")

 
@@ -851,7 +860,7 @@
                             (SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST))) 
                                                              (* ; "For incremental chain-update")

                             (SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
-                                           (FGETTOBJ TEXTOBJ LASTPIECE)))
+                                           (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
                             (FSETTOBJ TEXTOBJ \DIRTY T) inselpieces
 SELPIECES
        do
 (UNINTERRUPTABLY
               (\TEDIT.UPDATEPCNODES
 PC (IMINUS (PLEN PC))
@@ -875,7 +884,8 @@
     (\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")


@@ -890,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)
@@ -956,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))
@@ -989,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")


@@ -999,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)
@@ -1098,13 +1110,13 @@
 (GLOBALVARS BTVALIDATETAGS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
-\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) (
-\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) (
-\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE 
-36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) (
-\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 . 
-53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) (
-\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729
- . 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670)))))
+  (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-SELECTION

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Dec-2024 14:29:31" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;638
 151180 
+
(FILECREATED "19-Mar-2025 16:27:02" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;674
 154655 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.XYTOSEL)
+      :CHANGES-TO (FNS \TEDIT.SELPIECES.COPY \TEDIT.SELPIECES \TEDIT.RESET.EXTEND.PENDING.DELETE)
+                  (I.S.OPRS inselpieces)
 
-      :PREVIOUS-DATE " 6-Dec-2024 12:50:42" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;637)
+      :PREVIOUS-DATE "16-Mar-2025 10:06:15" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;665)
 
 
 (PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
@@ -442,13 +443,13 @@
                (add
 START-OF-PIECE (PLEN PC])
 
 (\TEDIT.WORD.BOUND

-  [LAMBDA (TEXTOBJ PREVCH CH)
                                (* ; "Edited 16-Jul-2024 19:52 by rmk")


+  [LAMBDA (TEXTOBJ PREVCH CH)
                                (* ; "Edited 13-Mar-2025 21:41 by rmk")


+                                                             (* ; "Edited 16-Jul-2024 19:52 by rmk")


                                                              (* ; "Edited 27-Sep-2022 23:54 by rmk")


-                                                             (* ; "Edited 25-Sep-2022 23:48 by rmk")


-                                                             (* ; "Edited 30-May-91 23:02 by jds")

+                                                             (* ; "Edited 25-Sep-2022 23:48 by rmk")

     (if
 (AND (FIXP PREVCH)
              (FIXP CH))
-        then
 (LET [(READSA (fetch
 READSA of
 (OR (fetch
 (TEXTOBJ TXTWTBL) of
 TEXTOBJ)
+        then
 (LET [(READSA (fetch
 READSA of
 (OR (GETTOBJ TEXTOBJ TXTWTBL)
                                                 TEDIT.WORDBOUND.READTABLE]
                   (NEQ (\SYNCODE READSA PREVCH)
                        (\SYNCODE READSA CH)))
@@ -569,15 +570,13 @@
              (\TEDIT.FIXSEL
 CURSEL TEXTOBJ)))])
 
 (\TEDIT.SCAN.LINE

-  [LAMBDA (LINE X Y NEWSEL SELOPERATION PANE BUTTON WORDSELFLG)

+  [LAMBDA (LINE X NEWSEL SELOPERATION TEXTOBJ BUTTON WORDSELFLG)

+                                                             (* ; "Edited 18-Feb-2025 22:04 by rmk")


+                                                             (* ; "Edited 14-Feb-2025 09:47 by rmk")


+                                                             (* ; "Edited  3-Feb-2025 09:31 by rmk")


                                                              (* ; "Edited  6-Dec-2024 11:06 by rmk")


-                                                             (* ; "Edited  4-Dec-2024 12:06 by rmk")


                                                              (* ; "Edited 30-Nov-2024 09:52 by rmk")


-                                                             (* ; "Edited 28-Nov-2024 11:54 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:07 by rmk")


-                                                             (* ; "Edited 18-Oct-2024 22:42 by rmk")


-                                                             (* ; "Edited 17-Oct-2024 21:47 by rmk")


-                                                             (* ; "Edited  3-Oct-2024 23:31 by rmk")


                                                              (* ; "Edited  6-Sep-2024 00:07 by rmk")


                                                              (* ; "Edited  1-Aug-2024 17:13 by rmk")


                                                              (* ; "Edited 20-Jun-2024 11:36 by rmk")


@@ -588,26 +587,24 @@
                                                              (* ; "Edited  9-Apr-2023 18:21 by rmk")


                                                              (* ; "Edited 31-May-91 12:26 by jds")

 
-    (* ;; "Given that LINE meets the mouse-Y criterion, find the selection picked out by the mouse X  coordinate.  This may run to the right if the mouse-position is protected. This also expands to word selection in the current line, avoiding protected characters.")

+    (* ;; "Find the selection in LINE picked out by the mouse X  coordinate.  This may run to the right if the mouse-position is protected. This also expands to word selection in the current line, avoiding protected characters.")

 
     (* ;; "")

 
     (* ;; "Earlier versions had more complexity because it not ony figured out the character pointed at but also %"fixed%" the selection on the fly to avoid the more generic \TEDIT.FIXLINE.The generic fixline would scan through the lines of a tall window to find the line containing the selected CH#, and then apply \TEDIT.CHTOX to scan its (presumably cached) THISLINE to set up the X0 and XLIM. But not a noticeable delay for user interaction--not worth the complexity.")

 
-    (* ;; "The button pressed on an image object is decoded from the EXTENDFLG and WORDFLG.")

-
+    (LINEDESCRIPTOR! LINE)
+    (TEXTOBJ! TEXTOBJ)
     (SELECTION! NEWSEL)
     (FSETSEL NEWSEL SET NIL)
-    (PROG ((TSTREAM (PANESTREAM PANE))
-           (TEXTOBJ (PANETOBJ PANE))
-           CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED)
+    (PROG (CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED)
           (SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE))
           (CL:UNLESS (EQ LINE (fetch
 DESC of
 THISLINE))      (* ; 
 
                                                            "Make sure the cache describes this line")

-              (SETQ LINE (\TEDIT.FORMATLINE TSTREAM (GETLD LINE LCHAR1)
+              (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
                                 LINE)))                      (* ; 
 
                                                          "Convert X's display units to LINE's scale")

-          (SETQ XLIM (GETLD LINE LX1))                       (* ; 
+          (SETQ XLIM (FGETLD LINE LX1))                      (* ; 
 
                                                 "Pretend the %"last%" character ended at the margin")

           (SETQ X (IMAX X XLIM))
           (SETQ CHNO (FGETLD LINE LCHAR1))
@@ -617,11 +614,11 @@
      (* ;; "Step 1:  Find the slot, character number, and ending TX for the character at the incoming mouse X position. ")

 
           (CL:WHEN (SETQ PASTRIGHT (IGREATERP X (FGETLD LINE LXLIM)))
-                                                             (* ; 
-
                                "If not more than 20 past the end, put it inside the last character.")

-              (CL:WHEN (IGREATERP (IDIFFERENCE X (FGETLD LINE LXLIM))
-                              30)
-                     (RETURN NIL))
+                                                             (* (* ; 
+
                                "If not more than 30 past the end, put it inside the last character.")
+
                                                             (CL:WHEN (IGREATERP (IDIFFERENCE X
+
                                                             (FGETLD LINE LXLIM)) 30)
+
                                                             (RETURN NIL)))

               (SETQ X (SUB1 (FGETLD LINE LXLIM))))
           [SETQ CHARSLOT (for
 CS incharslots
 THISLINE
                             do
 (if
 CHAR
@@ -708,11 +705,18 @@
                  (FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL]
           (FSETSEL NEWSEL CHLIM (IPLUS (FGETSEL NEWSEL CH#)
                                        (FGETSEL NEWSEL DCH)))
-          (FSETSEL NEWSEL POINT (if
 [OR PASTRIGHT (EQ MOVED 'BACKWARD)
-                                        (AND (IGEQ (CHARW CHARSLOT)
-                                                   3)
-                                             (IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT)
-                                                                              2]
+          (FSETSEL NEWSEL POINT (if
 (EQ (CHARCODE EOL)
+                                        (CHAR CHARSLOT))
+                                    then
 
+                                         (* ;; 
+
                                        "Always go to the left of an EOL, so caret stays on its line")

+
+                                         'LEFT
+                                  elseif
 [OR PASTRIGHT (EQ MOVED 'BACKWARD)
+                                             (AND (IGEQ (CHARW CHARSLOT)
+                                                        3)
+                                                  (IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT)
+                                                                                   2]
                                     then
 
                                          (* ;; 
 
                 "Beyond the line, or towards the end of a character that is at least 3 points wide.")

@@ -831,6 +835,7 @@
 
 (\TEDIT.XYTOSEL

   [LAMBDA (X Y NEWSEL TEXTOBJ SELOPERATION PANE BUTTON CURSEL REGIONTYPE)

+                                                             (* ; "Edited 13-Feb-2025 11:03 by rmk")


                                                              (* ; "Edited 17-Dec-2024 10:10 by rmk")


                                                              (* ; "Edited  6-Dec-2024 12:00 by rmk")


                                                              (* ; "Edited 30-Nov-2024 14:15 by rmk")


@@ -867,7 +872,7 @@
 
              "Y is below the last line of the text: force selection past the very end of that line.")

 
                        (SETQ X (ADD1 (GETLD LINE LXLIM))))
-                   (CL:WHEN (AND (\TEDIT.SCAN.LINE
 LINE X Y NEWSEL SELOPERATION PANE BUTTON
+                   (CL:WHEN (AND (\TEDIT.SCAN.LINE
 LINE X NEWSEL SELOPERATION TEXTOBJ BUTTON
                                         (SELECTQ BUTTON
                                             (RIGHT (MEMB (FGETSEL CURSEL SELKIND)
                                                          '(WORD PARA)))
@@ -1128,7 +1133,8 @@
     SEL])
 
 (\TEDIT.CHTOLINEX

-  [LAMBDA (TEXTOBJ LINE CH# AFTER)
                           (* ; "Edited 28-Nov-2024 14:41 by rmk")


+  [LAMBDA (TEXTOBJ LINE CH# AFTER)
                           (* ; "Edited  6-Mar-2025 11:57 by rmk")


+                                                             (* ; "Edited 28-Nov-2024 14:41 by rmk")


                                                              (* ; "Edited 17-Nov-2024 15:58 by rmk")


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


                                                              (* ; "Edited 10-May-2024 00:26 by rmk")


@@ -1162,10 +1168,17 @@
                        (IEQP CH# (FGETLD LINE LCHAR1)))
              then
 (FGETLD LINE LX1)
            else
 (for
 CHARSLOT (X _ (FGETLD LINE LX1))
-                     (CHNO _ (FGETLD LINE LCHAR1)) incharslots
 THISLINE unless
 (type?
 CHARLOOKS CHARW
-                                                                                      )
+                     (CHNO _ (FGETLD LINE LCHAR1)) incharslots
 THISLINE
+                   eachtime
 (CL:WHEN (AND CHAR (DIACRITICP CHAR))
+
+                                (* ;; "If the diacritic CHARW is greater than the CHARW of the next slot, we should set the diacritic CHARW to (IDIFFERENCE CHARW (NEXT CHARW)). ")

+
+                                (* ;; "i.e.  (IMAX 0 (IDIFFERENCE CHARW (NEXT CHARW))")

+
+                                (SETQ CHARW 0)) unless
 (type?
 CHARLOOKS CHARW)
                    do
 
-                      (* ;; "Update the running X-position in the line, skiping look-slots")

+                      (* ;; 
+
              "Update the running X-position in the line, skiping look-slots and skipping diacritics")

 
                       (CL:WHEN (IEQP CHNO CH#)
                           (if
 AFTER
@@ -1191,7 +1204,8 @@
 (DEFINEQ
 
 (\TEDIT.RESET.EXTEND.PENDING.DELETE

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 26-Nov-2024 23:44 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 19-Mar-2025 13:24 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 23:44 by rmk")


                                                              (* ; "Edited  9-Mar-2024 11:37 by rmk")


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


                                                              (* ; "Edited 24-Dec-2023 00:18 by rmk")


@@ -1201,12 +1215,18 @@
 
     (* ;; "Reset the 'Extend Pending Delete' status")

 
-    (\TEDIT.SET.SEL.LOOKS
 (TEXTSEL TEXTOBJ)
-           'NORMAL)
-    (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
+    (LET [(TEXTOBJ (CL:IF (type?
 TEXTOBJ TSTREAM)
+                       TSTREAM
+                       (GETTSTR TSTREAM TEXTOBJ))]
+         (\TEDIT.SHOWSEL
 (TEXTSEL TEXTOBJ)
+                NIL TEXTOBJ)
+         (\TEDIT.SET.SEL.LOOKS
 (TEXTSEL TEXTOBJ)
+                'NORMAL)
+         (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
 
 (\TEDIT.SET.SEL.LOOKS

-  [LAMBDA (SEL OPERATION)
                                    (* ; "Edited  7-Nov-2024 21:50 by rmk")


+  [LAMBDA (SEL OPERATION)
                                    (* ; "Edited 28-Feb-2025 17:45 by rmk")


+                                                             (* ; "Edited  7-Nov-2024 21:50 by rmk")


                                                              (* ; "Edited  4-Oct-2024 08:40 by rmk")


                                                              (* ; "Edited 12-Oct-2023 22:36 by rmk")


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


@@ -1247,9 +1267,10 @@
 
                                                 "For people who really want to see what's selected.")

                   (FSETSEL SEL HOW BLACKSHADE)
                   (FSETSEL SEL HOWHEIGHT 16384)
-                  (FSETSEL SEL HASCARET T)
-                  (\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
-        SEL])
+                  (FSETSEL SEL HASCARET T))
+        (NIL)
+        (\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
+    SEL])
 )
 (DEFINEQ
 
@@ -1437,55 +1458,105 @@
             (\TEDIT.THELP "ILLEGAL POINT" (GETSEL SEL POINT))))])
 
 (\TEDIT.SEL.L1

-  [LAMBDA (SEL PANE TEXTOBJ)
                                 (* ; "Edited 24-Apr-2024 08:34 by rmk")


+  [LAMBDA (SEL PANE TEXTOBJ)
                                 (* ; "Edited  9-Mar-2025 20:00 by rmk")


+                                                             (* ; "Edited 24-Apr-2024 08:34 by rmk")


                                                              (* ; "Edited  8-Apr-2024 23:42 by rmk")


                                                              (* ; "Edited 16-Nov-2023 23:43 by rmk")

 
     (* ;; "Returns L1 for PANE in SEL")

 
+    (CL:UNLESS PANE
+        (SETQ PANE (FGETTOBJ TEXTOBJ SELPANE)))
     (for
 L in
 (GETSEL SEL L1) as
 P inpanes
 (PROGN TEXTOBJ) when
 (EQ P PANE) do
 (RETURN L])
 
 (\TEDIT.SEL.LN

-  [LAMBDA (SEL PANE TEXTOBJ)
                                 (* ; "Edited 24-Apr-2024 08:34 by rmk")


+  [LAMBDA (SEL PANE TEXTOBJ)
                                 (* ; "Edited  9-Mar-2025 20:00 by rmk")


+                                                             (* ; "Edited 24-Apr-2024 08:34 by rmk")


                                                              (* ; "Edited  8-Apr-2024 23:41 by rmk")


                                                              (* ; "Edited 16-Nov-2023 23:43 by rmk")

 
     (* ;; "Returns LN for PANE in SEL")

 
+    (CL:UNLESS PANE
+        (SETQ PANE (FGETTOBJ TEXTOBJ SELPANE)))
     (for
 L in
 (GETSEL SEL LN) as
 P inpanes
 (PROGN TEXTOBJ) when
 (EQ P PANE) do
 (RETURN L])
 
 (\TEDIT.SEL.DELETEDCHARS

-  [LAMBDA (SELTOFIX FIRSTCHAR LEN)
                           (* ; "Edited 26-Nov-2024 22:31 by rmk")


+  [LAMBDA (SELTOFIX FIRSTCHAR LEN)
                           (* ; "Edited  6-Feb-2025 15:53 by rmk")


+                                                             (* ; "Edited  4-Feb-2025 23:05 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 22:31 by rmk")


                                                              (* ; "Edited  7-Jul-2024 12:09 by rmk")


                                                              (* ; "Edited 20-Feb-2024 17:31 by rmk")


                                                              (* ; "Edited 15-Feb-2024 23:39 by rmk")


                                                              (* ; "Edited 14-Feb-2024 20:59 by rmk")

 
-    (* ;; "Adjust SELTOFIX to reflect character number translations after LEN characters starting at FIRSTCHAR have been removed.")

+    (* ;; "Adjust SELTOFIX to reflect character number translations after LEN characters starting at FIRSTCHAR have been or will be removed.")

 
     (CL:WHEN (type?
 SELECTION FIRSTCHAR)
         (SETQ LEN (FGETSEL FIRSTCHAR DCH))
         (SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#)))
-    (CL:WHEN (IGEQ (FGETSEL SELTOFIX CHLIM)
-                   FIRSTCHAR)
+    (LET ((LASTCHAR (IPLUS FIRSTCHAR LEN -1))
+          (B (FGETSEL SELTOFIX CH#))
+          (E (FGETSEL SELTOFIX CHLAST))
+          (DCH (FGETSEL SELTOFIX DCH)))
 
-        (* ;; "Nothing to do if the deletion happened after the selection.")

+         (* ;; "No overlap")

 
-        [LET ((LASTCHAR (IPLUS FIRSTCHAR LEN -1)))
-             (if
 (ILESSP LASTCHAR (FGETSEL SELTOFIX CH#))
-                 then
 
-                      (* ;; 
-
                      "All deleted characters are in front of SELTOFIX, just move SELTOFIX forward")

+         (* ;; "   1                 FddL    F gt E")

 
-                      (add
 (FGETSEL SELTOFIX CH#)
-                           (IMINUS LEN))
-                      (add
 (FGETSEL SELTOFIX CHLIM)
-                           (IMINUS LEN))
-               else
 
-                    (* ;; " SELTOFIX starts after the last pre-deletion character and is shortened so that it only covers its still-remaining characters. Because of IMAX, this reduces to a point selection if all of SELTOFIX's characters (and more) have been deleted.")

+         (* ;; "          B23E                       nothing")

 
-                    (\TEDIT.UPDATE.SEL
 SELTOFIX FIRSTCHAR (IMAX 0 (IDIFFERENCE LASTCHAR
-                                                                         (FGETSEL SELTOFIX CHLAST])])
+         (* ;; "   2    FddL                 L lt B")

+
+         (* ;; "                     B123E           B=B - LEN   ")

+
+         (* ;; "Overlaps:  NEWB=(MIN F B)  = X+1  NEWDCH = (IMAX 0, E-L)")

+
+         (* ;; "   3   XFddL                   F leq B     L lt E")

+
+         (* ;; "         X  [B23]45E                    45E at F  DCH=E-L   X45E")

+
+         (* ;; "          X45E          E-L")

+
+         (* ;; "   4   XFdddddddL        F leq B         L geq E")

+
+         (* ;; "         X[   B234E] ")

+
+         (* ;; 
+
      "         X                               point selection at F DCH=0    E-L lt 0   DCH-LEN < 0")

+
+         (* ;; "   5     X      FddL              F geq B   L lt E")

+
+         (* ;; "          XB2[3456]7E                ")

+
+         (* ;; "          XB27E                    B27E at B  DCH = DCH - LEN   ")

+
+         (* ;; "   6      X       FddL           F geq B    L geq  E")

+
+         (* ;; "            XB2[3E ")

+
+         (* ;; "            XB2                       B2 at B                      ")

+
+         (if
 (IGREATERP FIRSTCHAR E)
+             then
                                            (* ; "Case 1: Nothing")

+                  NIL
+           elseif
 (ILESSP LASTCHAR B)
+             then
                                            (* ; "Case 2: move back")

+                  (add
 (FGETSEL SELTOFIX CH#)
+                       (IMINUS LEN))
+                  (add
 (FGETSEL SELTOFIX CHLIM)
+                       (IMINUS LEN))
+           else
                                              (* ; "Overlaps")

+                (\TEDIT.UPDATE.SEL
 SELTOFIX (IMIN B FIRSTCHAR)
+                       [if
 (ILEQ FIRSTCHAR B)
+                           then
                              (* ; "Cases 3 4")

+                                (IMAX 0 (IDIFFERENCE E LASTCHAR))
+                         elseif
 (ILEQ LASTCHAR E)
+                           then
                              (* ; "Case 5")

+                                (IDIFFERENCE DCH LEN)
+                         else
                                (* ; "Case 6")

+                              (IDIFFERENCE DCH (ADD1 (IDIFFERENCE E FIRSTCHAR]
+                       'LEFT])
 )
 (DEFINEQ
 
@@ -1707,7 +1778,8 @@
                 `(PROGN (DSPCLIPPINGREGION OLDVALUE ,DS])
 
 (\TEDIT.OPERATE.OBJECT

-  [LAMBDA (TSTREAM SEL PANE OPERATION)
                       (* ; "Edited  1-Dec-2024 11:55 by rmk")


+  [LAMBDA (TSTREAM SEL PANE OPERATION)
                       (* ; "Edited 31-Dec-2024 17:24 by rmk")


+                                                             (* ; "Edited  1-Dec-2024 11:55 by rmk")


                                                              (* ; "Edited 18-Oct-2024 13:44 by rmk")


                                                              (* ; "Edited  6-Oct-2024 23:09 by rmk")


                                                              (* ; "Edited 27-Aug-2024 10:03 by rmk")


@@ -1735,7 +1807,6 @@
                             (* ;; "Called from BUTTONEVENTFN.DOOPERATION. Execute once, in PANE.  SHOWSEL and FIXSEL do the updates across other panes. This runs in PANE's coordinate system.  We can't do it if we can't determine from SEL where OBJ is located in PANE.")

 
                             (CL:WHEN (SETQ LINE (\TEDIT.SEL.L1
 SEL PANE TEXTOBJ))
-                                (TEDIT.PROMPTCLEAR TSTREAM)
                                 (\TEDIT.SHOWSEL
 SEL NIL TEXTOBJ)
                                 (MOVETO (FGETSEL SEL X0)
                                        (FGETLD LINE YBASE)
@@ -1770,7 +1841,8 @@
 (DEFINEQ
 
 (\TEDIT.SELPIECES

-  [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ)
                   (* ; "Edited 26-Nov-2024 17:49 by rmk")


+  [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ)
                   (* ; "Edited 19-Mar-2025 16:10 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 17:49 by rmk")


                                                              (* ; "Edited 22-Nov-2024 14:24 by rmk")


                                                              (* ; "Edited  7-Jul-2024 09:10 by rmk")


                                                              (* ; "Edited 29-Apr-2024 13:13 by rmk")


@@ -1802,15 +1874,17 @@
 
     (* ;; "")

 
-    (* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ.  ")

+    (* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ.")

+
+    (* ;; "  Returns NIL on an empty selection rather than the empty SELPIECES (SPLEN 0, NIL for pieces).  Somehow SELPIECES.COPY gets screwed up.  To be debugged.  Meanwhile, callers hopefully test for NIL.")

 
     (LET (FIRSTCHAR LEFTPC RIGHTPC)
          (if
 (type?
 SELECTION SEL/FIRSTCHAR)
              then
 (if
 (FGETSEL SEL/FIRSTCHAR SET)
                       then
 (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#))
-                           [SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH))
-                                              FIRSTCHAR
-                                              (SUB1 (FGETSEL SEL/FIRSTCHAR CHLIM)))]
+                           [SETQ LASTCHAR (SUB1 (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH))
+                                                    FIRSTCHAR
+                                                    (FGETSEL SEL/FIRSTCHAR CHLIM))]
                     else
 (SETQ FIRSTCHAR 0)
                          (SETQ LASTCHAR -1))
            elseif
 (type?
 TEDITHISTORYEVENT SEL/FIRSTCHAR)
@@ -1833,7 +1907,9 @@
                     SPLASTCHAR _ LASTCHAR))])
 
 (\TEDIT.SELPIECES.COPY

-  [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ)
        (* ; "Edited 26-Nov-2024 23:31 by rmk")


+  [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ CHARLOOKS)

+                                                             (* ; "Edited 19-Mar-2025 16:26 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 23:31 by rmk")


                                                              (* ; "Edited 22-Nov-2024 15:38 by rmk")


                                                              (* ; "Edited 11-Dec-2023 08:16 by rmk")


                                                              (* ; "Edited  2-Jun-2023 11:21 by rmk")


@@ -1847,13 +1923,14 @@
 
     (CL:WHEN SELPIECES
         (CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ))
-        (for
 PC NPC PREVPC NEWFIRSTPIECE inselpieces
 SELPIECES
+        (for
 PC NPC PREVPC NEWFIRSTPIECE inselpieces
 (PROGN SELPIECES)
            do
 (SETQ NPC (\TEDIT.COPYPIECE PC FROMTEXTOBJ TOTEXTOBJ NIL OPERATION))
               (CL:UNLESS NPC                                 (* ; "Was an object-copy disallowed?")

                   (RETURN)) 
 
               (* ;; "Linke the new pieces together")

 
+              (CL:WHEN CHARLOOKS (FSETPC NPC PCHARLOOKS CHARLOOKS))
               (if
 PREVPC
                   then
 (SETPC PREVPC NEXTPIECE NPC)
                 else
 (SETQ NEWFIRSTPIECE NPC))
@@ -1890,29 +1967,32 @@
                   SPLASTCHAR _ (ffetch
 (SELPIECES SPLASTCHAR) of
 SP2])
 
 (\TEDIT.SELPIECES.CHARTRANSFORM

-  [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ)
              (* ; "Edited  7-Nov-2024 21:50 by rmk")


+  [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ)
              (* ; "Edited 16-Mar-2025 10:03 by rmk")


+                                                             (* ; "Edited  7-Nov-2024 21:50 by rmk")


                                                              (* ; "Edited  4-Oct-2024 08:41 by rmk")


                                                              (* ; "Edited 28-Apr-2024 08:52 by rmk")


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


                                                              (* ; "Edited 24-May-2023 13:04 by rmk")

 
-    (* ;; "This transforms the characters in SELPIECES according to CHARFN, skipping image objects unless OBJECTSTOO.  The purpose is to allow for character transformations (e.g. case switching) without depending on strings (TEDIT.SELAS.STRING) and character insertion (\INSERTCH) as intermediaries.  Strings can't hold image objects.")

+    (* ;; "This transforms the characters in SELPIECES according to CHARFN, skipping image objects unless OBJECTSTOO.  The purpose is to allow for character transformations (e.g. case switching) without depending on strings (TEDIT.SELAS.STRING) and character insertion (\INSERTCH) as intermediaries.  Image objects would be lost if we had to go through strings.")

 
     (* ;; 
 
 "This smashes the pieces, use crosscopy \TEDIT.SELPIECES.COPY first to protect the document pieces.")

 
-    [for
 PC PCONTENTS inselpieces
 SELPIECES
+    [for
 PC PCONTENTS (INDEX _ 0) inselpieces
 SELPIECES
        do
 (SETQ PCONTENTS (PCONTENTS PC))
           (SELECTC (PTYPE PC)
               (STRING.PTYPES (for
 I CH (STR _ PCONTENTS) from
 1 while
 (SETQ CH (NTHCHARCODE STR I))
-                                do
 (RPLCHARCODE STR I (APPLY* CHARFN CH TEXTOBJ))))
+                                do
 (RPLCHARCODE STR I (APPLY* CHARFN CH (add
 INDEX 1)
+                                                             TEXTOBJ))))
               (FILE.PTYPES [LET [(STR (ALLOCSTRING (PLEN PC]
 
                                 (* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this.  If not, ALLOCSTRING will cause an error.")

 
                                 [for
 I from
 1 to
 (PLEN PC)
                                    do
 (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE
-                                                                         TEXTOBJ PC I]
+                                                                         TEXTOBJ PC I)
+                                                                (add
 INDEX 1]
                                 (if
 (fetch
 (STRINGP FATSTRINGP) of
 STR)
                                     then
 (FSETPC PC PTYPE FATSTRING.PTYPE)
                                          (FSETPC PC PBYTESPERCHAR 2)
@@ -1923,15 +2003,15 @@
                                 (FSETPC PC PCONTENTS STR)
                                 (FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
                                                            (PLEN PC])
-              (OBJECT.PTYPE (CL:WHEN OBJECTSTOO
-                                (FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS TEXTOBJ))))
-              (SUBSTREAM.PTYPE 
-                   (\TEDIT.THELP "SUBSTREAM PIECES NOT IMPLEMENTED"))
+              (OBJECT.PTYPE (add
 INDEX 1)
+                            (CL:WHEN OBJECTSTOO
+                                (FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX))))
               (\TEDIT.THELP "ILLEGAL PIECE TYPE" (PTYPE PC]
     SELPIECES])
 
 (\TEDIT.SELPIECES.FROM.STRING

-  [LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS)
   (* ; "Edited 20-Mar-2024 10:57 by rmk")


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


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


                                                              (* ; "Edited  3-Mar-2024 13:00 by rmk")


                                                              (* ; "Edited 28-Jan-2024 08:28 by rmk")


                                                              (* ; "Edited 11-Dec-2023 08:12 by rmk")


@@ -1946,7 +2026,7 @@
     (CL:UNLESS CHARLOOKS
         (SETQ CHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)))
     (CL:UNLESS PARALOOKS
-        (SETQ PARALOOKS (FGETTOBJ TEXTOBJ FMTSPEC)))
+        (SETQ PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
     (CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP))
            (SETQ CHECKFOREOL T))
     (LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1)
@@ -2090,7 +2170,9 @@
                 (FGETSEL SCRSEL CH#])
 
 (TEDIT.SELPROP

-  [LAMBDA X
                                                  (* ; "Edited 31-Oct-2024 18:00 by rmk")


+  [LAMBDA X
                                                  (* ; "Edited 28-Feb-2025 17:14 by rmk")


+                                                             (* ; "Edited  6-Feb-2025 16:48 by rmk")


+                                                             (* ; "Edited 31-Oct-2024 18:00 by rmk")


                                                              (* ; "Edited 23-Sep-2024 23:11 by rmk")


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


                                                              (* ; "Edited 19-Aug-2024 13:55 by rmk")


@@ -2111,8 +2193,6 @@
                              'SELECTION]
           (PROP (ARG X 2))
           NEWVALUE)
-         (CL:UNLESS (FGETSEL SEL SET)
-                (ERROR "SELECTION NOT SET" SEL))
          (PROG1 (SELECTQ PROP
                     (CH# (FGETSEL SEL CH#))
                     (CHLIM (FGETSEL SEL CHLIM))
@@ -2123,13 +2203,14 @@
                          (FGETSEL SEL SELKIND))
                     (CHLAST (if
 (EQ 0 (FGETSEL SEL DCH))
                                 then
 (FGETSEL SEL CH#)
-                              else
 (SUB1 (FGETSEL SEL CHLIM))))
+                              else
 (FGETSEL SEL CHLAST)))
                     (POINTCH# (TEDIT.GETPOINT
 (FGETSEL SEL SELTEXTSTREAM)
                                      SEL))
                     (SELOBJ (FGETSEL SEL SELOBJ))
                     (TEXTSTREAM (FGETSEL SEL SELTEXTSTREAM))
                     (SHADE (FGETSEL SEL HOW))
                     (SHADEHEIGHT (FGETSEL SEL HOWHEIGHT))
+                    (SET (FGETSEL SEL SET))
                     (\ILLEGAL.ARG PROP))
              (CL:WHEN (IGREATERP X 2)
                  (SETQ NEWVALUE (ARG X 3))
@@ -2146,9 +2227,12 @@
                      (CHLAST (\TEDIT.UPDATE.SEL
 SEL NIL (IDIFFERENCE (ADD1 NEWVALUE)
                                                                (FGETSEL SEL CH#))))
                      (CHLIM (\TEDIT.UPDATE.SEL
 SEL NIL (IDIFFERENCE NEWVALUE (FGETSEL SEL CH#))))
+                     (SHADE (FSETSEL SEL HOW NEWVALUE))
+                     (SHADEHEIGHT (FSETSEL SEL HOWHEIGHT NEWVALUE))
+                     (SET (FSETSEL SEL SET NEWVALUE))
                      (\ILLEGAL.ARG PROP))
-                 [\TEDIT.FIXSEL
 SEL (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 (GETSEL SEL 
-                                                                                    SELTEXTSTREAM]))])
+                 (CL:WHEN (FGETSEL SEL SELTEXTSTREAM)
+                     (\TEDIT.FIXSEL
 SEL (FGETSEL SEL SELTEXTSTREAM)))))])
 
 (TEDIT.GETPOINT

   [LAMBDA (TSTREAM SEL)
                                      (* ; "Edited 31-Oct-2024 17:46 by rmk")


@@ -2245,20 +2329,19 @@
 
 (TEDIT.SETSEL

   [LAMBDA (TSTREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION)

+                                                             (* ; "Edited 17-Feb-2025 12:26 by rmk")


+                                                             (* ; "Edited 31-Jan-2025 12:43 by rmk")


+                                                             (* ; "Edited 19-Jan-2025 08:32 by rmk")


+                                                             (* ; "Edited  8-Jan-2025 00:20 by rmk")


                                                              (* ; "Edited 26-Nov-2024 23:51 by rmk")


                                                              (* ; "Edited 30-Jul-2024 23:27 by rmk")


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


                                                              (* ; "Edited 15-Jun-2024 10:08 by rmk")


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


-                                                             (* ; "Edited 19-May-2024 00:01 by rmk")


-                                                             (* ; "Edited 29-Apr-2024 12:39 by rmk")


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


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


                                                              (* ; "Edited  9-Mar-2024 12:04 by rmk")


                                                              (* ; "Edited 22-Sep-2023 18:09 by rmk")


                                                              (* ; "Edited  3-Aug-2023 23:12 by rmk")


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


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


                                                              (* ; "Edited 27-Mar-2023 13:07 by rmk")


                                                              (* ; "Edited 30-May-91 23:05 by jds")

 
@@ -2267,67 +2350,48 @@
     (* ;; "For convenience, TSTREAM may be provided as an external selection (with its SELTEXTSTREAM as the actual TSTREAM). That selection is never installed in TSTREAM, to avoid circularity.")

 
     (SETQ TSTREAM (TEXTSTREAM TSTREAM))
-    (LET* ((TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
+    (CL:WHEN (AND LEN (ILESSP LEN 0))
+           (ERROR "Selection length cannot be negative" LEN))
+    (LET* ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
            (SEL (TEXTSEL TEXTOBJ))
            (TEXTLEN (TEXTLEN TEXTOBJ))
            PC)
           (\TEDIT.SHOWSEL
 SEL NIL TEXTOBJ)                   (* ; "First turn the old sel off.")

-          [COND
-             ((type?
 SELECTION CH#)                          (* ; 
-
                                                          "He gave use a selection;  just plug it in")

-              (\TEDIT.COPYSEL
 CH# SEL)                       (* ; 
+          [if
 (type?
 SELECTION CH#)
+              then
                                           (* ; 
+
                                                           "He gave us a selection;  just plug it in")

+                   (\TEDIT.COPYSEL
 CH# SEL)                  (* ; 
 
                                                             "And make sure it can be turned on.")

-              (SETSEL SEL ONFLG NIL))
-             (T                                              (* ; 
+                   (SETSEL SEL ONFLG NIL)
+            else
                                             (* ; 
 
                                       "Documentation doesn't allow NIL, but DINFO.SHOWSEL passes it")

-                (SELECTQ POINT
-                    (LEFT)
-                    (RIGHT)
-                    (NIL (SETQ POINT 'LEFT))
-                    (ERROR POINT "is an illegal POINT"))     (* ; "He fed us numbers;  use them")

-                (SETQ LEN (IMAX 0 (OR LEN 0)))
-                (CL:WHEN (ILESSP CH# 0)
-                    (SETQ CH# (IPLUS 1 TEXTLEN CH#)))        (* ; "Length must be positive")

-                (SETQ CH# (IMIN (IMAX 1 CH#)
-                                (ADD1 TEXTLEN)))             (* ; 
-
                                        "Starting character. If beyond  TEXTLEN, then just after EOF")

-                (SETSEL SEL CH# CH#)
-                [SETSEL SEL CHLIM (IMAX CH# (IMIN (IPLUS CH# LEN)
-                                                  (ADD1 TEXTLEN]
-
-                (* ;; "LEN may have been reduced by TEXTLEN")

-
-                (SETQ LEN (IDIFFERENCE (GETSEL SEL CHLIM)
-                                 (GETSEL SEL CH#)))
-                (SETSEL SEL DCH LEN)
-                (SETSEL SEL POINT (if
 (IGREATERP CH# TEXTLEN)
-                                      then
 'LEFT
-                                    elseif
 POINT
-                                    else
 'LEFT))             (* ; "Which side the caret should go on")

-                (FSETSEL SEL SELOBJ (CL:WHEN (EQ 1 LEN)      (* ; "If CH# beyond TEXTLEN, LEN is 0")

-                                        (SETQ PC (\TEDIT.CHTOPC (GETSEL SEL CH#)
-                                                        TEXTOBJ))
-                                        (CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC))
-                                               (PCONTENTS PC)))]
-          [COND
-             [PENDINGDELFLG                                  (* ; 
-
                                                    "This selection is to be a pending-deletion sel.")

-                    (SETTOBJ TEXTOBJ BLUEPENDINGDELETE T)    (* ; 
-
                                                         "Warn TEdit that there's a deletion pending")

-                    (\TEDIT.SET.SEL.LOOKS
 SEL (OR OPERATION 'PENDINGDEL]
-             (T                                              (* ; 
-
                                                    "This selection is to be a pending-deletion sel.")

-                (\TEDIT.RESET.EXTEND.PENDING.DELETE
 TEXTOBJ)
-                (\TEDIT.SET.SEL.LOOKS
 SEL (OR OPERATION 'NORMAL]
-          (SETSEL SEL SET T)                                 (* ; 
-
                                                      "Mark the selection as valid for others to use")

+                 (SELECTQ POINT
+                     (LEFT)
+                     (RIGHT)
+                     (NIL (SETQ POINT 'LEFT))
+                     (ERROR POINT "is an illegal POINT"))    (* ; "He fed us numbers;  use them")

+                 (CL:WHEN (ILESSP CH# 0)                     (* ; "Negative => from end")

+                     (SETQ CH# (IPLUS 1 TEXTLEN CH#)))
+                 (if
 (EQ 0 TEXTLEN)
+                     then
 (\TEDIT.UPDATE.SEL
 SEL 1 0 'LEFT)
+                   elseif
 (IGREATERP CH# TEXTLEN)
+                     then
 (\TEDIT.UPDATE.SEL
 SEL TEXTLEN 0 'RIGHT)
+                   else
 [SETQ LEN (IMIN LEN (ADD1 (IDIFFERENCE TEXTLEN CH#]
+                        (\TEDIT.UPDATE.SEL
 SEL CH# LEN POINT)
+                        (FSETSEL SEL SELOBJ (CL:WHEN (EQ 1 LEN)
+                                                (SETQ PC (\TEDIT.CHTOPC (GETSEL SEL CH#)
+                                                                TEXTOBJ))
+                                                (CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC))
+                                                       (PCONTENTS PC)))]
+          (SETTOBJ TEXTOBJ BLUEPENDINGDELETE PENDINGDELFLG)
+          (\TEDIT.SET.SEL.LOOKS
 SEL OPERATION)
           (CL:UNLESS LEAVECARETLOOKS                         (* ; 
-
                                                             "And set the insertion looks to follow.")

+
                                                             "Set the insertion looks to follow.")

               (SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))
-          (\TEDIT.FIXSEL
 SEL TEXTOBJ)                        (* ; 
-
                                                             "Update the selection's screen location")

-          (\TEDIT.SHOWSEL
 SEL T TEXTOBJ)                     (* ; "Highlight it on the screen")

-          SEL])
+          (\TEDIT.FIXSEL
 SEL TEXTOBJ)
+          (\TEDIT.SHOWSEL
 SEL T TEXTOBJ)
+          (FSETTOBJ TEXTOBJ LASTARROWX NIL)
+          (TEDIT.GETSEL
 TSTREAM])
 
 (TEDIT.SHOWSEL

   [LAMBDA (TSTREAM ONFLG SEL)
                                (* ; "Edited  7-Jul-2024 11:25 by rmk")


@@ -2350,7 +2414,8 @@
              (\TEDIT.SHOWSEL
 SEL ONFLG TEXTOBJ))])
 
 (TEDIT.SEL.AS.STRING

-  [LAMBDA (TSTREAM SEL CODEFOROBJECT)
                        (* ; "Edited 14-Jul-2024 00:12 by rmk")


+  [LAMBDA (TSTREAM SEL/CH# LEN CODEFOROBJECT)
                (* ; "Edited 15-Feb-2025 12:47 by rmk")


+                                                             (* ; "Edited 14-Jul-2024 00:12 by rmk")


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


                                                              (* ; "Edited 27-Jan-2024 22:57 by rmk")


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


@@ -2363,30 +2428,34 @@
 
    "Given a text stream, go to the TEXTOBJ, get the current selection, and return it as a string.")

 
     (SETQ TSTREAM (TEXTSTREAM TSTREAM))
-    (CL:UNLESS SEL
-        (SETQ SEL (GETTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)
-                         SEL)))
-    (LET (RESULT (LEN (GETSEL SEL DCH)))
-         (COND
-            ((ZEROP LEN)                                     (* ; 
+    (CL:UNLESS SEL/CH#
+        (SETQ SEL/CH# (GETTOBJ (GETTSTR TSTREAM TEXTOBJ)
+                             SEL)))
+    (LET (RESULT CH#)
+         (if
 (type?
 SELECTION SEL/CH#)
+             then
 (SETQ LEN (GETSEL SEL/CH# DCH))
+                  (SETQ CH# (GETSEL SEL/CH# CH#))
+           else
 (SETQ CH# SEL/CH#))
+         (if
 (ZEROP LEN)
+             then
                                            (* ; 
 
                                              "There is no selection, or it's zero-width.  Return ''")

-             (CONCAT ""))
-            (T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE)))
+                  (CONCAT "")
+           else
 (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE))) 
                                                              (* ; "The resulting string")

-               (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (GETSEL SEL CH#)))
-                                                             (* ; 
+                (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#))   (* ; 
 
                                               "Starting point for the string is start of selection.")

-               (for
 I C from
 1 to
 LEN do
 (SETQ C (BIN TSTREAM))
-                                         (CL:WHEN (AND (IMAGEOBJP C)
-                                                       CODEFOROBJECT)
+                (for
 I C from
 1 to
 LEN do
 (SETQ C (BIN TSTREAM))
+                                          (CL:WHEN (AND (IMAGEOBJP C)
+                                                        CODEFOROBJECT)
                                                              (* ; 
 
                                                         "RPLCHARCODE will cause an error on objects")

-                                             (SETQ C CODEFOROBJECT))
-                                         (RPLCHARCODE RESULT I C))
-               RESULT])
+                                              (SETQ C CODEFOROBJECT))
+                                          (RPLCHARCODE RESULT I C))
+                RESULT])
 
 (TEDIT.SEL.AS.SEXPR

-  [LAMBDA (TSTREAM SEL RDTBL FLG)
                            (* ; "Edited 29-Apr-2024 10:49 by rmk")


+  [LAMBDA (TSTREAM SEL RDTBL FLG)
                            (* ; "Edited 29-Dec-2024 08:47 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 10:49 by rmk")


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


                                                              (* ; "Edited 25-Dec-2023 18:52 by rmk")


                                                              (* ; "Edited  9-Jul-2023 09:37 by rmk")


@@ -2399,7 +2468,7 @@
     (SETQ TSTREAM (TEXTSTREAM TSTREAM))
     [\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (\TEDIT.WORD.FIRST TSTREAM (TEDIT.GETPOINT
 TSTREAM SEL)
                                                 (TEDIT.ATOMBOUND.READTABLE (OR RDTBL *READTABLE*]
-    (READ TSTREAM RDTBL FLG])
+    (CAR (NLSETQ (READ TSTREAM RDTBL FLG])
 
 (TEDIT.SELECTALL

   [LAMBDA (TEXTSTREAM TEXTOBJ SEL)
                           (* ; "Edited 14-Jun-2023 16:58 by rmk")


@@ -2416,25 +2485,25 @@
 (ADDTOVAR LAMA
 TEDIT.SELPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (15576 17397 (\TEDIT.SELECTION.DEFPRINT 15586 . 17395)) (17434 18939 (
-\TEDIT.SET.GLOBAL.SELECTIONS 17444 . 18937)) (18940 24809 (\TEDIT.SELECTED.PIECES 18950 . 20470) (
-\TEDIT.FIND.PROTECTED.END 20472 . 22141) (\TEDIT.FIND.PROTECTED.START 22143 . 24001) (
-\TEDIT.WORD.BOUND 24003 . 24807)) (24943 58882 (\TEDIT.EXTEND.SEL 24953 . 32041) (\TEDIT.SCAN.LINE 
-32043 . 43671) (\TEDIT.SCAN.LINE.WORD 43673 . 49034) (\TEDIT.XYTOSEL 49036 . 56035) (\TEDIT.REGIONTYPE
- 56037 . 57056) (\TEDIT.XYTOSEL.INLINEP 57058 . 57513) (\TEDIT.XYTOSEL.LINE 57515 . 58880)) (58883 
-72045 (\TEDIT.FIXSEL 58893 . 68506) (\TEDIT.CHTOLINEX 68508 . 72043)) (72046 75583 (
-\TEDIT.RESET.EXTEND.PENDING.DELETE 72056 . 73029) (\TEDIT.SET.SEL.LOOKS 73031 . 75581)) (75584 91884 (
-\TEDIT.SHOWSEL 75594 . 80054) (\TEDIT.SHOWSEL.HILIGHT 80056 . 84677) (\TEDIT.UPDATE.SEL 84679 . 88178)
- (\TEDIT.CARETLINE 88180 . 88894) (\TEDIT.SEL.L1 88896 . 89402) (\TEDIT.SEL.LN 89404 . 89910) (
-\TEDIT.SEL.DELETEDCHARS 89912 . 91882)) (91885 96591 (\TEDIT.COPYSEL 91895 . 94361) (
-\TEDIT.SEL.CHANGED? 94363 . 96589)) (96622 109302 (\TEDIT.SELECT.OBJECT 96632 . 101138) (
-\TEDIT.SHOWSEL.OBJECT 101140 . 103302) (\TEDIT.CLIP.OBJECT 103304 . 105308) (\TEDIT.OPERATE.OBJECT 
-105310 . 109300)) (109330 127559 (\TEDIT.SELPIECES 109340 . 113288) (\TEDIT.SELPIECES.COPY 113290 . 
-115328) (\TEDIT.SELPIECES.CONCAT 115330 . 117209) (\TEDIT.SELPIECES.CHARTRANSFORM 117211 . 120169) (
-\TEDIT.SELPIECES.FROM.STRING 120171 . 125194) (\TEDIT.SELPIECES.TO.STRING 125196 . 127557)) (127612 
-151011 (TEDIT.XYTOCH 127622 . 130006) (TEDIT.SELPROP 130008 . 133764) (TEDIT.GETPOINT 133766 . 135686)
- (TEDIT.GETSEL 135688 . 136422) (TEDIT.GETSEL.PARA 136424 . 137373) (TEDIT.SCANSEL 137375 . 138323) (
-TEDIT.SET.SEL.LOOKS 138325 . 139704) (TEDIT.SETSEL 139706 . 145976) (TEDIT.SHOWSEL 145978 . 147258) (
-TEDIT.SEL.AS.STRING 147260 . 149511) (TEDIT.SEL.AS.SEXPR 149513 . 150677) (TEDIT.SELECTALL 150679 . 
-151009)))))
+  (FILEMAP (NIL (15676 17497 (\TEDIT.SELECTION.DEFPRINT 15686 . 17495)) (17534 19039 (
+\TEDIT.SET.GLOBAL.SELECTIONS 17544 . 19037)) (19040 24892 (\TEDIT.SELECTED.PIECES 19050 . 20570) (
+\TEDIT.FIND.PROTECTED.END 20572 . 22241) (\TEDIT.FIND.PROTECTED.START 22243 . 24101) (
+\TEDIT.WORD.BOUND 24103 . 24890)) (25026 59225 (\TEDIT.EXTEND.SEL 25036 . 32124) (\TEDIT.SCAN.LINE 
+32126 . 43904) (\TEDIT.SCAN.LINE.WORD 43906 . 49267) (\TEDIT.XYTOSEL 49269 . 56378) (\TEDIT.REGIONTYPE
+ 56380 . 57399) (\TEDIT.XYTOSEL.INLINEP 57401 . 57856) (\TEDIT.XYTOSEL.LINE 57858 . 59223)) (59226 
+72850 (\TEDIT.FIXSEL 59236 . 68849) (\TEDIT.CHTOLINEX 68851 . 72848)) (72851 76834 (
+\TEDIT.RESET.EXTEND.PENDING.DELETE 72861 . 74170) (\TEDIT.SET.SEL.LOOKS 74172 . 76832)) (76835 95235 (
+\TEDIT.SHOWSEL 76845 . 81305) (\TEDIT.SHOWSEL.HILIGHT 81307 . 85928) (\TEDIT.UPDATE.SEL 85930 . 89429)
+ (\TEDIT.CARETLINE 89431 . 90145) (\TEDIT.SEL.L1 90147 . 90830) (\TEDIT.SEL.LN 90832 . 91515) (
+\TEDIT.SEL.DELETEDCHARS 91517 . 95233)) (95236 99942 (\TEDIT.COPYSEL 95246 . 97712) (
+\TEDIT.SEL.CHANGED? 97714 . 99940)) (99973 112702 (\TEDIT.SELECT.OBJECT 99983 . 104489) (
+\TEDIT.SHOWSEL.OBJECT 104491 . 106653) (\TEDIT.CLIP.OBJECT 106655 . 108659) (\TEDIT.OPERATE.OBJECT 
+108661 . 112700)) (112730 131910 (\TEDIT.SELPIECES 112740 . 117021) (\TEDIT.SELPIECES.COPY 117023 . 
+119310) (\TEDIT.SELPIECES.CONCAT 119312 . 121191) (\TEDIT.SELPIECES.CHARTRANSFORM 121193 . 124402) (
+\TEDIT.SELPIECES.FROM.STRING 124404 . 129545) (\TEDIT.SELPIECES.TO.STRING 129547 . 131908)) (131963 
+154486 (TEDIT.XYTOCH 131973 . 134357) (TEDIT.SELPROP 134359 . 138389) (TEDIT.GETPOINT 138391 . 140311)
+ (TEDIT.GETSEL 140313 . 141047) (TEDIT.GETSEL.PARA 141049 . 141998) (TEDIT.SCANSEL 142000 . 142948) (
+TEDIT.SET.SEL.LOOKS 142950 . 144329) (TEDIT.SETSEL 144331 . 149095) (TEDIT.SHOWSEL 149097 . 150377) (
+TEDIT.SEL.AS.STRING 150379 . 152864) (TEDIT.SEL.AS.SEXPR 152866 . 154152) (TEDIT.SELECTALL 154154 . 
+154484)))))
 STOP

library/tedit/TEDIT-STREAM

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "22-Dec-2024 00:24:17" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;835
 172312 
+
(FILECREATED "28-Mar-2025 18:32:27" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;872
 187180 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.TEXTPROP)
+      :CHANGES-TO (FNS \TEDIT.NTHCHARCODE \TEDIT.TEXTBOUT \TEDIT.RPLCHARCODE)
+                  (VARS TEDIT-STREAMCOMS)
 
-      :PREVIOUS-DATE "20-Dec-2024 12:19:41" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;834)
+      :PREVIOUS-DATE "26-Mar-2025 00:29:46" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;865)
 
 
 (PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -57,6 +58,10 @@
              \TEDIT.TEXTSETEOF \TEDIT.TEXTSETFILEPTR \TEDIT.TEXTDSPXPOSITION \TEDIT.TEXTDSPYPOSITION
              \TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH 
              \TEDIT.TEXTDSPSTRINGWIDTH \TEDIT.TEXTDSPLINEFEED)
+        
+        (* ;; "Access by character")

+
+        (FNS \TEDIT.NTHCHARCODE \TEDIT.PIECE.NTHCHARCODE \TEDIT.RPLCHARCODE)
         (COMS 
               (* ;; "Editing support")

 
@@ -102,7 +107,7 @@
                  NEXTPIECE                                   (* ; "-> Next piece in this textobj.")

                  (PREVPIECE FULLXPOINTER)                    (* ; 
 
                                                             "-> Prior piece in this text object.")

-                 PLOOKS                                      (* ; "Character formatting info ")

+                 PCHARLOOKS                                  (* ; "Character formatting info ")

                  PBYTESPERCHAR                               (* ; 
 
       "The number of bytes per character, given that all characters in a piece are the same length.")

                  (PPARALAST FLAG)                            (* ; "This piece ends paragraph")

@@ -121,10 +126,12 @@
                 [ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
                                        (type?
 IMAGEOBJ (PCONTENTS DATUM))
                                        (PCONTENTS DATUM)))
-                            (PCHARLOOKS (PLOOKS DATUM)
-                                   (STANDARD (replace
 (PIECE PLOOKS) of
 DATUM with
 NEWVALUE)
+                            (PLOOKS (STANDARD (fetch
 (PIECE PCHARLOOKS) of
 DATUM)
+                                           FAST
+                                           (fetch
 (PIECE PCHARLOOKS) of
 DATUM))
+                                   (STANDARD (replace
 (PIECE PCHARLOOKS) of
 DATUM with
 NEWVALUE)
                                           FAST
-                                          (freplace
 (PIECE PLOOKS) of
 DATUM with
 NEWVALUE]
+                                          (freplace
 (PIECE PCHARLOOKS) of
 DATUM with
 NEWVALUE]
                 PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
 
 (DATATYPE TEXTOBJ
 
@@ -135,7 +142,7 @@
            PCTB                                              (* ; "The piece table")

            TEXTLEN                                           (* ; "# of chars in the text")

            PRIMARYPANE                                       (* ; "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC")

-           LASTPIECE                                         (* ; 
+           SUFFIXPIECE                                       (* ; 
 
                    "The last (end-of-stream) piece of the textstream, for easy insertion at the end")

            CHARFN                                            (* ; 
 
    "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")

@@ -157,8 +164,8 @@
 
  "NOTE:  THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")

            SEL                                               (* ; 
 
                                                             "The current selection within the text")

-           NIL                                               (* ; 
-
                                                          "Was: Scratch space for the selection code")

+           LASTARROWX                                        (* ; 
+
                       "X for next arrow up or arrow down. Was: Scratch space for the selection code")

            NIL                                               (* ; 
 
                                                      "Was MOVESEL: Source for the next MOVE of text")

            NIL                                               (* ; 
@@ -187,7 +194,7 @@
 
                                               "Cache of line-related info, to speed up selection &c")

            (MENUFLG FLAG)                                    (* ; 
 
                                                            "T if this TEXTOBJ is a tedit-style menu")

-           FMTSPEC                                           (* ; 
+           DEFAULTPARALOOKS                                  (* ; 
 
                                      "Default Formatting Spec to be used when formatting paragraphs")

            (FORMATTEDP FLAG)                                 (* ; 
 
 "Flag for paragraph formatting.  T if this document is to contain paragraph formatting information.")

@@ -225,7 +232,7 @@
            TXTCHARLOOKSLIST                                  (* ; 
 
                             "List of all the CHARLOOKSs in the document, so they can be kept unique")

            TXTPARALOOKSLIST                                  (* ; 
-
                               "List of all the FMTSPECs in the document, so they can be kept unique")

+
                              "List of all the PARALOOKS in the document, so they can be kept unique")

            (TXTAPPENDONLY FLAG)                              (* ; "Allows updates only at the end of the stream.  Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater")

            (TXTDON'TUPDATE FLAG)                             (* ; "T if we're holding off on screen updates until later.  Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.")

            TXTRAWINCLUDESTREAM                               (* ; 
@@ -236,13 +243,15 @@
 
                      "Style sheet local to this document.  Not currently saved as part of the file.")

            )
           [ACCESSFNS TEXTOBJ ((\DIRTY (ffetch
 (TEXTOBJ \XDIRTY) of
 DATUM)
-                                     (CL:UNLESS (EQ NEWVALUE (ffetch
 (TEXTOBJ \XDIRTY) of
 DATUM))
-                                         (\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
-                                         (freplace
 \XDIRTY OF
 DATUM WITH
 NEWVALUE))]
+                                     (PROGN (FSETTOBJ DATUM LASTARROWX NIL)
+                                            (CL:UNLESS (EQ NEWVALUE (ffetch
 (TEXTOBJ \XDIRTY)
+                                                                       of
 DATUM))
+                                                (\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
+                                                (freplace
 \XDIRTY OF
 DATUM WITH
 NEWVALUE))]
           SEL _ (create
 SELECTION)
           TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ 'TEXT THISLINE _
           (create
 THISLINE)
-          FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
+          DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
 
 (ACCESSFNS TEXTSTREAM
 
            (
@@ -265,10 +274,10 @@
 
                                                             "Runs from PLEN to 0: piece exhausted")

             (NIL)                                            (* ; "Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ.")

             (CURRENTPARALOOKS (fetch
 (STREAM IMAGEDATA) of
 DATUM)
-                   (REPLACE
 (STREAM IMAGEDATA) of
 DATUM with
 NEWVALUE))
-                                                             (* ; "The FMTSPEC that is currently applicable to characters being taken from the stream. This was  the only residual field of TEXTIMAGEDATA, now gone.")

+                   (replace
 (STREAM IMAGEDATA) of
 DATUM with
 NEWVALUE))
+                                                             (* ; "THIS IS SOMEHOW INVOLVED IN STYLES, NOT SENSIBLE. REMOVE? The PARALOOKS that is currently applicable to characters being taken from the stream. This was  the only residual field of TEXTIMAGEDATA, now gone.")

             (APPLYLOOKSUPDATEFN (fetch
 (STREAM F4) of
 DATUM)
-                   (REPLACE
 (STREAM F4) OF
 DATUM with
 NEWVALUE))
+                   (replace
 (STREAM F4) OF
 DATUM with
 NEWVALUE))
                                                              (* ; "Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting.")

             (STARTINGCOFFSET (fetch
 (STREAM F2) of
 DATUM)
                    (replace
 (STREAM F2) of
 DATUM with
 NEWVALUE)))
@@ -400,10 +409,10 @@
                            (ffetch
 (PIECE PCONTENTS) of
 PC)))
 
 (PUTPROPS PLOOKS
 MACRO
 ((PC)
-                        (ffetch
 (PIECE PLOOKS) of
 PC)))
+                        (ffetch
 (PIECE PCHARLOOKS) of
 PC)))
 
 (PUTPROPS PCHARLOOKS
 MACRO
 ((PC)
-                            (PLOOKS PC)))
+                            (ffetch
 (PIECE PCHARLOOKS) of
 PC)))
 
 (PUTPROPS PCHARSET
 MACRO
 ((PC)
                           (ffetch
 (PIECE PCHARSET) of
 PC)))
@@ -1015,7 +1024,8 @@
                  (\TEDIT.THELP "UNKNOWN PIECE TYPE")))])
 
 (\TEDIT.TEXTBOUT

-  [LAMBDA (TSTREAM CHAR)
                                     (* ; "Edited 17-Nov-2024 10:05 by rmk")


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


+                                                             (* ; "Edited 17-Nov-2024 10:05 by rmk")


                                                              (* ; "Edited  6-Sep-2024 13:06 by rmk")


                                                              (* ; "Edited 27-Aug-2024 14:50 by rmk")


                                                              (* ; "Edited 13-Aug-2024 08:28 by rmk")


@@ -1056,7 +1066,7 @@
               (ERROR "FILE NOT OPEN" TSTREAM)
               (RETURN))
           (if
 (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN))
-              then
 (TEDIT.RPLCHARCODE TSTREAM CHNO CHAR)     (* ; 
+              then
 (\TEDIT.RPLCHARCODE
 TSTREAM CHNO CHAR)    (* ; 
 
                                                             "Replace in the middle, add at the end")

             elseif
 (AND (\TEDIT.INSERTCH
 CHAR CHNO TEXTOBJ (MEMB CHAR (FGETTOBJ TEXTOBJ 
                                                                              PARABREAKCHARS)))
@@ -1225,7 +1235,13 @@
 (DEFINEQ
 
 (OPENTEXTSTREAM

-  [LAMBDA (TEXT WINDOW START END PROPS)
+  [LAMBDA (TEXT WINDOW START/PROPS END PROPS)
+
+    (* ;; "Edited 17-Feb-2025 08:57 by rmk")

+
+    (* ;; "Edited 30-Jan-2025 11:15 by rmk")

+
+    (* ;; "Edited 10-Jan-2025 11:17 by rmk")

 
     (* ;; "Edited 21-Nov-2024 00:18 by rmk")

 
@@ -1287,11 +1303,17 @@
 
                                           "Empty string means empty document, not illegal file name")

         (SETQ TEXT NIL))
     (RESETLST
-        (LET ((TSTREAM (TEXTSTREAMP TEXT))
-              TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE)
+        (LET ((TSTREAM (TEXTSTREAM TEXT T))
+              TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE START)
              (DECLARE
 (SPECVARS TEDIT.GET.FINISHEDFORMS))    (* ; 
 
                 "Undocumented, but available for special-purpose actions specified somewhere below.")

-             (if
 TSTREAM
+             (SETQ START (if
 (FIXP START/PROPS)
+                             then
 START/PROPS
+                           elseif
 (AND (LISTP START/PROPS)
+                                       (NOT (LISTP PROPS)))
+                             then
 (SETQ PROPS START/PROPS)
+                                  NIL))
+             [if
 TSTREAM
                  then
 (SETQ TEXTOBJ (TEXTOBJ TSTREAM))
                       (CL:WHEN (OR START END)                (* ; "Do the end first")

                           (CL:WHEN (AND END (ILESSP END (TEXTLEN TEXTOBJ)))
@@ -1304,14 +1326,13 @@
                                                           TEXTOBJ)
                                      TEXTOBJ)))
                       (\TEDIT.OPENTEXTSTREAM.PROPS
 TEXTOBJ PROPS)
+                      (\TEDIT.REOPENTEXTSTREAM
 TSTREAM)
                       (SETQ WINDOW (if
 [AND (SETQ PRIMPANE (OPENWP (\TEDIT.PRIMARYPANE TSTREAM)))
                                             (OR (NULL WINDOW)
                                                 (EQ WINDOW (CAR (WINDOWPROP PRIMPANE 'TYPED-REGION]
                                        then
                  (* ; "Reuse the existing window/region")

                                             PRIMPANE
-                                     else
 (\TEDIT.CREATEW WINDOW TSTREAM PROPS)))
-                      (\TEDIT.OPENTEXTSTREAM.WINDOW
 WINDOW TSTREAM PROPS)
-                      (\TEDIT.REOPENTEXTSTREAM
 TSTREAM)
+                                     else
 (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))
                else
 (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM
 PROPS))
                     (SETQ TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ))
                     (CL:WHEN TEXT                            (* ; 
@@ -1319,23 +1340,23 @@
                         (SETQ TEXT (\TEDIT.OPENTEXTFILE
 TEXT PROPS))
                         (FSETTOBJ TEXTOBJ TXTFILE TEXT)) 
 
-                    (* ;; "Get the window before populating pieces, so that the local promptwindow is availabe for messages and queries")

+                    (* ;; "If we swap the window before the pieces, the local promptwindow is availabe for messages and queries. Otherwise, those show up in the system prompt.  But if we do it in the opposite order, we don't know how to estimate the width for the window region.")

 
-                    (CL:WHEN WINDOW                          (* ; 
-
                                      "If NIL, don't create a window.  It's Tedit on call from TEDIT")

-                        (SETQ WINDOW (\TEDIT.CREATEW WINDOW TSTREAM PROPS)))
                     (CL:WHEN TEXT
 
                         (* ;; "TEXT is a stream. The fresh TEXTSTREAM is updated to hold that text, ready for window and process attachments.")

 
-                        (\TEDIT.OPENTEXTSTREAM.PIECES
 TEXT TSTREAM START END PROPS)) 
+                        (\TEDIT.OPENTEXTSTREAM.PIECES
 TEXT TSTREAM START END PROPS))
+                    (CL:WHEN WINDOW                          (* ; 
+
                                                             "WINDOW is Tedit on call from TEDIT")

+                        (SETQ WINDOW (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))]
 
-                    (* ;; "We now have all the pieces, even for TEXT=NIL (empty document) case.")

+             (* ;; "We now have all the pieces, even for TEXT=NIL (empty document) case.")

 
-                    (CL:WHEN WINDOW                          (* ; "Connect to the window")

-                        (\TEDIT.OPENTEXTSTREAM.WINDOW
 WINDOW TSTREAM PROPS))
-                    (\TEDIT.OPENTEXTSTREAM.SETUP.SEL
 TSTREAM)
-                    (\TEDIT.SCROLL.CARET TSTREAM))
+             (CL:WHEN WINDOW                                 (* ; "Connect to the window")

+                 (\TEDIT.OPENTEXTSTREAM.WINDOW
 WINDOW TSTREAM PROPS))
+             (\TEDIT.OPENTEXTSTREAM.SETUP.SEL
 TSTREAM)
+             (\TEDIT.SCROLL.CARET TSTREAM)
              (CL:UNLESS (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)
                     (TEDIT.PAGEFORMAT TEXTOBJ TEDIT.PAGE.FRAMES))
              (for
 FORM in
 TEDIT.GET.FINISHEDFORMS do
 (EVAL FORM))
@@ -1345,7 +1366,9 @@
              TSTREAM))])
 
 (COPYTEXTSTREAM

-  [LAMBDA (ORIGINAL
 CROSSCOPY)
                               (* ; "Edited 17-Mar-2024 12:41 by rmk")


+  [LAMBDA (ORIGINAL
 CROSSCOPY)
                               (* ; "Edited  8-Feb-2025 20:10 by rmk")


+                                                             (* ; "Edited 12-Jan-2025 12:16 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 16-Mar-2024 10:03 by rmk")


                                                              (* ; "Edited 16-Jan-2024 12:27 by rmk")


                                                              (* ; "Edited 22-Sep-2023 20:48 by rmk")


@@ -1365,13 +1388,16 @@
 
                                   "Create an empty textstream into which the pieces can be hammered")

          [SETQ NEWSTREAM (OPENTEXTSTREAM
 NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
          (SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM))
-         (for
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ) do
 (\TEDIT.INSERTPIECE (\TEDIT.COPYPIECE
-                                                                              PC TEXTOBJ NEWTEXTOBJ 
-                                                                              NIL 'COPY)
-                                                                NIL NEWTEXTOBJ))
+         (for
 PC NEWPC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ)
+            do
 (SETQ NEWPC (\TEDIT.COPYPIECE PC TEXTOBJ NEWTEXTOBJ NIL 'COPY))
+               (CL:UNLESS NEWPC
+                   (CL:IF (EQ OBJECT.PTYPE (PTYPE PC))
+                       (ERROR "Image object does not allow copying" (POBJ PC))
+                       (ERROR "Piece cannot be copied " PC)))
+               (\TEDIT.INSERTPIECE NEWPC NIL NEWTEXTOBJ))
          (FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
          (FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-         (FSETTOBJ NEWTEXTOBJ FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
+         (FSETTOBJ NEWTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
          (FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL))
          (FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL))
          (FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET))
@@ -1492,7 +1518,8 @@
     (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
 TEXTOBJ])
 
 (\TEDIT.OPENTEXTSTREAM.SETUP.SEL

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 25-Nov-2024 14:33 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 17-Feb-2025 08:56 by rmk")


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


                                                              (* ; "Edited 20-Nov-2024 23:56 by rmk")


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


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


@@ -1513,53 +1540,53 @@
     (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
            (SEL (TEXTSEL TEXTOBJ))
            SELPROP)
-          (SETQ SELPROP (GETTEXTPROP
 TEXTOBJ 'SEL))
-          (FSETSEL SEL SET T)
-          (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
-          (CL:UNLESS (EQ SELPROP 'DON'T)
-              (FSETSEL SEL SELKIND 'CHAR)                    (* ; "Default, maybe reset below")

-              (if
 (type?
 SELECTION SELPROP)
-                  then
                                       (* ; 
+          (CL:UNLESS (AND SEL (GETSEL SEL SET))
+              (SETQ SELPROP (GETTEXTPROP
 TEXTOBJ 'SEL))
+              (FSETSEL SEL SET T)
+              (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+              (CL:UNLESS (EQ SELPROP 'DON'T)
+                  (FSETSEL SEL SELKIND 'CHAR)                (* ; "Default, maybe reset below")

+                  (if
 (type?
 SELECTION SELPROP)
+                      then
                                   (* ; 
 
                                         "We came in with an explicit initial selection.  Set it up.")

-                       (\TEDIT.COPYSEL SELPROP SEL)
-                elseif
 (LISTP SELPROP)
-                  then
 
-                       (* ;; "Default to POINT selection")

+                           (\TEDIT.COPYSEL SELPROP SEL)
+                    elseif
 (LISTP SELPROP)
+                      then
 
+                           (* ;; "Default to POINT selection")

 
-                       (\TEDIT.UPDATE.SEL SEL (CAR SELPROP)
-                              (OR (CADR SELPROP)
-                                  0)
-                              (OR (CADDR SELPROP)
-                                  'LEFT))
-                       (FSETSEL SEL SELKIND 'CHAR)
-                elseif
 (FIXP SELPROP)
-                  then
 (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
-                elseif
 (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
-                  then
 
-                       (* ;; "Default to after the last character")

+                           (\TEDIT.UPDATE.SEL SEL (CAR SELPROP)
+                                  (OR (CADR SELPROP)
+                                      0)
+                                  (OR (CADDR SELPROP)
+                                      'LEFT))
+                           (FSETSEL SEL SELKIND 'CHAR)
+                    elseif
 (FIXP SELPROP)
+                      then
 (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
+                    elseif
 (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
+                      then
 
+                           (* ;; "Default to after the last character")

 
-                       (\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
-                              0
-                              'RIGHT)
-                else
 
-                     (* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1,  But UPDATE.SEL adds 1 when DCH=0.  That's wrong for the initial caret, so brute-force fix it here.  Maybe it's wrong in general?")

+                           (\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
+                                  0
+                                  'RIGHT)
+                    else
 
+                         (* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1,  But UPDATE.SEL adds 1 when DCH=0.  That's wrong for the initial caret, so brute-force fix it here.  Maybe it's wrong in general?")

 
-                     (\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
-                     (FSETSEL SEL CHLIM 1))
-              [FSETTOBJ TEXTOBJ CARETLOOKS (if
 (FGETSEL SEL SET)
-                                               then
          (* ; 
+                         (\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
+                         (FSETSEL SEL CHLIM 1))
+                  [FSETTOBJ TEXTOBJ CARETLOOKS (if
 (FGETSEL SEL SET)
+                                                   then
      (* ; 
 
                                                  "An initial selection implies initial caret looks.")

-                                                    (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)
-                                             else
 (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (GETTOBJ TEXTOBJ
-                                                                                           
-                                                                                     DEFAULTCHARLOOKS
-                                                                                           ]
-              (CL:WHEN (OR (FGETTOBJ TEXTOBJ TXTREADONLY)
-                           (FGETTOBJ TEXTOBJ TXTAPPENDONLY)) (* ; 
+                                                        (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)
+                                                 else
 (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
+                                                             (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS]
+                  (CL:WHEN (OR (FGETTOBJ TEXTOBJ TXTREADONLY)
+                               (FGETTOBJ TEXTOBJ TXTAPPENDONLY))
+                                                             (* ; 
 
                                                     "Don't blink for read-only, but do highlighting")

-                  (FSETSEL SEL HASCARET NIL))
-              (\TEDIT.FIXSEL SEL TEXTOBJ)
-              (\TEDIT.SHOWSEL SEL T TEXTOBJ))
+                      (FSETSEL SEL HASCARET NIL))
+                  (\TEDIT.FIXSEL SEL TEXTOBJ)
+                  (\TEDIT.SHOWSEL SEL T TEXTOBJ)))
           SEL])
 
 (\TEDIT.OPENTEXTSTREAM.WINDOW

@@ -1601,7 +1628,10 @@
          WINDOW])
 
 (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS

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


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 22-Mar-2025 21:37 by rmk")


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


+                                                             (* ; "Edited 29-Dec-2024 20:37 by rmk")


+                                                             (* ; "Edited 20-Dec-2024 11:56 by rmk")


                                                              (* ; "Edited 16-Dec-2024 13:14 by rmk")


                                                              (* ; "Edited 21-Nov-2024 14:35 by rmk")


                                                              (* ; "Edited 29-Aug-2024 09:46 by rmk")


@@ -1620,8 +1650,8 @@
          (* ;; "Find the default font for this TEXTOBJ -- either what the guy tells us, the one from TEDIT.DEFAULT.PROPS, or his DEFAULTFONT.")

 
          (SETQ FONT (OR (GETTEXTPROP
 TEXTOBJ 'FONT)
-                        DEFAULTFONT))
-         (SETQ CHARLOOKS (GETTEXTPROP
 TEXTOBJ 'LOOKS))
+                        (FONTCREATE DEFAULTFONT)))
+         (SETQ CHARLOOKS (GETTEXTPROP
 TEXTOBJ 'CHARLOOKS))
          (SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
                              (AND (type?
 CHARLOOKS FONT)
                                   FONT)
@@ -1629,13 +1659,14 @@
          (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ))
          (SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
                                                      (OR (GETTEXTPROP
 TEXTOBJ 'PARALOOKS)
-                                                         (create
 FMTSPEC using
 TEDIT.DEFAULT.FMTSPEC)
-                                                         )
+                                                         (create
 PARALOOKS using
 
+                                                                                TEDIT.DEFAULT.FMTSPEC
+                                                                ))
                                                      NIL TEXTOBJ)
                                 TEXTOBJ))
          (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS)
          (SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS)
-         (SETTOBJ TEXTOBJ FMTSPEC PARALOOKS])
+         (SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
 
 (\TEDIT.OPENTEXTFILE

   [LAMBDA (TEXT PROPS)
                                       (* ; "Edited 21-Nov-2024 11:38 by rmk")


@@ -1666,7 +1697,8 @@
                (ERROR TEXT " does not identify a Tedit document")))])
 
 (\TEDIT.CREATE.TEXTSTREAM

-  [LAMBDA (PROPS)
                                            (* ; "Edited 16-Mar-2024 09:52 by rmk")


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


+                                                             (* ; "Edited 16-Mar-2024 09:52 by rmk")


                                                              (* ; "Edited 21-Jan-2024 15:16 by rmk")


                                                              (* ; "Edited 17-Sep-2023 00:38 by rmk")


                                                              (* ; "Edited 12-Sep-2023 11:27 by rmk")

@@ -1679,7 +1711,7 @@
          (SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
          (\TEDIT.OPENTEXTSTREAM.PROPS
 TEXTOBJ PROPS)
          (\TEDIT.MAKEPCTB TEXTOBJ)
-         (\TEDIT.INSTALL.PIECE
 TSTREAM (FGETTOBJ TEXTOBJ LASTPIECE)
+         (\TEDIT.INSTALL.PIECE
 TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
                 0)
          TSTREAM])
 
@@ -1954,7 +1986,8 @@
                   (\TEDIT.DELETE TEXTOBJ TAILSEL)))])
 
 (\TEDIT.TEXTGETFILEPTR

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited  7-May-2024 21:14 by rmk")


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


+                                                             (* ; "Edited  7-May-2024 21:14 by rmk")


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


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


                                                              (* ; "Edited 21-Oct-2023 20:57 by rmk")


@@ -1968,7 +2001,7 @@
           (PC (ffetch
 (TEXTSTREAM PIECE) of
 TSTREAM))
           PCCHARSLEFT)
          (if
 (OR (NULL PC)
-                 (\LASTPIECEP PC TEXTOBJ))
+                 (\SUFFIXPIECEP PC TEXTOBJ))
              then
 
                   (* ;; "Not set or off the end")

 
@@ -1977,7 +2010,7 @@
              then
 
                   (* ;; "Replace a lingering piece from a delete-everything?")

 
-                  (freplace
 (TEXTSTREAM PIECE) of
 TSTREAM with
 (FGETTOBJ TEXTOBJ LASTPIECE))
+                  (freplace
 (TEXTSTREAM PIECE) of
 TSTREAM with
 (FGETTOBJ TEXTOBJ SUFFIXPIECE))
                   0
            else
                                              (* ; "Somewhere inside the document")

                 (SETQ PCCHARSLEFT (ffetch
 (TEXTSTREAM PCCHARSLEFT) of
 TSTREAM))
@@ -2087,13 +2120,18 @@
              THEN
 (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE])
 
 (\TEDIT.TEXTLEFTMARGIN

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


+  [LAMBDA (TSTREAM XPOSITION)
                                (* ; "Edited 19-Feb-2025 13:39 by rmk")


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


+                                                             (* ; "Edited 17-Mar-2024 12:30 by rmk")


                                                              (* ; "Edited 31-May-91 14:03 by jds")

-    (IPLUS 8 (fetch
 (FMTSPEC LEFTMAR) of
 (FGETTOBJ (TEXTOBJ TSTREAM)
-                                                FMTSPEC])
+    (IPLUS 8 (GETPLOOKS (FGETTOBJ (TEXTOBJ TSTREAM)
+                               DEFAULTPARALOOKS)
+                    LEFTMAR])
 
 (\TEDIT.TEXTRIGHTMARGIN

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


+  [LAMBDA (TSTREAM XPOSITION)
                                (* ; "Edited 19-Feb-2025 13:39 by rmk")


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


+                                                             (* ; "Edited 28-Jun-2024 22:07 by rmk")


                                                              (* ; "Edited 21-Sep-2023 12:38 by rmk")


                                                              (* ; "Edited 31-May-91 14:03 by jds")

 
@@ -2105,25 +2143,25 @@
 
     (* ;; "If RIGHTMAR is 0 and there is no window (WRIGHT), estimate from the stream's linelength.")

 
-    (* ;; "If \TEDIT.MINIMAL.WINDOW.SETUP sets WRIGHT, maybe that's enough?  I.e. the right margin is either the width of the window or calculated from the LINELENGTH.  It wouldn't depend on the default FMTSPEC or the FMTSPEC of the current piece.")

+    (* ;; "If \TEDIT.MINIMAL.WINDOW.SETUP sets WRIGHT, maybe that's enough?  I.e. the right margin is either the width of the window or calculated from the LINELENGTH.  It wouldn't depend on the default PARALOOKS or the PARALOOKS of the current piece.")

 
     (LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
          (if
 (FGETTOBJ TEXTOBJ PRIMARYPANE)
-             then
 (LET* ((FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
-                         (RIGHTMAR (fetch
 (FMTSPEC RIGHTMAR) of
 FMTSPEC))
+             then
 (LET* ((PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
+                         (RIGHTMAR (FGETPLOOKS PARALOOKS RIGHTMAR))
                          LEFTMAR NEWPOS)
                         (CL:WHEN (ZEROP RIGHTMAR)
-                            (SETQ RIGHTMAR (fetch
 (TEXTOBJ WRIGHT) of
 TEXTOBJ)))
+                            (SETQ RIGHTMAR (FGETTOBJ TEXTOBJ WRIGHT)))
                         (CL:WHEN (AND XPOSITION (NEQ XPOSITION RIGHTMAR))
-                                                             (* ; "Changing the default FMTSPEC")

-                            (SETQ LEFTMAR (fetch
 (FMTSPEC LEFTMAR) of
 FMTSPEC))
+                                                             (* ; "Changing the default PARALOOKS")

+                            (SETQ LEFTMAR (FGETPLOOKS PARALOOKS LEFTMAR))
                             (CL:WHEN (ILEQ RIGHTMAR LEFTMAR)
                                    (\ILLEGAL.ARG XPOSITION))
-                            (FSETTOBJ TEXTOBJ FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS (create
 FMTSPEC
-                                                                                    using
 FMTSPEC 
-                                                                                          RIGHTMAR _
-                                                                                          XPOSITION)
-                                                             TEXTOBJ))
+                            (FSETTOBJ TEXTOBJ DEFAULTPARALOOKS
+                                   (\TEDIT.UNIQUIFY.PARALOOKS (create
 PARALOOKS
+                                                                 using
 PARALOOKS RIGHTMAR _ XPOSITION
+                                                                     )
+                                          TEXTOBJ))
                             (LINELENGTH (IQUOTIENT (IDIFFERENCE RIGHTMAR XPOSITION)
                                                (CHARWIDTH (CHARCODE A)
                                                       TSTREAM))
@@ -2161,6 +2199,190 @@
 
 
 
+(* ;; "Access by character")

+
+(DEFINEQ
+
+(\TEDIT.NTHCHARCODE

+  [LAMBDA (TSTREAM N)
                                        (* ; "Edited 28-Mar-2025 18:31 by rmk")


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


+                                                             (* ; "Edited 29-Apr-2024 13:06 by rmk")


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


+                                                             (* ; "Edited  1-Feb-2024 09:50 by rmk")


+                                                             (* ; "Edited  8-Nov-2023 08:41 by rmk")


+                                                             (* ; "Edited  4-Nov-2023 15:23 by rmk")

+
+    (* ;; "Returns the Nth character of TEXTOBJ.  First character is N=1, NIL if out of bounds.  If TSTREAM is a selection, treats it as a substring, N is relative to that.")

+
+    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+          START-OF-PIECE)
+         (DECLARE
 (SPECVARS START-OF-PIECE))
+         (CL:WHEN (AND (IGEQ N 1)
+                       (ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
+             (\TEDIT.PIECE.NTHCHARCODE
 TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
+                    (IDIFFERENCE (ADD1 N)
+                           START-OF-PIECE)))])
+
+(\TEDIT.PIECE.NTHCHARCODE

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


+                                                             (* ; "Edited 29-Apr-2024 08:46 by rmk")


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


+                                                             (* ; "Edited  1-Feb-2024 09:55 by rmk")


+                                                             (* ; "Edited  6-Jan-2024 16:36 by rmk")


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


+                                                             (* ; "Edited  8-Dec-2023 22:54 by rmk")


+                                                             (* ; "Edited  7-Dec-2023 15:57 by rmk")


+                                                             (* ; "Edited  8-Nov-2023 08:43 by rmk")


+                                                             (* ; "Edited  5-Nov-2023 08:17 by rmk")

+
+    (* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.")

+
+    (CL:WHEN (AND (IGEQ OFFSET 1)
+                  (ILEQ OFFSET (PLEN PC)))
+        [LET ((PCONTENTS (PCONTENTS PC))
+              FILEPOS)
+             (SELECTC (PTYPE PC)
+                 (STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET))
+                 (THINFILE.PTYPE 
+                      (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
+                      (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
+                                                    (SUB1 OFFSET)))
+                      (PROG1 (BIN PCONTENTS)
+                             (\SETFILEPTR PCONTENTS FILEPOS)))
+                 (FATFILE1.PTYPE 
+                      (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
+                      (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
+                                                    (SUB1 OFFSET)))
+                      (PROG1 (create
 WORD
+                                    HIBYTE _ (PCHARSET PC)
+                                    LOBYTE _ (BIN PCONTENTS))
+                             (\SETFILEPTR PCONTENTS FILEPOS)))
+                 (FATFILE2.PTYPE 
+                      (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
+                      (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
+                                                    (UNFOLD (SUB1 OFFSET)
+                                                           2)))
+                      (PROG1 (\WIN PCONTENTS)
+                             (\SETFILEPTR PCONTENTS FILEPOS)))
+                 (UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
+                             [\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
+                                                           (ITIMES (SUB1 OFFSET)
+                                                                  (PBYTESPERCHAR PC]
+                             (PROG1 (UTF8.INCCODEFN PCONTENTS)
+                                    (\SETFILEPTR PCONTENTS FILEPOS)))
+                 (OBJECT.PTYPE PCONTENTS)
+                 (SUBSTREAM.PTYPE                            (* ; "A substream stored as an object")

+                      (\TEDIT.THELP 'SUBSTREAM?)
+                      (BIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
+                 (PROGN 
+                        (* ;; "For pieces not listed because they require more work. Assumes the function updates COFFSET and that multi-byte characters are safe: don't cross buffer boundaries.")

+
+                        (\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
+
+(\TEDIT.RPLCHARCODE

+  [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY)
   (* ; "Edited 28-Mar-2025 10:04 by rmk")

+
+    (* ;; "Replaces the Nth charcode (or object) in TSTREAM with  NEWCHARCODE (or object) with NEWCHARLOOKS.  This is accomplished by isolating the target character into a length 1 piece, then converting that into a string (or object) piece containing NEWCHAR.")

+
+    (* ;; "If DONTDISPLAY, this doesn't update the display.  ")

+
+    (* ;; "NOTE:  this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")

+
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:UNLESS (\TEDIT.READONLY TSTREAM)
+        (PROG ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
+               PC OFFSET START-OF-PIECE OLDCHAR PARALAST)
+              (DECLARE
 (SPECVARS START-OF-PIECE))
+              (replace
 (STREAM BINABLE) of
 TSTREAM with
 NIL)
+              (SETQ PC (\TEDIT.CHTOPC N TEXTOBJ T))
+              (SETQ OFFSET (ADD1 (IDIFFERENCE N START-OF-PIECE)))
+                                                             (* ; "Change is at OFFSET 1")

+              (SETQ PARALAST (MEMB NEWCHARCODE (FGETTOBJ TEXTOBJ PARABREAKCHARS)))
+              [if
 (AND (SMALLP NEWCHARCODE)
+                       (MEMB (PTYPE PC)
+                             STRING.PTYPES)
+                       (OR (NULL NEWCHARLOOKS)
+                           (EQ NEWCHARLOOKS (PLOOKS PC)))
+                       (NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
+                       (NOT PARALAST))
+                  then
 
+                       (* ;; 
+
            "Fast case:  Smash a new character code into an existing string piece with same looks.  ")

+
+                       (SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
+                                            OFFSET))
+                       (RPLCHARCODE (PCONTENTS PC)
+                              OFFSET NEWCHARCODE)            (* ; 
+
                                                             "May upgrade string from thin to fat")

+                       (CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
+                                     (IGREATERP NEWCHARCODE 255))
+                           (FSETPC PC PTYPE FATSTRING.PTYPE)
+                           (FSETPC PC PBINABLE NIL)
+                           (FSETPC PC PBYTESPERCHAR 2)
+                           (FSETPC PC PBYTELEN (UNFOLD (PLEN PC)
+                                                      2)))
+                elseif
 [AND (IMAGEOBJP NEWCHARCODE)
+                            (EQ OBJECT.PTYPE (PTYPE PC))
+                            (OR (NULL NEWCHARLOOKS)
+                                (EQ NEWCHARLOOKS (PLOOKS PC]
+                  then
 (SETQ OLDCHAR (POBJ PC))              (* ; "We know PLEN is 1")

+                       (FSETPC PC PCONTENTS NEWCHARCODE)
+                else
 
+                     (* ;; 
+
                     "The PC that contained character N becomes the suffix of characters after N,  ")

+
+                     (CL:UNLESS (IEQP OFFSET (PLEN PC))      (* ; "No suffix for the last character")

+
+                         (* ;; 
+
       "Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")

+
+                         (\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
+                         (SETQ PC (PREVPIECE PC)))           (* ; 
+
                                    "Original PC holds the suffix, new PC ends with change position.")

+                     (CL:UNLESS (EQ OFFSET 1)
+                         (SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
+                                         TEXTOBJ)))          (* ; 
+
                                               "Chop off the prefix. PC is now the singleton target ")

+
+                     (* ;; "N is now isolated into a one-character new piece which we smash.  ")

+
+                     (SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE
 TEXTOBJ PC 1))
+                     (if
 (IMAGEOBJP NEWCHARCODE)
+                         then
 (FSETPC PC PBINABLE NIL)
+                              (FSETPC PC PCONTENTS NEWCHARCODE)
+                              (FSETPC PC PTYPE OBJECT.PTYPE)
+                              (FSETPC PC PBYTESPERCHAR NIL)  (* ; "Doesn't make sense for objects")

+                              (FSETPC PC PBYTELEN NIL)
+                       else
 (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE))) 
+                                                             (* ; 
+
                                              "Use the extend-string in INSERTCH for repeated calls?")

+                            (if
 (IGREATERP NEWCHARCODE 255)
+                                then
 (FSETPC PC PTYPE FATSTRING.PTYPE)
+                                     (FSETPC PC PBINABLE NIL)
+                                     (FSETPC PC PBYTESPERCHAR 2)
+                                     (FSETPC PC PBYTELEN 2)
+                              else
 (FSETPC PC PTYPE THINSTRING.PTYPE)
+                                   (FSETPC PC PBINABLE T)
+                                   (FSETPC PC PBYTESPERCHAR 1)
+                                   (FSETPC PC PBYTELEN 1)
+                                   (FSETPC PC PCHARSET 0)))
+                     (FSETPC PC PFPOS NIL)
+                     (CL:WHEN NEWCHARLOOKS
+                         (FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS)
+                                               (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
+                                                                           NEWCHARLOOKS)
+                                                      TEXTOBJ)
+                                               NEWCHARLOOKS)))]
+              (CL:WHEN PARALAST (FSETPC PC PPARALAST T))
+              (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL 
+                                                OLDCHAR))
+              (CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
+                  (\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED N 1))
+              (RETURN TSTREAM)))])
+)
+
+
+
 (* ;; "Editing support")

 
 (DECLARE%: EVAL@COMPILE DONTCOPY 
@@ -2191,7 +2413,8 @@
 (DEFINEQ
 
 (\TEDIT.DELETE.SELPIECES

-  [LAMBDA (TEXTOBJ FIRSTCHAR LEN)
                            (* ; "Edited 26-Nov-2024 22:31 by rmk")


+  [LAMBDA (TEXTOBJ FIRSTCHAR LEN DONTCHECK)
                  (* ; "Edited  5-Feb-2025 23:33 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 22:31 by rmk")


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


                                                              (* ; "Edited  7-Jul-2024 09:09 by rmk")


                                                              (* ; "Edited  7-May-2024 21:14 by rmk")


@@ -2211,10 +2434,10 @@
     (CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
         (\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'START TEXTOBJ)
         (LET (SELPIECES PREVPC)
-             (CL:WHEN (AND (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
+             (CL:WHEN [AND (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
                                                   TEXTOBJ))
-                           (for
 PC inselpieces
 (PROGN SELPIECES) always
 (OBJECT.ALLOWS PC
-                                                                               'DELETE TEXTOBJ)))
+                           (OR DONTCHECK (for
 PC inselpieces
 (PROGN SELPIECES)
+                                            always
 (OBJECT.ALLOWS PC 'DELETE TEXTOBJ]
                  (SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST)))
                  (\TEDIT.DELETEPIECES SELPIECES TEXTOBJ)
 
@@ -2240,7 +2463,8 @@
                  T)))])
 
 (\TEDIT.INSERTCH

-  [LAMBDA (CH CH# TEXTOBJ PARALAST)
                          (* ; "Edited 22-Nov-2024 13:48 by rmk")


+  [LAMBDA (CH CH# TEXTOBJ PARALAST)
                          (* ; "Edited 26-Mar-2025 00:29 by rmk")


+                                                             (* ; "Edited 22-Nov-2024 13:48 by rmk")


                                                              (* ; "Edited 22-Sep-2024 12:32 by rmk")


                                                              (* ; "Edited 13-Aug-2024 08:30 by rmk")


                                                              (* ; "Edited 18-May-2024 19:04 by rmk")


@@ -2330,12 +2554,11 @@
                           (FSETPC PREVPC PBYTELEN ILEN)
                           (FSETPC PREVPC PBINABLE T)
                           (FSETPC PREVPC PCHARSET 0))
-                     (FATSTRING.PTYPE 
+                     (FATSTRING.PTYPE                        (* ; "PCHARSET is not relevant")

                           (FSETPC PREVPC PBYTESPERCHAR 2)
                           (FSETPC PREVPC PBYTELEN (UNFOLD ILEN 2))
-                          (FSETPC PREVPC PBINABLE NIL)
-                          (FSETPC PREVPC PCHARSET \NORUNCODE))
-                     NIL)
+                          (FSETPC PREVPC PBINABLE NIL))
+                     (\TEDIT.THELP "Unexpected PTYPE"))
                  (\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))
 
      (* ;; "The insertion is done and the pieces are properly integrated into the stream. ")

@@ -2681,7 +2904,9 @@
                                                        (CADR PTAIL])
 
 (\TEDIT.TEXTPROP

-  [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE)
                (* ; "Edited 22-Dec-2024 00:23 by rmk")


+  [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE)
                (* ; "Edited 16-Feb-2025 23:27 by rmk")


+                                                             (* ; "Edited 15-Feb-2025 14:02 by rmk")


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


                                                              (* ; "Edited 23-Nov-2024 09:47 by rmk")


                                                              (* ; "Edited 21-Nov-2024 11:53 by rmk")


                                                              (* ; "Edited 18-Nov-2024 16:37 by rmk")


@@ -2723,7 +2948,7 @@
         (DON'TUPDATE (PROG1 (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)
                          (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NEWVALUE))))
         (NOTSPLITTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
-                           (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE T))))
+                           (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE NEWVALUE))))
         (DIRTY (PROG1 (FGETTOBJ TEXTOBJ \XDIRTY)
                    (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ \DIRTY NEWVALUE))))
         (LENGTH (PROG1 (FGETTOBJ TEXTOBJ TEXTLEN)
@@ -2751,6 +2976,11 @@
                              (fetch
 FULLFILENAME of
 (FGETTOBJ TEXTOBJ TXTFILE)))
                       (CL:WHEN (AND SETNEWVALUE (NEQ NEWVALUE NIL))
                              (ERROR "FILENAME cannot be changed"))))
+        (FILESTREAM (PROG1 (FGETTOBJ TEXTOBJ TXTFILE)
+                        (CL:WHEN SETNEWVALUE
+                            (CL:WHEN (AND NEWVALUE (NOT (type?
 STREAM NEWVALUE)))
+                                   (\ILLEGAL.ARG NEWVALUE))
+                            (FSETTOBJ TEXTOBJ TXTFILE NEWVALUE))))
         (PAGEFORMAT (PROG1 (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)
                         (CL:WHEN SETNEWVALUE
                             (CL:UNLESS (type?
 PAGEREGION NEWVALUE)
@@ -2839,31 +3069,32 @@
 (ADDTOVAR LAMA
 TEXTPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (36657 67258 (\TEDIT.TEXTBIN 36667 . 47417) (\TEDIT.TEXTPEEKBIN 47419 . 52969) (
-\TEDIT.TEXTBACKFILEPTR 52971 . 58644) (\TEDIT.TEXTBOUT 58646 . 63048) (\TEDIT.INSTALL.FILEBUFFER 63050
- . 67256)) (68156 72204 (\TEDIT.TEXTOUTCHARFN 68166 . 69722) (\TEDIT.TEXTINCCODEFN 69724 . 70463) (
-\TEDIT.TEXTBACKCCODEFN 70465 . 71057) (\TEDIT.TEXTFORMATBYTESTREAM 71059 . 71762) (
-\TEDIT.TEXTFORMATBYTESTRING 71764 . 72202)) (72251 82942 (OPENTEXTSTREAM 72261 . 78678) (
-COPYTEXTSTREAM 78680 . 82165) (TEDIT.STREAMCHANGEDP 82167 . 82469) (TXTFILE 82471 . 82940)) (82943 
-112098 (\TEDIT.REOPENTEXTSTREAM 82953 . 84305) (\TEDIT.OPENTEXTSTREAM.PIECES 84307 . 88737) (
-\TEDIT.OPENTEXTSTREAM.PROPS 88739 . 89841) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 89843 . 94778) (
-\TEDIT.OPENTEXTSTREAM.WINDOW 94780 . 97461) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 97463 . 99990) (
-\TEDIT.OPENTEXTFILE 99992 . 101705) (\TEDIT.CREATE.TEXTSTREAM 101707 . 102641) (\TEDIT.REOPEN.STREAM 
-102643 . 104979) (\TEDIT.TEXTINIT 104981 . 112096)) (112136 113324 (\TEDIT.TTYBOUT 112146 . 113322)) (
-113442 131819 (\TEDIT.TEXTCLOSEF 113452 . 114776) (\TEDIT.TEXTDSPFONT 114778 . 115748) (
-\TEDIT.TEXTEOFP 115750 . 117505) (\TEDIT.TEXTGETEOFPTR 117507 . 117830) (\TEDIT.TEXTSETEOFPTR 117832
- . 118922) (\TEDIT.TEXTGETFILEPTR 118924 . 121646) (\TEDIT.TEXTSETFILEINFO 121648 . 122156) (
-\TEDIT.TEXTOPENF 122158 . 123089) (\TEDIT.TEXTSETEOF 123091 . 123707) (\TEDIT.TEXTSETFILEPTR 123709 . 
-125750) (\TEDIT.TEXTDSPXPOSITION 125752 . 126769) (\TEDIT.TEXTDSPYPOSITION 126771 . 127512) (
-\TEDIT.TEXTLEFTMARGIN 127514 . 127891) (\TEDIT.TEXTRIGHTMARGIN 127893 . 130968) (
-\TEDIT.TEXTDSPCHARWIDTH 130970 . 131274) (\TEDIT.TEXTDSPSTRINGWIDTH 131276 . 131582) (
-\TEDIT.TEXTDSPLINEFEED 131584 . 131817)) (132866 153517 (\TEDIT.DELETE.SELPIECES 132876 . 136303) (
-\TEDIT.INSERTCH 136305 . 144099) (\TEDIT.INSERTCH.HISTORY 144101 . 147565) (\TEDIT.INSERTEOL 147567 . 
-149392) (\TEDIT.INSERTCH.INSERTION 149394 . 152231) (\TEDIT.INSERTCH.EXTEND 152233 . 153515)) (153518 
-155022 (\TEDIT.NEXTCHANGEABLE.CHNO 153528 . 154243) (\TEDIT.LASTCHANGEABLE.CHNO 154245 . 155020)) (
-155023 156727 (\SETUPGETCH 155033 . 156725)) (156785 161243 (\TEDIT.INSTALL.PIECE 156795 . 161241)) (
-161281 169493 (TEXTPROP 161291 . 161638) (GETTEXTPROP 161640 . 161884) (PUTTEXTPROP 161886 . 162143) (
-GETTEXTPROPS 162145 . 162589) (PUTTEXTPROPS 162591 . 163495) (\TEDIT.TEXTPROP 163497 . 169491)) (
-169494 171564 (\TEDIT.TEXTOBJ.PROPNAMES 169504 . 170456) (\TEDIT.TEXTOBJ.PROPFETCHFN 170458 . 170974) 
-(\TEDIT.TEXTOBJ.PROPSTOREFN 170976 . 171562)))))
+  (FILEMAP (NIL (37315 68029 (\TEDIT.TEXTBIN 37325 . 48075) (\TEDIT.TEXTPEEKBIN 48077 . 53627) (
+\TEDIT.TEXTBACKFILEPTR 53629 . 59302) (\TEDIT.TEXTBOUT 59304 . 63819) (\TEDIT.INSTALL.FILEBUFFER 63821
+ . 68027)) (68927 72975 (\TEDIT.TEXTOUTCHARFN 68937 . 70493) (\TEDIT.TEXTINCCODEFN 70495 . 71234) (
+\TEDIT.TEXTBACKCCODEFN 71236 . 71828) (\TEDIT.TEXTFORMATBYTESTREAM 71830 . 72533) (
+\TEDIT.TEXTFORMATBYTESTRING 72535 . 72973)) (73022 84543 (OPENTEXTSTREAM 73032 . 79984) (
+COPYTEXTSTREAM 79986 . 83766) (TEDIT.STREAMCHANGEDP 83768 . 84070) (TXTFILE 84072 . 84541)) (84544 
+114404 (\TEDIT.REOPENTEXTSTREAM 84554 . 85906) (\TEDIT.OPENTEXTSTREAM.PIECES 85908 . 90338) (
+\TEDIT.OPENTEXTSTREAM.PROPS 90340 . 91442) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91444 . 96530) (
+\TEDIT.OPENTEXTSTREAM.WINDOW 96532 . 99213) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99215 . 102185) (
+\TEDIT.OPENTEXTFILE 102187 . 103900) (\TEDIT.CREATE.TEXTSTREAM 103902 . 104947) (\TEDIT.REOPEN.STREAM 
+104949 . 107285) (\TEDIT.TEXTINIT 107287 . 114402)) (114442 115630 (\TEDIT.TTYBOUT 114452 . 115628)) (
+115748 134540 (\TEDIT.TEXTCLOSEF 115758 . 117082) (\TEDIT.TEXTDSPFONT 117084 . 118054) (
+\TEDIT.TEXTEOFP 118056 . 119811) (\TEDIT.TEXTGETEOFPTR 119813 . 120136) (\TEDIT.TEXTSETEOFPTR 120138
+ . 121228) (\TEDIT.TEXTGETFILEPTR 121230 . 124065) (\TEDIT.TEXTSETFILEINFO 124067 . 124575) (
+\TEDIT.TEXTOPENF 124577 . 125508) (\TEDIT.TEXTSETEOF 125510 . 126126) (\TEDIT.TEXTSETFILEPTR 126128 . 
+128169) (\TEDIT.TEXTDSPXPOSITION 128171 . 129188) (\TEDIT.TEXTDSPYPOSITION 129190 . 129931) (
+\TEDIT.TEXTLEFTMARGIN 129933 . 130524) (\TEDIT.TEXTRIGHTMARGIN 130526 . 133689) (
+\TEDIT.TEXTDSPCHARWIDTH 133691 . 133995) (\TEDIT.TEXTDSPSTRINGWIDTH 133997 . 134303) (
+\TEDIT.TEXTDSPLINEFEED 134305 . 134538)) (134578 145928 (\TEDIT.NTHCHARCODE 134588 . 135938) (
+\TEDIT.PIECE.NTHCHARCODE 135940 . 139741) (\TEDIT.RPLCHARCODE 139743 . 145926)) (146975 167848 (
+\TEDIT.DELETE.SELPIECES 146985 . 150498) (\TEDIT.INSERTCH 150500 . 158430) (\TEDIT.INSERTCH.HISTORY 
+158432 . 161896) (\TEDIT.INSERTEOL 161898 . 163723) (\TEDIT.INSERTCH.INSERTION 163725 . 166562) (
+\TEDIT.INSERTCH.EXTEND 166564 . 167846)) (167849 169353 (\TEDIT.NEXTCHANGEABLE.CHNO 167859 . 168574) (
+\TEDIT.LASTCHANGEABLE.CHNO 168576 . 169351)) (169354 171058 (\SETUPGETCH 169364 . 171056)) (171116 
+175574 (\TEDIT.INSTALL.PIECE 171126 . 175572)) (175612 184361 (TEXTPROP 175622 . 175969) (GETTEXTPROP 
+175971 . 176215) (PUTTEXTPROP 176217 . 176474) (GETTEXTPROPS 176476 . 176920) (PUTTEXTPROPS 176922 . 
+177826) (\TEDIT.TEXTPROP 177828 . 184359)) (184362 186432 (\TEDIT.TEXTOBJ.PROPNAMES 184372 . 185324) (
+\TEDIT.TEXTOBJ.PROPFETCHFN 185326 . 185842) (\TEDIT.TEXTOBJ.PROPSTOREFN 185844 . 186430)))))
 STOP

library/tedit/TEDIT-STYLES

@@ -0,0 +1,234 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "19-Feb-2025 13:31:28" {WMEDLEY}<library>tedit>TEDIT-STYLES.;4
 12550  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES)
+
+      :PREVIOUS-DATE "12-Feb-2025 12:18:37" {WMEDLEY}<library>tedit>TEDIT-STYLES.;3)
+
+
+(PRETTYCOMPRINT TEDIT-STYLESCOMS)
+
+(RPAQQ TEDIT-STYLESCOMS

+       (                                                     (* ; "Style-sheet support")

+        (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET 
+             TEDIT.PUSH.STYLESHEET TEDIT.ADD.STYLESHEET)
+        
+        (* ;; "*TEDIT-PARASTYLE-CACHE* is an ALIST of  original char/para looks to styled char/para looks.  It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles.")

+
+        
+        (* ;; "*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are.  Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries.  Mostly, this'll be NIL and not interesting.")

+
+        
+        (* ;; "*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly.  This is the push-stack, in effect.  Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET")

+
+        (INITVARS (TEDIT.STYLES))
+        
+        (* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")

+
+        (GLOBALVARS TEDIT.STYLES)
+        (INITVARS (*TEDIT-PARASTYLE-CACHE*)
+               (*TEDIT-CURRENTPARA-CACHE*)
+               (*TEDIT-STYLESHEET-SAVE-LIST*))
+        (GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)))
+
+
+
+(* ; "Style-sheet support")

+
+(DEFINEQ
+
+(\TEDIT.APPLY.STYLES

+  [LAMBDA (LOOKS PC TSTREAM)
                                 (* ; "Edited 19-Feb-2025 13:31 by rmk")


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


+                                                             (* ; "Edited 12-Nov-2023 16:08 by rmk")


+                                                             (* ; "Edited 18-Mar-2023 21:45 by rmk")


+                                                             (* ; "Edited 25-Sep-2022 13:28 by rmk")


+                                                             (* ; "Edited 11-Sep-2022 14:45 by rmk")

+                                                             (* ; 
+
                                                        "Edited  4-Jul-93 01:02 by sybalskY:MV:ENVOS")

+
+    (* ;; "Given a set of looks, return the looks with the proper styles expanded out.")

+
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*))
+        (CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*))
+        (LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
+               (STYLE (GETCLOOKS LOOKS CLSTYLE))
+               (STYLE-SHEET (OR (FGETTOBJ TEXTOBJ TXTSTYLESHEET)
+                                TEDIT.STYLES))
+               NOSTYLE CHARSTYLES CHARSTYLE IN-PARA)
+              (SETQ STYLE (COND
+                             ((NULL STYLE)                   (* ; 
+
                                       "STYLE of NIL means don't bother.  Just use the looks we got.")

+                              (SETQ NOSTYLE T)
+                              LOOKS)
+                             ((AND (SETQ CHARSTYLES (AND (GETTSTR TSTREAM CURRENTPARALOOKS)
+                                                         (GETPLOOKS (GETTSTR TSTREAM CURRENTPARALOOKS
+                                                                           )
+                                                                FMTCHARSTYLES)))
+                                   (SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES)))
+                                                             (* ; 
+
                   "If the paragraph we're in has character styles, and this is one of them, use it.")

+                              (SETQ IN-PARA T)
+                              CHARSTYLE)
+                             ((CDR (SASSOC STYLE STYLE-SHEET)))
+                             ((AND (LITATOM STYLE)
+                                   (DEFINEDP STYLE))         (* ; 
+
                                                      "Call the guy's function to find the new looks")

+                              (APPLY* STYLE LOOKS PC TEXTOBJ))
+                             (T                              (* ; 
+
                                                "If all else fails, return the original set of looks")

+                                (SETQ NOSTYLE T)
+                                LOOKS)))
+              (SETQ STYLE (COND
+                             ((LISTP STYLE)
+                              (\TEDIT.PARSE.CHARLOOKS.LIST (APPEND STYLE '(STYLE NIL))
+                                     LOOKS TEXTOBJ))
+                             (T STYLE)))
+
+              (* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.")

+
+              [OR NOSTYLE (CL:IF IN-PARA
+                              (push
 *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE))
+                              (push
 *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))]
+              STYLE])
+
+(\TEDIT.APPLY.PARASTYLES

+  [LAMBDA (PARALOOKS PC TEXTOBJ)
                             (* ; "Edited 19-Feb-2025 13:31 by rmk")


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


+                                                             (* ; "Edited  4-Aug-2024 14:48 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 11:06 by rmk")


+                                                             (* ; "Edited  4-Mar-2023 22:23 by rmk")


+                                                             (* ; "Edited 25-Sep-2022 13:26 by rmk")

+                                                             (* ; 
+
                                                        "Edited  3-Jul-93 23:15 by sybalskY:MV:ENVOS")

+
+    (* ;; "Given a set of looks, return the looks with the proper styles expanded out.")

+
+    (\TEDIT.CHECK (type?
 PARALOOKS PARALOOKS))               (* ; "Incoming thing has to be a LOOKS.")

+    (OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*))
+        (LET* [NOSTYLE (STYLE-SHEET (OR (fetch
 (TEXTOBJ TXTSTYLESHEET) of
 TEXTOBJ)
+                                        TEDIT.STYLES))
+                     (STYLE (COND
+                               ((NULL (GETPLOOKS PARALOOKS FMTSTYLE))
+                                (SETQ NOSTYLE T)
+                                PARALOOKS)
+                               ((CDR (SASSOC (GETPLOOKS PARALOOKS FMTSTYLE)
+                                            STYLE-SHEET)))
+                               ((AND (LITATOM (GETPLOOKS PARALOOKS FMTSTYLE))
+                                     (DEFINEDP (GETPLOOKS PARALOOKS FMTSTYLE)))
+                                                             (* ; 
+
                                                      "Call the guy's function to find the new looks")

+                                (APPLY* (GETPLOOKS PARALOOKS FMTSTYLE)
+                                       PARALOOKS PC TEXTOBJ))
+                               (T (SETQ NOSTYLE T)
+                                  PARALOOKS]
+              (CL:WHEN (LISTP STYLE)
+                  (SETQ STYLE (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL))
+                                     PARALOOKS TEXTOBJ)))
+              (CL:UNLESS NOSTYLE
+                  (push
 *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE)))
+              STYLE])
+
+(TEDIT.STYLESHEET

+  [LAMBDA (SHEET TEXTSTREAM)                                 (* ; 
+
                                                        "Edited  3-Jul-93 23:19 by sybalskY:MV:ENVOS")

+
+    (* ;; "Put a new stylesheet into force.  This REPLACES any existing style sheets, and forgets any pushed sheets.")

+
+    (LET [(TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM]
+         (COND
+            (TEXTOBJ (SETQ *TEDIT-PARASTYLE-CACHE* NIL)      (* ; 
+
                                                             "Clear the cache, to force reformatting")

+                   (replace
 (TEXTOBJ TXTSTYLESHEET) of
 TEXTOBJ with
 SHEET))
+            (T 
+               (* ;; "No specific document given; change the global style sheet TEDIT.STYLES")

+
+               (SETQ *TEDIT-PARASTYLE-CACHE* NIL)            (* ; 
+
                                                             "Clear the cache, to force reformatting")

+               (SETQ TEDIT.STYLES SHEET)
+               (SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
+
+(TEDIT.POP.STYLESHEET

+  [LAMBDA NIL                                                (* ; 
+
                                                        "Edited  3-Jul-93 17:42 by sybalskY:MV:ENVOS")

+
+    (* ;; "Go back to an earlier stylesheet, by popping the stack of saved sheets.  You can't pop back to no sheet -- you'll always bottom out at the original style sheet.")

+
+    (SETQ *TEDIT-PARASTYLE-CACHE* NIL)                       (* ; 
+
                                                             "Clear the cache, to force reformatting")

+    (SETQ TEDIT.STYLES (OR (CL:POP *TEDIT-STYLESHEET-SAVE-LIST*)
+                           TEDIT.STYLES])
+
+(TEDIT.PUSH.STYLESHEET

+  [LAMBDA (SHEET)                                            (* ; 
+
                                                        "Edited  3-Jul-93 17:40 by sybalskY:MV:ENVOS")

+
+    (* ;; "Add more style definitions to the current style sheet, and remember how to get back to the old one.  Think of this as PUSHING onto a stack of stylesheets, with the new sheet being a composition of SHEET and the existing styles.  ")

+
+    (SETQ *TEDIT-PARASTYLE-CACHE* NIL)                       (* ; 
+
                                                             "Clear the cache, to force reformatting")

+    (SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
+    (CL:PUSH TEDIT.STYLES *TEDIT-STYLESHEET-SAVE-LIST*])
+
+(TEDIT.ADD.STYLESHEET

+  [LAMBDA (SHEET)                                            (* ; 
+
                                                        "Edited  3-Jul-93 17:38 by sybalskY:MV:ENVOS")

+
+    (* ;; "Add more style definitions to the current style sheet.  This ADDS entries, without remembering that there was an earlier sheet. ")

+
+    (SETQ *TEDIT-PARASTYLE-CACHE* NIL)                       (* ; 
+
                                                             "Clear the cache, to force reformatting")

+    (SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
+    (SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
+)
+
+
+
+(* ;; 
+"*TEDIT-PARASTYLE-CACHE* is an ALIST of  original char/para looks to styled char/para looks.  It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles."
+)

+
+
+
+
+(* ;; 
+"*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are.  Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries.  Mostly, this'll be NIL and not interesting."
+)

+
+
+
+
+(* ;; 
+"*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly.  This is the push-stack, in effect.  Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET"
+)

+
+
+(RPAQ? TEDIT.STYLES
 )
+
+
+
+(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")

+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS TEDIT.STYLES)
+)
+
+(RPAQ? *TEDIT-PARASTYLE-CACHE*
 )
+
+(RPAQ? *TEDIT-CURRENTPARA-CACHE*
 )
+
+(RPAQ? *TEDIT-STYLESHEET-SAVE-LIST*
 )
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1980 11244 (\TEDIT.APPLY.STYLES 1990 . 5638) (\TEDIT.APPLY.PARASTYLES 5640 . 8118) (
+TEDIT.STYLESHEET 8120 . 9187) (TEDIT.POP.STYLESHEET 9189 . 9857) (TEDIT.PUSH.STYLESHEET 9859 . 10599) 
+(TEDIT.ADD.STYLESHEET 10601 . 11242)))))
+STOP

library/tedit/TEDIT-TFBRAVO

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163
 92210  
+
(FILECREATED "28-Mar-2025 14:23:07" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;176
 94631  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS)
+      :CHANGES-TO (FNS TEDITFROMBRAVO)
 
-      :PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;162)
+      :PREVIOUS-DATE "19-Feb-2025 12:18:40" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;175)
 
 
 (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -72,10 +72,10 @@
 (RECORD BRAVOFONT
 (BFFONTNUM BRFAMILY BRSIZE BRWEIGHT BRSLOPE))
 
 (RECORD PARA
 (PARAFMTSPEC RUNS FORMATPTRS)
-             (ACCESSFNS (PARATABDEFS (fetch
 (FMTSPEC FMTUSERINFO) of
 (fetch
 (PARA PARAFMTSPEC)
-                                                                        of
 DATUM))
-                               (replace
 (FMTSPEC FMTUSERINFO) of
 (fetch
 (PARA PARAFMTSPEC)
-                                                                    of
 DATUM) with
 NEWVALUE))))
+             (ACCESSFNS (PARATABDEFS (GETPLOOKS (fetch
 (PARA PARAFMTSPEC) of
 DATUM)
+                                            FMTUSERINFO)
+                               (FSETPLOOKS (fetch
 (PARA PARAFMTSPEC) of
 DATUM)
+                                      FMTUSERINFO NEWVALUE))))
 
 (RECORD RUN
 (RUNLENGTH RUNLOOKS RUNSTART RUNLAST)
             (ACCESSFNS (RUNTABS (fetch
 (CHARLOOKS CLUSERINFO) of
 (fetch
 (RUN RUNLOOKS) of
 DATUM))
@@ -170,7 +170,11 @@
           (RETURN T])
 
 (TEDITFROMBRAVO

-  [LAMBDA (BFILE TEXTSTREAM PROPS USER.CM)
                   (* ; "Edited 17-Jan-2024 12:11 by rmk")


+  [LAMBDA (BFILE TSTREAM PROPS USER.CM)
                      (* ; "Edited 28-Mar-2025 14:16 by rmk")


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


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


+                                                             (* ; "Edited  2-Jan-2025 22:22 by rmk")


+                                                             (* ; "Edited 17-Jan-2024 12:11 by rmk")


                                                              (* ; "Edited 26-Nov-2023 00:29 by rmk")


                                                              (* ; "Edited 14-Nov-2023 17:09 by rmk")


                                                              (* ; "Edited 22-Sep-2023 08:53 by rmk")


@@ -182,13 +186,13 @@
 (* ;;; "Top level entry for conversion from a Bravo file to a textstream.  The textstream is returned,  %"Writing%" here means sticking it in the textstream, not saving to a Tedit file.  Assumes that a stream BFILE is positioned at the first byte to be included.")

 
     (RESETLST
-        (CL:UNLESS TEXTSTREAM
-            (SETQ TEXTSTREAM (OPENTEXTSTREAM NIL)))          (* ; 
+        (CL:UNLESS TSTREAM
+            (SETQ TSTREAM (OPENTEXTSTREAM NIL)))             (* ; 
 
                                                     " Produce the USER.CM's alist of default values")

-        (bind
 PARA NEXTFMTSPEC USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST START (BSTREAM _ BFILE
-                                                                                            )
-              (TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare
 (SPECVARS USER.CM.FMTSPEC USER.CM.CHARLOOKS 
-                                                              USER.CM.ALIST)
+        (bind
 PARA NEXTPARALOOKS USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST START
+              (BSTREAM _ BFILE)
+              (TEXTOBJ _ (TEXTOBJ TSTREAM)) declare
 (SPECVARS USER.CM.PARALOOKS USER.CM.CHARLOOKS 
+                                                           USER.CM.ALIST)
            first
 (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM
 BFILE USER.CM TEXTOBJ))
                                                              (* ; "Go for plain text")

                      (RETURN))
@@ -201,31 +205,35 @@
                  (PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT)
                  [RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
                         `(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE]
-                 (SETQ NEXTFMTSPEC USER.CM.FMTSPEC) eachtime
 (SETQ START (GETFILEPTR BSTREAM)) 
+                 (SETQ NEXTPARALOOKS USER.CM.PARALOOKS) eachtime
 (SETQ START (GETFILEPTR BSTREAM)) 
                                                              (* ; 
 
                                                             "Profiles and headings have to back up")

-                                                          (SETQ PARA (\TFBRAVO.PARSE.PARA
 NEXTFMTSPEC
-                                                                            BSTREAM TEXTOBJ)) 
+                                                              (SETQ PARA (\TFBRAVO.PARSE.PARA
 
+                                                                                NEXTPARALOOKS BSTREAM
+                                                                                TEXTOBJ)) 
 
-                                                          (* ;; "No runs signals the very end")

- while
 (fetch
 (PARA RUNS) of
 PARA) do
 (SETQ NEXTFMTSPEC (fetch
 (PARA PARAFMTSPEC) of
 PARA)) 
+                                                              (* ;; "No runs signals the very end")

+ while
 (fetch
 (PARA RUNS) of
 PARA) do
 (SETQ NEXTPARALOOKS (fetch
 (PARA PARAFMTSPEC) of
 PARA)) 
 
                                       (* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text")

 
-                                      (CL:UNLESS (AND (EQ 'PROFILE (fetch
 (FMTSPEC FMTPARATYPE)
-                                                                      of
 NEXTFMTSPEC))
+                                      (CL:UNLESS (AND (EQ 'PROFILE (GETPLOOKS NEXTPARALOOKS 
+                                                                          FMTPARATYPE))
                                                       (\TFBRAVO.PARSE.PROFILE.PARA
 BSTREAM PARA 
                                                              TEXTOBJ START))
                                              (\TFBRAVO.INSERT.PARA
 PARA BSTREAM TEXTOBJ))
-           finally
 (\TFBRAVO.INSTALL.PAGEFORMAT
 TEXTOBJ)
-                 (\TEDIT.UNIQUIFY.ALL TEXTOBJ)               (* ; "Lists are complete and unique")

+           finally
 (\TFBRAVO.INSTALL.PAGEFORMAT
 TEXTOBJ) 
+
+                 (* ;; "Named tab information is collected in the userinfo fields, but then ignored.")

+
                  (for
 PARALOOKS in
 (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
-                    do
 (replace
 (FMTSPEC FMTUSERINFO) of
 PARALOOKS with
 NIL))
+                    do
 (SETPLOOKS PARALOOKS FMTUSERINFO NIL))
                  (for
 CHARLOOKS in
 (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
-                    do
 (replace
 (CHARLOOKS CLUSERINFO) of
 CHARLOOKS with
 NIL))
-                 (\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ)
+                    do
 (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
+                 (\TEDIT.UNIQUIFY.ALL TEXTOBJ)               (* ; "Lists are complete and unique")

+                 (\TEDIT.TRANSLATE.ASCIICHARS TSTREAM)
                  (TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
-                 (RETURN TEXTSTREAM)))])
+                 (RETURN TSTREAM)))])
 )
 
 (ADDTOVAR TEDIT.INPUT.FORMATS
 (TEDIT.BRAVOFILE? TEDITFROMBRAVO))
@@ -282,22 +290,23 @@
           (RETURN USER.CM])
 
 (\TFBRAVO.USER.CM.LOOKS

-  [LAMBDA (USER.CM TEXTOBJ)
                                  (* ; "Edited 18-Aug-2023 18:47 by rmk")


+  [LAMBDA (USER.CM TEXTOBJ)
                                  (* ; "Edited  8-Feb-2025 22:13 by rmk")


+                                                             (* ; "Edited  2-Jan-2025 11:06 by rmk")


+                                                             (* ; "Edited 18-Aug-2023 18:47 by rmk")


                                                              (* ; "Edited 16-Aug-2023 21:33 by rmk")


                                                              (* ; "Edited  5-Aug-2023 17:15 by rmk")

-    (DECLARE
 (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST))
+    (DECLARE
 (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST))
     (SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM
 USER.CM))
     (SETQ USER.CM.CHARLOOKS (create
 CHARLOOKS
-                                   CLNAME _ (\TFBRAVO.GETFONT 0 BRFAMILY)
-                                   CLSIZE _ (\TFBRAVO.GETFONT 0 BRSIZE)
                                    CLOFFSET _ 0))
-    (\TFBRAVO.FONT.FROM.CHARLOOKS
 USER.CM.CHARLOOKS)
+    (\TFBRAVO.FONT.FROM.CHARLOOKS
 USER.CM.CHARLOOKS (\TFBRAVO.GETFONT 0 BRFAMILY)
+           (\TFBRAVO.GETFONT 0 BRSIZE))
     (\TFBRAVO.INIT.PAGEFORMAT
 TEXTOBJ)
-    (SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS
 USER.CM.ALIST))
+    (SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS
 USER.CM.ALIST))
     (SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ))
-    (SETQ USER.CM.FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.FMTSPEC TEXTOBJ))
+    (SETQ USER.CM.PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.PARALOOKS TEXTOBJ))
     (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS USER.CM.CHARLOOKS)
-    (SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
+    (SETTOBJ TEXTOBJ DEFAULTPARALOOKS USER.CM.PARALOOKS])
 
 (\TFBRAVO.READ.USER.CM

   [LAMBDA (USER.CM)
                                          (* ; "Edited 27-Aug-2024 18:12 by rmk")


@@ -378,7 +387,8 @@
               (GO LLP)))])
 
 (\TFBRAVO.INIT.PARALOOKS

-  [LAMBDA (ALIST)
                                            (* ; "Edited  4-Aug-2024 22:17 by rmk")


+  [LAMBDA (ALIST)
                                            (* ; "Edited  8-Feb-2025 22:09 by rmk")


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


                                                              (* ; "Edited 28-Jul-2024 21:36 by rmk")


                                                              (* ; "Edited 13-Aug-2023 11:27 by rmk")


                                                              (* ; "Edited  8-Aug-2023 23:51 by rmk")


@@ -387,12 +397,12 @@
 
     (* ;; "creates the default paragraph looks from the USER.CM.  The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points.  ")

 
-    (LET ((INITFMTSPEC (create
 FMTSPEC using
 TEDIT.DEFAULT.FMTSPEC)))
+    (LET ((INITPARALOOKS (create
 PARALOOKS using
 TEDIT.DEFAULT.FMTSPEC)))
 
          (* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60.  I'm going with 36.")

 
-         (with
 FMTSPEC INITFMTSPEC (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
-                                                     85))
+         (with
 PARALOOKS INITPARALOOKS (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
+                                                         85))
                (SETQ 1STLEFTMAR (OR (CADR (ASSOC 'FirstLineLeftMargin ALIST))
                                     LEFTMAR))
                (SETQ RIGHTMAR (OR (CADR (ASSOC 'RightMargin ALIST))
@@ -406,7 +416,7 @@
                                        DEFAULTTAB))
                (SETQ FMTSPECIALX 0)
                (SETQ FMTSPECIALY 0))
-         INITFMTSPEC])
+         INITPARALOOKS])
 
 (\TFBRAVO.INIT.PAGEFORMAT

   [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 22-Sep-2023 20:03 by rmk")


@@ -493,7 +503,8 @@
 (DEFINEQ
 
 (\TFBRAVO.PARSE.PARA

-  [LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ)
                       (* ; "Edited 21-Oct-2024 00:33 by rmk")


+  [LAMBDA (OLDPARALOOKS BSTREAM TEXTOBJ)
                     (* ; "Edited  8-Feb-2025 23:04 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 14-Nov-2023 13:03 by rmk")


                                                              (* ; "Edited  7-Nov-2023 21:53 by rmk")


                                                              (* ; "Edited 21-Aug-2023 23:41 by rmk")


@@ -501,17 +512,17 @@
                                                              (* ; "Edited 16-Aug-2023 21:28 by rmk")


                                                             (* ; "Edited 13-Jun-2021 09:46 by rmk:")

 
-    (* ;; "OLDFMTSPEC are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run.  Leaves the input file pointer at the end of the trailer, after the CR.")

+    (* ;; "OLDPARALOOKS are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run.  Leaves the input file pointer at the end of the trailer, after the CR.")

 
     (* ;; "^Z marks the end of a Bravo-looks paragraph which may have internal CR's that mark the end of Tedit paragraphs.  The Bravo runs with different charlooks want to end up in different pieces all within the same paragraph.")

 
     (* ;; 
 
    "The carriage return that ends the trailer is its own final run, the trailer itself is skipped.")

 
-    (DECLARE
 (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC))
-    (LET (BYTE PLEN ^ZPTR ENDCHAR FMTSPEC RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
-                                                                                     BSTREAM))
-               (FMTSPEC USER.CM.FMTSPEC))
+    (DECLARE
 (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS))
+    (LET (BYTE PLEN ^ZPTR ENDCHAR PARALOOKS RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
+                                                                                       BSTREAM))
+               (PARALOOKS USER.CM.PARALOOKS))
 
          (* ;; "BYTE=NIL at EOF, no terminating ^Z")

 
@@ -540,17 +551,19 @@
                      (NIL T)
                      NIL))
          (SELCHARQ BYTE
-              (^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS
 OLDFMTSPEC BSTREAM TEXTOBJ))
+              (^Z (SETQ PARALOOKS (\TFBRAVO.READ.PARALOOKS
 OLDPARALOOKS BSTREAM TEXTOBJ))
                   (SETQ RUNS (\TFBRAVO.CREATE.RUNS
 BSTREAM PSTART PLEN)))
               (NIL)
               (\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF"))
          (create
 PARA
-                PARAFMTSPEC _ FMTSPEC
+                PARAFMTSPEC _ PARALOOKS
                 RUNS _ RUNS
                 FORMATPTRS _ FORMATPTRS])
 
 (\TFBRAVO.READ.PARALOOKS

-  [LAMBDA (OLDFMTSPEC BSTREAM)
                               (* ; "Edited 19-Dec-2024 23:42 by rmk")


+  [LAMBDA (OLDPARALOOKS BSTREAM)
                             (* ; "Edited 19-Feb-2025 12:14 by rmk")


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


+                                                             (* ; "Edited 19-Dec-2024 23:42 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:27 by rmk")


                                                              (* ; "Edited 27-Aug-2024 21:59 by rmk")


                                                              (* ; "Edited 28-Jul-2024 21:39 by rmk")


@@ -562,46 +575,48 @@
                                                              (* ; "Edited 13-Aug-2023 19:58 by rmk")


                                                              (* ; "Edited  3-Aug-2023 00:20 by rmk")


                                                              (* ; "Edited 31-May-91 15:26 by jds")

-    (DECLARE
 (USEDFREE USER.CM.FMTSPEC))
+    (DECLARE
 (USEDFREE USER.CM.PARALOOKS))
 
     (* ;; 
-
    "Decodes bravo paragraph looks into a TEDIT FMTSPEC.  OLDFMTSPEC is used just for its tabs.")

+
    "Decodes bravo paragraph looks into a TEDIT PARALOOKS.  OLDPARALOOKS is used just for its tabs.")

 
-    (\DTEST OLDFMTSPEC 'FMTSPEC)
-    (bind
 LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC 
+    (PARALOOKS! OLDPARALOOKS)
+    (bind
 LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPLOOKS USER.CM.PARALOOKS 
                                                                              FMTDEFAULTTAB))
-          (NEWFMTSPEC _ (create
 FMTSPEC using
 USER.CM.FMTSPEC))
-       first
 (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC FMTPARATYPE))
+          (NEWPARALOOKS _ (create
 PARALOOKS using
 USER.CM.PARALOOKS))
+       first
 (CL:UNLESS (EQ 'PROFILE (FGETPLOOKS OLDPARALOOKS FMTPARATYPE))
 
                  (* ;; "It appears that heading-tabs don't carry over to other paragraphs.  Although maybe the default interval-tab does?")

 
-                 (SETQ TABDEFAULT (OR (FGETPARA OLDFMTSPEC FMTDEFAULTTAB)
-                                      (FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
+                 (SETQ TABDEFAULT (OR (FGETPLOOKS OLDPARALOOKS FMTDEFAULTTAB)
+                                      (FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
 
                  (* ;; "We don't put the NAMEDTABS in the TABSPEC since we don't know which ones will be activated by any particular run. ")

 
-                 (SETQ NAMEDTABS (COPY (FGETPARA OLDFMTSPEC FMTUSERINFO))))
+                 (SETQ NAMEDTABS (COPY (FGETPLOOKS OLDPARALOOKS FMTUSERINFO))))
        do
 (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
                (l (SETQ LMFLAG T)
-                  (FSETPARA NEWFMTSPEC LEFTMAR (\TFBRAVO.READNUM?
 BSTREAM T 'MICATOHALFPICAPOINTS)))
+                  (FSETPLOOKS NEWPARALOOKS LEFTMAR (\TFBRAVO.READNUM?
 BSTREAM T 
+                                                          'MICATOHALFPICAPOINTS)))
                (d (SETQ 1LMFLAG T)
-                  (FSETPARA NEWFMTSPEC 1STLEFTMAR (\TFBRAVO.READNUM?
 BSTREAM T 'MICATOHALFPICAPOINTS)
-                         ))
-               (z (FSETPARA NEWFMTSPEC RIGHTMAR (\TFBRAVO.READNUM?
 BSTREAM T 'MICATOHALFPICAPOINTS)))
-               (x (FSETPARA NEWFMTSPEC LINELEAD (\TFBRAVO.READNUM?
 BSTREAM T)))
-               (e (FSETPARA NEWFMTSPEC LEADAFTER 0)
-                  (FSETPARA NEWFMTSPEC LEADBEFORE (\TFBRAVO.READNUM?
 BSTREAM T)))
+                  (FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (\TFBRAVO.READNUM?
 BSTREAM T 
+                                                             'MICATOHALFPICAPOINTS)))
+               (z (FSETPLOOKS NEWPARALOOKS RIGHTMAR (\TFBRAVO.READNUM?
 BSTREAM T 
+                                                           'MICATOHALFPICAPOINTS)))
+               (x (FSETPLOOKS NEWPARALOOKS LINELEAD (\TFBRAVO.READNUM?
 BSTREAM T)))
+               (e (FSETPLOOKS NEWPARALOOKS LEADAFTER 0)
+                  (FSETPLOOKS NEWPARALOOKS LEADBEFORE (\TFBRAVO.READNUM?
 BSTREAM T)))
                (y                                            (* ; "vertical tabs are supported")

-                  (FSETPARA NEWFMTSPEC FMTSPECIALX 0)
-                  (FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM?
 BSTREAM T)))
-               (k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM?
 BSTREAM T)))
+                  (FSETPLOOKS NEWPARALOOKS FMTSPECIALX 0)
+                  (FSETPLOOKS NEWPARALOOKS FMTSPECIALY (\TFBRAVO.READNUM?
 BSTREAM T)))
+               (k (FSETPLOOKS NEWPARALOOKS FMTHEADINGKEEP (\TFBRAVO.READNUM?
 BSTREAM T)))
                (w 'HardcopyMode)
-               (j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED))
-               (c (FSETPARA NEWFMTSPEC QUAD 'CENTERED))
+               (j (FSETPLOOKS NEWPARALOOKS QUAD 'JUSTIFIED))
+               (c (FSETPLOOKS NEWPARALOOKS QUAD 'CENTERED))
                (q 
                   (* ;; "Profiles are marked here but then interpreted at the top")

 
-                  (FSETPARA NEWFMTSPEC FMTPARATYPE 'PROFILE))
+                  (FSETPLOOKS NEWPARALOOKS FMTPARATYPE 'PROFILE))
                (%(                                           (* ; "Collect the named tabs")

                    (SETQ TABX (\TFBRAVO.READNUM?
 BSTREAM T)) (* ; "Name or X position")

 
@@ -632,13 +647,13 @@
                ((CR \) 
                     (CL:WHEN (AND LMFLAG (NOT 1LMFLAG))      (* ; 
 
                                   "If there was a Left margin but no firstline left then default it")

-                        (FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR)))
-                    (FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT)
-                    (FSETPARA NEWFMTSPEC FMTUSERINFO (DREVERSE NAMEDTABS))
+                        (FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (FGETPLOOKS NEWPARALOOKS LEFTMAR)))
+                    (FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB TABDEFAULT)
+                    (FSETPLOOKS NEWPARALOOKS FMTUSERINFO (DREVERSE NAMEDTABS))
                     (CL:WHEN (EQ COMMAND (CHARCODE CR))      (* ; 
 
                                                 "Read the \ separator, but leave the terminating CR")

                         (\BACKFILEPTR BSTREAM))
-                    (RETURN NEWFMTSPEC))
+                    (RETURN NEWPARALOOKS))
                (\TEDIT.THELP (CHARACTER COMMAND)
                       '" is not a legal Bravo paragraph-format character"])
 
@@ -660,7 +675,8 @@
                                                 (SETQ OLDCHARLOOKS (fetch
 (RUN RUNLOOKS) of
 RUN])
 
 (\TFBRAVO.READ.CHARLOOKS

-  [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN)
               (* ; "Edited 21-Oct-2024 00:27 by rmk")


+  [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN)
               (* ; "Edited  2-Jan-2025 23:44 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:27 by rmk")


                                                              (* ; "Edited  9-Sep-2023 21:39 by rmk")


                                                              (* ; "Edited 20-Aug-2023 16:15 by rmk")


                                                              (* ; "Edited 18-Aug-2023 20:11 by rmk")


@@ -670,36 +686,39 @@
 
     (* ;; "The charlooks trailer (from \ to CR) consists of a sequence of run-looks.  Each run-look is a sequence of commands followed by the length of the run.  If the first run has no commands (i.e. the \ is followed immediately by a length-number), than the first run gets the USER.CM default looks.")

 
-    (bind
 COMMAND LEN LAST VALUE TABNAMES (NEWCHARLOOKS _ (create
 CHARLOOKS using
 OLDCHARLOOKS))
-       until
 (SETQ LEN (\TFBRAVO.READNUM?
 BSTREAM))
+    (bind
 COMMAND LEN LAST VALUE TABNAMES FAMILY SIZE BOLD ITALIC (NEWCHARLOOKS _
+                                                                         (create
 CHARLOOKS
+                                                                            using
 OLDCHARLOOKS))
+       first
 [SETQ FAMILY (SETQ SIZE (SETQ BOLD (SETQ ITALIC 'OFF] until
 (SETQ LEN (\TFBRAVO.READNUM?

+                                                                                    BSTREAM))
        do
 
-          (* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped.  BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safter?")

+          (* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped.  BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safer?")

 
           (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
-               (s (replace
 (CHARLOOKS CLSTRIKE) of
 NEWCHARLOOKS with
 T))
-               (S (replace
 (CHARLOOKS CLSTRIKE) of
 NEWCHARLOOKS with
 NIL))
-               (u (replace
 (CHARLOOKS CLULINE) of
 NEWCHARLOOKS with
 T))
-               (U (replace
 (CHARLOOKS CLULINE) of
 NEWCHARLOOKS with
 NIL))
-               (b (replace
 (CHARLOOKS CLBOLD) of
 NEWCHARLOOKS with
 T))
-               (B (replace
 (CHARLOOKS CLBOLD) of
 NEWCHARLOOKS with
 NIL))
-               (i (replace
 (CHARLOOKS CLITAL) of
 NEWCHARLOOKS with
 T))
-               (I (replace
 (CHARLOOKS CLITAL) of
 NEWCHARLOOKS with
 NIL))
+               (s (FSETCLOOKS NEWCHARLOOKS CLSTRIKE T))
+               (S (FSETCLOOKS NEWCHARLOOKS CLSTRIKE NIL))
+               (u (FSETCLOOKS NEWCHARLOOKS CLULINE T))
+               (U (FSETCLOOKS NEWCHARLOOKS CLULINE NIL))
+               (b (SETQ BOLD T))
+               (B (SETQ BOLD NIL))
+               (i (SETQ ITALIC T))
+               (I (SETQ ITALIC NIL))
                (g "Graphic T --unsupported")
                (G "Graphic NIL")
-               (v (replace
 (CHARLOOKS CLINVISIBLE) of
 NEWCHARLOOKS with
 NIL))
-               (V (AND NIL (replace
 (CHARLOOKS CLINVISIBLE) of
 NEWCHARLOOKS with
 T)))
+               (v (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE NIL))
+               (V (AND NIL (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE T)))
                (t 
                   (* ;; "Collect the named tabs for writerun")

 
                   (PUSH
 TABNAMES (CHARACTER (BIN BSTREAM))))
                (f                                            (* ; "Save the fontface until the end")

                   (SETQ VALUE (CHARACTER (BIN BSTREAM)))
-                  (replace
 (CHARLOOKS CLSIZE) of
 NEWCHARLOOKS with
 (\TFBRAVO.GETFONT VALUE BRSIZE))
-                  (replace
 (CHARLOOKS CLNAME) of
 NEWCHARLOOKS with
 (\TFBRAVO.GETFONT VALUE BRFAMILY)))
+                  (SETQ SIZE (\TFBRAVO.GETFONT VALUE BRSIZE))
+                  (SETQ FAMILY (\TFBRAVO.GETFONT VALUE BRFAMILY)))
                (o (SETQ VALUE (\TFBRAVO.READNUM?
 BSTREAM T)) (* ; "Superscript")

-                  (replace
 (CHARLOOKS CLOFFSET) of
 NEWCHARLOOKS with
 (CL:IF (IGREATERP VALUE 127)
-                                                                         (IDIFFERENCE VALUE 256)
-                                                                         VALUE)))
+                  (FSETCLOOKS NEWCHARLOOKS CLOFFSET (CL:IF (IGREATERP VALUE 127)
+                                                        (IDIFFERENCE VALUE 256)
+                                                        VALUE)))
                (SPACE)
                (CR 
                    (* ;; "We hit the trailer-terminating CR, It is either the end-marker for the last run, or a signal that this paragraph has no run-look information. ")

@@ -722,8 +741,8 @@
 
              (* ;; "Wait til end to do font, so we have the bold/italic looks for sure.  Last run may not have an explicit length")

 
-             (replace
 (CHARLOOKS CLUSERINFO) of
 NEWCHARLOOKS with
 (DREVERSE TABNAMES))
-             (\TFBRAVO.FONT.FROM.CHARLOOKS
 NEWCHARLOOKS)
+             (FSETCLOOKS NEWCHARLOOKS CLUSERINFO (DREVERSE TABNAMES))
+             (\TFBRAVO.FONT.FROM.CHARLOOKS
 NEWCHARLOOKS FAMILY SIZE BOLD ITALIC)
              (RETURN (create
 RUN
                             RUNSTART _ RUNSTART
                             RUNLENGTH _ LEN
@@ -731,22 +750,29 @@
                             RUNLAST _ LAST])
 
 (\TFBRAVO.FONT.FROM.CHARLOOKS

-  [LAMBDA (CHARLOOKS)
                                        (* ; "Edited  1-Aug-2023 13:21 by rmk")


+  [LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC)
                (* ; "Edited  2-Jan-2025 23:43 by rmk")


+                                                             (* ; "Edited  1-Aug-2023 13:21 by rmk")


                                                              (* ; "Edited 31-May-91 15:26 by jds")

 
     (* ;; "Takes a TEDIT CHARLOOKS with fields filled in (CLNAME = family name) and creates the font to fill it.")

 
-    [replace
 (CHARLOOKS CLFONT) of
 CHARLOOKS with
 (FONTCREATE (fetch
 (CHARLOOKS CLNAME) of
 CHARLOOKS)
-                                                         (fetch
 (CHARLOOKS CLSIZE) of
 CHARLOOKS)
-                                                         (LIST (CL:IF (fetch
 (CHARLOOKS CLBOLD)
-                                                                         of
 CHARLOOKS)
-                                                                   'BOLD
-                                                                   'MEDIUM)
-                                                               (CL:IF (fetch
 (CHARLOOKS CLITAL)
-                                                                         of
 CHARLOOKS)
-                                                                   'ITALIC
-                                                                   'REGULAR)
-                                                               'REGULAR]
+    [LET ((OLDFONT (GETCLOOKS CHARLOOKS CLFONT)))
+         (CL:WHEN (EQ FAMILY 'OFF)
+             (SETQ FAMILY (FONTPROP OLDFONT 'FAMILY)))
+         (CL:WHEN (EQ SIZE 'OFF)
+             (SETQ SIZE (FONTPROP OLDFONT 'SIZE)))
+         (CL:WHEN (EQ BOLD 'OFF)
+             [SETQ BOLD (EQ 'BOLD (FONTPROP OLDFONT 'WEIGHT])
+         (CL:WHEN (EQ ITALIC 'OFF)
+             [SETQ ITALIC (EQ 'ITALIC (FONTPROP OLDFONT 'SLOPE])
+         [SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD
+                                                                       'BOLD
+                                                                       'MEDIUM)
+                                                                   (CL:IF ITALIC
+                                                                       'ITALIC
+                                                                       'REGULAR)
+                                                                   'REGULAR]
+         (SETCLOOKS CHARLOOKS CLNAME (FONTUNPARSE (GETCLOOKS CHARLOOKS CLFONT]
     CHARLOOKS])
 
 (\TFBRAVO.READNUM?

@@ -782,7 +808,9 @@
 (DEFINEQ
 
 (\TFBRAVO.HANDLE.HEADING

-  [LAMBDA (BSTREAM TEXTOBJ HEADINGSTART)
                     (* ; "Edited 20-Aug-2023 20:11 by rmk")


+  [LAMBDA (BSTREAM TEXTOBJ HEADINGSTART)
                     (* ; "Edited 19-Feb-2025 12:17 by rmk")


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


+                                                             (* ; "Edited 20-Aug-2023 20:11 by rmk")


                                                              (* ; "Edited 18-Aug-2023 10:37 by rmk")


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


                                                              (* ; "Edited  9-Aug-2023 23:37 by rmk")


@@ -792,31 +820,33 @@
 
     (* ;; "Called from  \TFBRAVO.PARSE.PROFILE.PARA. The heading is a paragraph beginning at the current position, presumably just a line with a looks trailer. Its paralooks have to be marked with special heading properties--heading type and special X and Y locations.")

 
-    (DECLARE
 (USEDFREE USER.CM.FMTSPEC))
-    (LET (HEADINGDESC HEADINGPARA HEADINGFMTSPEC)            (* ; 
+    (DECLARE
 (USEDFREE USER.CM.PARALOOKS))
+    (LET (HEADINGDESC HEADINGPARA HEADINGPARALOOKS)          (* ; 
 
                                                          "skip over the trailer of the profile para")

          (SETFILEPTR BSTREAM HEADINGSTART)
-         (SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA
 USER.CM.FMTSPEC BSTREAM TEXTOBJ))
-         (SETQ HEADINGFMTSPEC (fetch
 (PARA PARAFMTSPEC) of
 HEADINGPARA))
-         (replace
 (FMTSPEC FMTPARATYPE) of
 HEADINGFMTSPEC with
 'PAGEHEADING)
+         (SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA
 USER.CM.PARALOOKS BSTREAM TEXTOBJ))
+         (SETQ HEADINGPARALOOKS (fetch
 (PARA PARAFMTSPEC) of
 HEADINGPARA))
+         (SETPLOOKS HEADINGPARALOOKS FMTPARATYPE 'PAGEHEADING)
 
          (* ;; "This is where the vertical tab info is placed for the heading, remove the special x and y and use them as the position for the descriptor")

 
          (SETQ HEADINGDESC (LIST (GENSYM 'PageHeading)
-                                 (OR (fetch
 (FMTSPEC FMTSPECIALX) of
 HEADINGFMTSPEC)
+                                 (OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALX)
                                      0)
-                                 (OR (fetch
 (FMTSPEC FMTSPECIALY) of
 HEADINGFMTSPEC)
+                                 (OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALY)
                                      0)))
-         (replace
 (FMTSPEC FMTPARASUBTYPE) of
 HEADINGFMTSPEC with
 (CAR HEADINGDESC))
-         (replace
 (FMTSPEC FMTSPECIALX) of
 HEADINGFMTSPEC with
 (CADR HEADINGDESC))
-         (replace
 (FMTSPEC FMTSPECIALY) of
 HEADINGFMTSPEC with
 (CADDR HEADINGDESC))
+         (FSETPLOOKS HEADINGPARALOOKS FMTPARASUBTYPE (CAR HEADINGDESC))
+         (FSETPLOOKS HEADINGPARALOOKS FMTSPECIALX (CADR HEADINGDESC))
+         (FSETPLOOKS HEADINGPARALOOKS FMTSPECIALY (CADDR HEADINGDESC))
                                                              (* ; 
 
                                                             "now write out the heading paragraph")

          (\TFBRAVO.INSERT.PARA
 HEADINGPARA BSTREAM TEXTOBJ MAX.FIXP)
          HEADINGDESC])
 
 (\TFBRAVO.PARSE.PROFILE.PARA

-  [LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START)
                  (* ; "Edited 22-Sep-2023 20:02 by rmk")


+  [LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START)
                  (* ; "Edited 19-Feb-2025 12:17 by rmk")


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


+                                                             (* ; "Edited 22-Sep-2023 20:02 by rmk")


                                                              (* ; "Edited 19-Aug-2023 23:33 by rmk")


                                                              (* ; "Edited 17-Aug-2023 14:51 by rmk")


                                                              (* ; "Edited 10-Aug-2023 10:37 by rmk")


@@ -914,8 +944,8 @@
                (PROGN                                        (* ; 
 
                                                       "Not a profile line, presumably a mistaken q.")

                       (SETFILEPTR BSTREAM END)
-                      (replace
 (FMTSPEC FMTPARATYPE) of
 (fetch
 (PARA PARAFMTSPEC) of
 PARAGRAPH)
-                         with
 NIL)
+                      (FSETPLOOKS (fetch
 (PARA PARAFMTSPEC) of
 PARAGRAPH)
+                             FMTPARATYPE NIL)
                       (RETURN NIL] repeatuntil
 [EQ (CAR LINE)
                                                    (CONSTANT (CHARACTER (CHARCODE ^Z]
        finally
 (CL:WHEN ROMAN
@@ -936,17 +966,20 @@
 (DEFINEQ
 
 (\TFBRAVO.INSERT.PARA

-  [LAMBDA (PARA BSTREAM TEXTOBJ)
                             (* ; "Edited 20-Aug-2023 16:13 by rmk")

+  [LAMBDA (PARA BSTREAM TEXTOBJ)
                             (* ; "Edited  8-Feb-2025 23:06 by rmk")


+                                                             (* ; "Edited 20-Aug-2023 16:13 by rmk")

 
     (* ;; "Inserts pieces into TEXTOBJ that correspond to the runs in PARA.  PARA may be broken up at internal CR's to get spacing and tabs right.")

 
-    (for
 P PFMTSPEC in
 (\TFBRAVO.SPLIT.PARA
 PARA)
-       do
 (SETQ PFMTSPEC (fetch
 (PARA PARAFMTSPEC) of
 P))
-          (for
 RUN in
 (fetch
 (PARA RUNS) of
 P) do
 (SETQ PFMTSPEC (\TFBRAVO.RUN.TABSPEC
 RUN PFMTSPEC))
-                                                  (\TFBRAVO.INSERT.RUN
 RUN BSTREAM PFMTSPEC TEXTOBJ])
+    (for
 P PARALOOKS in
 (\TFBRAVO.SPLIT.PARA
 PARA)
+       do
 (SETQ PARALOOKS (fetch
 (PARA PARAFMTSPEC) of
 P))
+          (for
 RUN in
 (fetch
 (PARA RUNS) of
 P) do
 (SETQ PARALOOKS (\TFBRAVO.RUN.TABSPEC
 RUN PARALOOKS
+                                                                         ))
+                                                  (\TFBRAVO.INSERT.RUN
 RUN BSTREAM PARALOOKS TEXTOBJ])
 
 (\TFBRAVO.INSERT.RUN

-  [LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ)
                  (* ; "Edited 17-Mar-2024 12:41 by rmk")


+  [LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ)
                    (* ; "Edited  8-Feb-2025 23:08 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 16-Jan-2024 18:28 by rmk")


                                                              (* ; "Edited 29-Dec-2023 11:50 by rmk")


                                                              (* ; "Edited 23-Sep-2023 12:11 by rmk")


@@ -956,7 +989,7 @@
 
     (* ;; "A Bravo run can include many CR's each of which should end a separate TEDIT paragraph.  Unless we want to think of those as paragraph internal meta-CRs ?")

 
-    (* ;; "PARAFMTSPEC is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs.  It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC")

+    (* ;; "PARALOOKS is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs.  It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC")

 
     (CL:WHEN (IGREATERP (fetch
 (RUN RUNLENGTH) of
 RUN)
                     0)                                       (* ; "No need for an empty piece")

@@ -967,7 +1000,7 @@
                              PLEN _ NCHARS
                              PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
 (RUN RUNLOOKS) of
 RUN)
                                              TEXTOBJ)
-                             PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)
+                             PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)
                              PPARALAST _ (fetch
 (RUN RUNLAST) of
 RUN)))
              (if
 (STRINGP RUNSTART)
                  then
 
@@ -995,10 +1028,12 @@
              PC))])
 
 (\TFBRAVO.SPLIT.PARA

-  [LAMBDA (PARA)
                                             (* ; "Edited  9-Sep-2023 21:35 by rmk")


+  [LAMBDA (PARA)
                                             (* ; "Edited 19-Feb-2025 12:15 by rmk")


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


+                                                             (* ; "Edited  9-Sep-2023 21:35 by rmk")


                                                              (* ; "Edited 22-Aug-2023 23:45 by rmk")

 
-    (* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs.  All of them share the same basic FMTSPEC, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.")

+    (* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs.  All of them share the same basic PARALOOKS, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.")

 
     (* ;; "However, we leave alone a paragraph with a special location, since we don't know how to arrange the positions of the later sub-paragraphs.")

 
@@ -1006,7 +1041,7 @@
 
     (* ;; "This smashes PARA's runs.")

 
-    (LET ((PARAFMTSPEC (fetch
 (PARA PARAFMTSPEC) of
 PARA))
+    (LET ((PARALOOKS (fetch
 (PARA PARAFMTSPEC) of
 PARA))
           NEWPARAS)
 
          (* ;; 
@@ -1014,9 +1049,9 @@
 
          (SETQ NEWPARAS
           (if
 [AND (fetch
 (PARA FORMATPTRS) of
 PARA)
-                   (FMEMB (fetch
 (FMTSPEC FMTSPECIALX) of
 PARAFMTSPEC)
+                   (FMEMB (GETPLOOKS PARALOOKS FMTSPECIALX)
                           '(0 NIL))
-                   (FMEMB (fetch
 (FMTSPEC FMTSPECIALY) of
 PARAFMTSPEC)
+                   (FMEMB (GETPLOOKS PARALOOKS FMTSPECIALY)
                           '(0 NIL]
               then
 [for
 PTR POS RUN FIRSTRUN NEWRUNLENGTH (RUNS _ (fetch
 (PARA RUNS) of
 PARA))
                       in
 (fetch
 (PARA FORMATPTRS) of
 PARA) eachtime
 (SETQ POS (CDR PTR))
@@ -1047,7 +1082,7 @@
                                                                           NEWRUNLENGTH)))
                                 (replace
 (RUN RUNLENGTH) of
 RUN with
 NEWRUNLENGTH)) 
 
-                            (* ;; "Fill in RUNS here, FMTSPEC below.  No more FORMATPTRS")

+                            (* ;; "Fill in RUNS here, PARALOOKS below.  No more FORMATPTRS")

 
                             (create
 PARA
                                    RUNS _ FIRSTRUN)
@@ -1057,19 +1092,18 @@
                             (* ;; "The first paragraph has LEADAFTER=0, all the others have 1STLEFTMAR=LEFTMAR and LEADAFTER=LEADBEFORE=0, except that the last one keeps the original LEADAFTER. Tabs are retained across all the runs.")

 
                             (replace
 (PARA PARAFMTSPEC) of
 (CAR $$VAL)
-                               with
 (create
 FMTSPEC using
 PARAFMTSPEC LEADAFTER _ 0))
-                            (for
 PTAIL (NEWFMTSPEC _ (create
 FMTSPEC
-                                                        using
 PARAFMTSPEC 1STLEFTMAR _
-                                                              (fetch
 (FMTSPEC LEFTMAR) of
 PARAFMTSPEC
-                                                                     )
-                                                              LEADBEFORE _ 0 LEADAFTER _ 0))
+                               with
 (create
 PARALOOKS using
 PARALOOKS LEADAFTER _ 0))
+                            (for
 PTAIL (NEWPARALOOKS _ (create
 PARALOOKS
+                                                          using
 PARALOOKS 1STLEFTMAR _
+                                                                (GETPLOOKS PARALOOKS LEFTMAR)
+                                                                LEADBEFORE _ 0 LEADAFTER _ 0))
                                on
 (CDR $$VAL)
                                do
 (replace
 (PARA PARAFMTSPEC) of
 (CAR PTAIL)
                                      with
 (CL:IF (CDR PTAIL)
-                                              NEWFMTSPEC
-                                              (create
 FMTSPEC using
 NEWFMTSPEC LEADAFTER _
-                                                                    (fetch
 (FMTSPEC LEADAFTER)
-                                                                       of
 PARAFMTSPEC)))]
+                                              NEWPARALOOKS
+                                              (create
 PARALOOKS using
 NEWPARALOOKS LEADAFTER _
+                                                                      (GETPLOOKS PARALOOKS LEADAFTER)
+                                                     ))]
             else
 (CONS PARA)))
 
          (* ;; "If t0 is the first tab specfied for a run, tx is the last tab of the previous run, and t(x+1) is defined, then change t0 to t(x+1).")

@@ -1094,31 +1128,33 @@
          NEWPARAS])
 
 (\TFBRAVO.RUN.TABSPEC

-  [LAMBDA (RUN PARAFMTSPEC)
                                  (* ; "Edited 27-Aug-2024 22:02 by rmk")


+  [LAMBDA (RUN PARALOOKS)
                                    (* ; "Edited 19-Feb-2025 12:16 by rmk")


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


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


                                                              (* ; "Edited 28-Jul-2024 21:30 by rmk")


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


                                                              (* ; "Edited 22-Aug-2023 16:54 by rmk")


                                                              (* ; "Edited 19-Aug-2023 15:47 by rmk")

 
-    (* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARAFMTSPEC. This returns a FMTSPEC for this run that only includes the named tabs that this run calls for.")

+    (* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARALOOKS. This returns a PARALOOKS for this run that only includes the named tabs that this run calls for.")

 
     (* ;; "")

 
-    (* ;; "For the first run, the PARAFMTSPEC is the unspecialized run for the paragraph, with empty TABSPEC.  Each subsequent run is given the FMTSPEC for the last run, so the tabs that were selected there are known.  This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think).  (Or perhaps as setting the next tabs TABX as the interval?)")

+    (* ;; "For the first run, the PARALOOKS is the unspecialized run for the paragraph, with empty TABSPEC.  Each subsequent run is given the PARALOOKS for the last run, so the tabs that were selected there are known.  This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think).  (Or perhaps as setting the next tabs TABX as the interval?)")

 
     (* ;; "")

 
-    (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants.  For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that  Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs.  ")

+    (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants.  For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that  Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS.  ")

 
     (* ;; "")

 
     (* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1.  t0 doesn't match.")

 
-    (DECLARE
 (USEDFREE USER.CM.FMTSPEC))
-    (LET ([LASTTAB (CAR (LAST (FGETPARA PARAFMTSPEC FMTTABS]
-          (TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
-          (TABDEFAULT (OR (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)
-                          (FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
+    (DECLARE
 (USEDFREE USER.CM.PARALOOKS))
+    (LET ([LASTTAB (CAR (LAST (GETPLOOKS PARALOOKS FMTTABS]
+          (TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
+          (TABDEFAULT (OR (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
+                          (FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
           (RUNTABS (fetch
 (RUN RUNTABS) of
 RUN))
           TAB TABS)
          (CL:WHEN (AND TABDEFS (NULL RUNTABS))
@@ -1149,9 +1185,9 @@
                               (FUNCTION (LAMBDA (T1 T2)
                                           (ILEQ (fetch
 (TAB TABX) of
 T1)
                                                 (fetch
 (TAB TABX) of
 T2]
-             (SETQ PARAFMTSPEC (create
 FMTSPEC using
 PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
+             (SETQ PARALOOKS (create
 PARALOOKS using
 PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _ 
                                                      TABS)))
-         PARAFMTSPEC])
+         PARALOOKS])
 
 (\TFBRAVO.INSTALL.PAGEFORMAT

   [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 22-Sep-2023 20:04 by rmk")


@@ -1345,7 +1381,9 @@
 (DEFINEQ
 
 (\TFBRAVO.ADD.NAMEDTAB

-  [LAMBDA (RUN PARAFMTSPEC TEXTOBJ)
                          (* ; "Edited  4-Aug-2024 18:05 by rmk")


+  [LAMBDA (RUN PARALOOKS TEXTOBJ)
                            (* ; "Edited 19-Feb-2025 12:17 by rmk")


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


+                                                             (* ; "Edited  4-Aug-2024 18:05 by rmk")


                                                              (* ; "Edited 28-Jul-2024 21:29 by rmk")


                                                              (* ; "Edited  9-Sep-2023 21:44 by rmk")


                                                              (* ; "Edited 18-Aug-2023 18:42 by rmk")


@@ -1356,7 +1394,7 @@
 
     (* ;; "")

 
-    (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants.  For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that  Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs.  ")

+    (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants.  For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that  Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS.  ")

 
     (* ;; "")

 
@@ -1364,8 +1402,8 @@
 
     (NOTUSED)
     (LET ((RUNLOOKS (fetch
 (RUN RUNLOOKS) of
 RUN))
-          (TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
-          (TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB))
+          (TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
+          (TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))
           (TABOFFSETS '(fetch
 (RUN RUNTABOFFSETS) of
 RUN))
           TAB TABNAMES TABS)
          (SETQ TABNAMES (fetch
 (CHARLOOKS CLUSERINFO) of
 RUNLOOKS))
@@ -1388,11 +1426,11 @@
 
         "No name and 0, make it be the default. How else would we decide where the second tab goes?")

 
                       (SETQ TABDEFAULT (fetch
 (TAB TABX) of
 (CDAR TABDEFS]
-             (CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)))
-                 (SETQ PARAFMTSPEC (create
 FMTSPEC using
 PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT 
-                                                         FMTTABS _ TABS))
-                 (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)))
-         PARAFMTSPEC])
+             (CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)))
+                 (SETQ PARALOOKS (create
 PARALOOKS using
 PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS
+                                                         _ TABS))
+                 (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)))
+         PARALOOKS])
 
 (\TFBRAVO.COPY.NAMEDTAB

   [LAMBDA (OBJ PIECE OLDCH NEWCH)                            (* jds " 8-Feb-84 19:58")

@@ -1465,18 +1503,18 @@
 (AND NIL (\TEDIT.NAMEDTAB.INIT
))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6681 13063 (TEDIT.BRAVOFILE? 6691 . 8421) (TEDITFROMBRAVO 8423 . 13061)) (13174 28618 (
-\TFBRAVO.GET.USER.CM 13184 . 15994) (\TFBRAVO.USER.CM.LOOKS 15996 . 17171) (\TFBRAVO.READ.USER.CM 
-17173 . 21743) (\TFBRAVO.INIT.PARALOOKS 21745 . 23731) (\TFBRAVO.INIT.PAGEFORMAT 23733 . 24613) (
-\TFBRAVO.GETPARAMS 24615 . 27469) (\TFBRAVO.FIND.LAST.TRAILER 27471 . 28616)) (28660 48692 (
-\TFBRAVO.PARSE.PARA 28670 . 32470) (\TFBRAVO.READ.PARALOOKS 32472 . 38894) (\TFBRAVO.CREATE.RUNS 38896
- . 40284) (\TFBRAVO.READ.CHARLOOKS 40286 . 45422) (\TFBRAVO.FONT.FROM.CHARLOOKS 45424 . 46793) (
-\TFBRAVO.READNUM? 46795 . 48690)) (48729 59480 (\TFBRAVO.HANDLE.HEADING 48739 . 51371) (
-\TFBRAVO.PARSE.PROFILE.PARA 51373 . 59478)) (59523 80972 (\TFBRAVO.INSERT.PARA 59533 . 60186) (
-\TFBRAVO.INSERT.RUN 60188 . 63385) (\TFBRAVO.SPLIT.PARA 63387 . 70629) (\TFBRAVO.RUN.TABSPEC 70631 . 
-75277) (\TFBRAVO.INSTALL.PAGEFORMAT 75279 . 80970)) (80973 85116 (\TFBRAVO.ASSERT 80983 . 81513) (
-\TEST.CHARACTER.LOOKS 81515 . 83401) (\TEST.PARAGRAPH.LOOKS 83403 . 85114)) (85601 92044 (
-\TFBRAVO.ADD.NAMEDTAB 85611 . 89002) (\TFBRAVO.COPY.NAMEDTAB 89004 . 89452) (\TFBRAVO.PUT.NAMEDTAB 
-89454 . 89734) (\TFBRAVO.GET.NAMEDTAB 89736 . 90113) (\NAMEDTABNYET 90115 . 90275) (\NAMEDTABSIZE 
-90277 . 90792) (\NAMEDTABPREPRINT 90794 . 90992) (\TEDIT.NAMEDTAB.INIT 90994 . 92042)))))
+  (FILEMAP (NIL (6570 13446 (TEDIT.BRAVOFILE? 6580 . 8310) (TEDITFROMBRAVO 8312 . 13444)) (13557 29284 (
+\TFBRAVO.GET.USER.CM 13567 . 16377) (\TFBRAVO.USER.CM.LOOKS 16379 . 17714) (\TFBRAVO.READ.USER.CM 
+17716 . 22286) (\TFBRAVO.INIT.PARALOOKS 22288 . 24397) (\TFBRAVO.INIT.PAGEFORMAT 24399 . 25279) (
+\TFBRAVO.GETPARAMS 25281 . 28135) (\TFBRAVO.FIND.LAST.TRAILER 28137 . 29282)) (29326 50024 (
+\TFBRAVO.PARSE.PARA 29336 . 33263) (\TFBRAVO.READ.PARALOOKS 33265 . 40155) (\TFBRAVO.CREATE.RUNS 40157
+ . 41545) (\TFBRAVO.READ.CHARLOOKS 41547 . 46576) (\TFBRAVO.FONT.FROM.CHARLOOKS 46578 . 48125) (
+\TFBRAVO.READNUM? 48127 . 50022)) (50061 61102 (\TFBRAVO.HANDLE.HEADING 50071 . 52798) (
+\TFBRAVO.PARSE.PROFILE.PARA 52800 . 61100)) (61145 83181 (\TFBRAVO.INSERT.PARA 61155 . 61996) (
+\TFBRAVO.INSERT.RUN 61998 . 65300) (\TFBRAVO.SPLIT.PARA 65302 . 72617) (\TFBRAVO.RUN.TABSPEC 72619 . 
+77486) (\TFBRAVO.INSTALL.PAGEFORMAT 77488 . 83179)) (83182 87325 (\TFBRAVO.ASSERT 83192 . 83722) (
+\TEST.CHARACTER.LOOKS 83724 . 85610) (\TEST.PARAGRAPH.LOOKS 85612 . 87323)) (87810 94465 (
+\TFBRAVO.ADD.NAMEDTAB 87820 . 91423) (\TFBRAVO.COPY.NAMEDTAB 91425 . 91873) (\TFBRAVO.PUT.NAMEDTAB 
+91875 . 92155) (\TFBRAVO.GET.NAMEDTAB 92157 . 92534) (\NAMEDTABNYET 92536 . 92696) (\NAMEDTABSIZE 
+92698 . 93213) (\NAMEDTABPREPRINT 93215 . 93413) (\TEDIT.NAMEDTAB.INIT 93415 . 94463)))))
 STOP

library/tedit/TEDIT-WINDOW

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Dec-2024 23:43:52" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;739
 230830 
+
(FILECREATED "31-Mar-2025 22:43:28" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;790
 237200 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.SHIFTLINES)
+      :CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION)
 
-      :PREVIOUS-DATE "13-Dec-2024 09:00:10" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;738)
+      :PREVIOUS-DATE "31-Mar-2025 12:04:14" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;789)
 
 
 (PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -18,15 +18,15 @@
                                                 (MACROS PANEPROPS PANEPREFIX PANESUFFIX PANETOPLINE 
                                                        PANECARET PANESTREAM PANETOBJ PANEBOTTOMLINE 
                                                        \TEDIT.PREFIX.LCHARLIM)
-                                                (MACROS PANETOP PANEWIDTH PANELEFT PANEBOTTOM 
-                                                       PANEHEIGHT PANEREGION)
+                                                (MACROS PANETOP PANEWIDTH PANELEFT PANERIGHT 
+                                                       PANEBOTTOM PANEHEIGHT PANEREGION)
                                                 (I.S.OPRS inpanes backpanes)
                                                 (MACROS ALLBUTTONSUP)))
         (INITRECORDS TEDITCARET PANEPROPS)
         (FILES ATTACHEDWINDOW)
         (FNS TEDIT.DEFER.UPDATES)
-        (FNS \TEDIT.CREATEW \TEDIT.WINDOW.SETUP \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE 
-             \TEDIT.FILL.PANES)
+        (FNS \TEDIT.WINDOW.CREATE \TEDIT.WINDOW.GETREGION \TEDIT.WINDOW.SETUP 
+             \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE \TEDIT.FILL.PANES)
         (FNS \TEDIT.CURSORMOVEDFN \TEDIT.CURSOROUTFN \TEDIT.ACTIVE.WINDOWP \TEDIT.EXPANDFN 
              \TEDIT.MAINW \TEDIT.MAINSTREAM \TEDIT.PRIMARYPANE \TEDIT.PANELIST \TEDIT.NEWREGIONFN 
              \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN \TEDIT.PANEREGION)
@@ -58,7 +58,7 @@
                      (TEDIT.PROMPTWINDOW.HEIGHT NIL))
               (GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT))
         (COMS                                                (* ; "Title creation and update")

-              (FNS \TEXTSTREAM.TITLE \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEXTSTREAM.FILENAME 
+              (FNS \TEDIT.FILENAME \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEDIT.LIKELY.FILENAME 
                    \TEDIT.UPDATE.TITLE))
         (COMS                                                (* ; "Screen updating utilities")

               (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.RESHAPEFN \TEDIT.REPAINTFN)
@@ -85,7 +85,9 @@
                                                                                          
                                                                                      Unformatted% Get
                                                                                          ))
-                                                                    Include Find Looks Substitute 
+                                                                    Include Find Looks Substitute
+                                                                    (Buttons 'Buttons 
+                                                                           "Display action buttons")
                                                                     Quit
                                                                     (Expanded% Menu 'Expanded% Menu 
                                                                            NIL
@@ -263,6 +265,9 @@
 (PUTPROPS PANELEFT
 MACRO
 [(PANE PREG)
                           (fetch
 (REGION LEFT) of
 (OR PREG (DSPCLIPPINGREGION NIL PANE])
 
+(PUTPROPS PANERIGHT
 MACRO
 [(PANE PREG)
+                           (fetch
 (REGION RIGHT) of
 (OR PREG (DSPCLIPPINGREGION NIL PANE])
+
 (PUTPROPS PANEBOTTOM
 MACRO
 [(PANE PREG)
                             (fetch
 (REGION BOTTOM) of
 (OR PREG (DSPCLIPPINGREGION NIL PANE])
 
@@ -351,8 +356,9 @@
 )
 (DEFINEQ
 
-(\TEDIT.CREATEW

-  [LAMBDA (WINDOW TSTREAM PROPS)
                             (* ; "Edited  1-Jul-2024 22:55 by rmk")


+(\TEDIT.WINDOW.CREATE

+  [LAMBDA (WINDOW TSTREAM PROPS)
                             (* ; "Edited 18-Feb-2025 09:49 by rmk")


+                                                             (* ; "Edited  1-Jul-2024 22:55 by rmk")


                                                              (* ; "Edited 29-Jun-2024 23:16 by rmk")


                                                              (* ; "Edited  5-May-2024 21:54 by rmk")


                                                              (* ; "Edited 20-Mar-2024 09:57 by rmk")


@@ -410,18 +416,12 @@
              (SETQ REGION (if
 (REGIONP WINDOW)
                               then
 (PROG1 (COPY WINDOW)
                                           (SETQ WINDOW NIL))
-                            else
 (GRAB-TYPED-REGION REGIONTYPE)))
-             (CL:UNLESS REGION
-                 (CLRPROMPT)                                 (* ; "System promptwindow")

-                 (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
-                        " window region")
-                 (CL:WHEN FILE
-                     (printout PROMPTWINDOW " for " T "  " (FULLNAME FILE)))
-                 (TERPRI PROMPTWINDOW)
-                 (SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32)
-                                     REGIONTYPE))            (* ; 
+                            elseif
 (GRAB-TYPED-REGION REGIONTYPE)
+                            else
 (SETQ REGION (\TEDIT.WINDOW.GETREGION
 TSTREAM REGIONTYPE PHEIGHT)) 
+                                                             (* ; 
 
                                                        "We don't want the default to keep shrinking")

-                 (SETQ PREPROMPT (create
 REGION using
 REGION)))
+                                 (SETQ PREPROMPT (create
 REGION using
 REGION))
+                                 REGION))
              (add
 (fetch
 (REGION HEIGHT) of
 REGION)
                   (IMINUS PHEIGHT))
              (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS))
@@ -429,6 +429,11 @@
              (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default.  We stash it back onto the window so it will be remembered for next time.")

 
              (REGISTER-TYPED-REGION REGION REGIONTYPE WINDOW))
+
+         (* ;; "")

+
+         (* ;; "We now have the main window")

+
          (WINDOWPROP WINDOW 'TEDITCREATED (OR PREPROMPT T))
          (CL:UNLESS [OR PWINDOW (EQ PROMPTPROP 'DON'T)
                         (SETQ PWINDOW (WINDOWP (CAR (WINDOWPROP WINDOW 'PROMPTWINDOW]
@@ -451,6 +456,53 @@
          (WINDOWPROP WINDOW 'TITLE TITLE)
          WINDOW])
 
+(\TEDIT.WINDOW.GETREGION

+  [LAMBDA (TSTREAM REGIONTYPE PHEIGHT)
                       (* ; "Edited 31-Mar-2025 22:43 by rmk")


+                                                             (* ; "Edited 24-Mar-2025 11:29 by rmk")


+                                                             (* ; "Edited 18-Mar-2025 21:52 by rmk")


+                                                             (* ; "Edited 19-Feb-2025 16:48 by rmk")


+                                                             (* ; "Edited 18-Feb-2025 10:09 by rmk")

+    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+          WIDTH HEIGHT)
+         (CLRPROMPT)                                         (* ; "System promptwindow")

+         (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
+                " window region")
+         (CL:WHEN (TXTFILE TSTREAM)
+             (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
+         (TERPRI PROMPTWINDOW)
+         (if
 (IGREATERP (TEXTLEN TEXTOBJ)
+                    0)
+             then
 
+                  (* ;; "Explict user properties cover everything, otherwise allow for extra stuff")

+
+                  [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
+                                  (for
 PARALOOKS in
 (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
+                                     largest
 (GETPLOOKS PARALOOKS RIGHTMAR)
+                                     finally
 (CL:UNLESS (AND $$EXTREME (IGREATERP $$EXTREME 0))
+                                                 (SETQ $$EXTREME (TIMES 6 PTSPERINCH))) 
+                                                             (* ; "36 for right margin selection")

+                                           (RETURN (IPLUS $$EXTREME \TEDIT.LINEREGION.WIDTH 36
+                                                          (ADD1 (TIMES 2 WBorder)
+                                                                1)
+                                                          (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
+                                                              0
+                                                              \TEDIT.OP.WIDTH)]
+                  [SETQ HEIGHT (if
 (GETTEXTPROP TEXTOBJ 'OPENHEIGHT)
+                                 elseif
 (ZEROP (TEXTLEN TEXTOBJ))
+                                   then
 50
+                                 else
 (for
 I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
+                                           (CHNO _ 1) from
 1 to
 20 while
 (ILEQ CHNO TEXTLEN)
+                                         sum
 (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO))
+                                             (SETQ CHNO (FGETLD L LCHARLIM))
+                                             (FGETLD L LHEIGHT)
+                                         finally
 (RETURN (IPLUS $$VAL PHEIGHT (ADD1 (TIMES 2 WBorder)
+                                                                                    )
+                                                                (FONTPROP WindowTitleDisplayStream
+                                                                       'HEIGHT]
+                  (GETBOXREGION WIDTH HEIGHT)
+           else
 (GETREGION (IMAX 200 (ADD1 (TIMES 2 WBorder)))
+                       (IMAX 100 (ADD1 (TIMES 2 WBorder])
+
 (\TEDIT.WINDOW.SETUP

   [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1)
              (* ; "Edited 25-Nov-2024 20:10 by rmk")


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


@@ -958,48 +1010,51 @@
                                                  LEFT _ 0)))))])
 
 (\TEDIT.SHRINK.ICONCREATE

-  [LAMBDA (W ICON ICON-POSITION)
                             (* ; "Edited 15-Mar-2024 18:28 by rmk")


+  [LAMBDA (W ICON ICON-POSITION)
                             (* ; "Edited 14-Mar-2025 12:35 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 18:28 by rmk")


                                                              (* ; "Edited 20-Dec-2023 23:44 by rmk")


                                                              (* ; "Edited 10-Apr-2023 09:44 by rmk")


                                                              (* ; "Edited 25-Apr-88 23:53 by jds")

 
     (* ;; "Create the icon that represents this window.")

 
-    [PROG [(ICON (WINDOWPROP W 'ICON))
-           (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
-           (SHRINKFN (WINDOWPROP W 'SHRINKFN]
-          (COND
-             ((NOT (fetch
 (TEXTWINDOW WTEXTOBJ) of
 W))       (* ; 
-
                                      "This isn't really a TEdit window any more.  Don't do anything")

-              NIL)
-             ((TEDITMENUP W)                                 (* ; 
+    [LET ((ICON (WINDOWPROP W 'ICON))
+          (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
+          (SHRINKFN (WINDOWPROP W 'SHRINKFN))
+          (TSTREAM (TEXTSTREAM W T)))
+         (CL:WHEN TSTREAM
+             [if
 (GETTOBJ (GETTSTR TSTREAM TEXTOBJ)
+                        MENUFLG)
+                 then
                                        (* ; 
 
                                                    "This is a text menu, and shrinks without trace.")

-              NIL)
-             ((OR (IGREATERP (FLENGTH SHRINKFN)
-                         3)
-                  (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
-                       (IGREATERP (FLENGTH SHRINKFN)
-                              2)))                           (* ; 
+                      NIL
+               elseif
 (OR (IGREATERP (FLENGTH SHRINKFN)
+                                 3)
+                          (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
+                               (IGREATERP (FLENGTH SHRINKFN)
+                                      2)))
+                 then
                                        (* ; 
 
                               "There are other functions that expect to handle this.  Don't bother.")

-              NIL)
-             ((OR [AND ICONTITLE (EQUAL ICONTITLE (\TEXTSTREAM.TITLE
 (TEXTSTREAM W]
-                  (AND (NOT ICONTITLE)
-                       ICON))
-
-              (* ;; 
+                      NIL
+               else
 (OR (AND ICONTITLE (STRING.EQUAL ICONTITLE (\TEDIT.FILENAME
 TSTREAM)))
+                        (AND (NOT ICONTITLE)
+                             ICON))
+                 then
 
+                      (* ;; 
 
        "we built this and the title is the same, or he has already put an icon on this.  Do nothing")

 
-              NIL)
-             (ICON 
-                   (* ;; "There's an existing icon window;  change the title in it")

+                      NIL
+               else
 (SETQ ICONTITLE (\TEDIT.FILENAME
 TSTREAM))
+                    (WINDOWPROP W 'TEDIT.ICON.TITLE ICONTITLE)
+                    (if
 ICON
+                        then
 
+                             (* ;; "There's an existing icon window;  change the title in it")

 
-                   [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE
 (TEXTSTREAM
-                                                                                       W]
-                   (ICONTITLE ICONTITLE NIL NIL ICON))
-             (T                                              (* ; "install a new icon")

-                [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE
 (TEXTSTREAM W]
-                (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT
-                                           ICON-POSITION T NIL 'FILE]
+                             (ICONTITLE ICONTITLE NIL NIL ICON)
+                      else
                                   (* ; "install a new icon")

+                           (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE 
+                                                      TEDIT.ICON.FONT ICON-POSITION T NIL
+                                                      'FILE])]
     (WINDOWPROP W 'ICON])
 
 (\TEDIT.SHRINKFN

@@ -1057,7 +1112,8 @@
 (DEFINEQ
 
 (\TEDIT.BUTTONEVENTFN

-  [LAMBDA (PANE)
                                             (* ; "Edited  6-Dec-2024 11:33 by rmk")


+  [LAMBDA (PANE)
                                             (* ; "Edited 13-Feb-2025 11:53 by rmk")


+                                                             (* ; "Edited  6-Dec-2024 11:33 by rmk")


                                                              (* ; "Edited  1-Dec-2024 12:03 by rmk")


                                                              (* ; "Edited 27-Nov-2024 20:21 by rmk")


                                                              (* ; "Edited  3-Nov-2024 07:19 by rmk")


@@ -1103,9 +1159,7 @@
                                                                    TEXTOBJ)
                                                             (\TEDIT.BUTTONEVENTFN.INACTIVE
 TEXTOBJ 
                                                                    PANE)
-                                                            (\TEDIT.PANE.SPLIT
 TEXTOBJ PANE)
-                                                            (NOT (\TEDIT.XYTOSEL.INLINEP X Y PANE 
-                                                                        TEXTOBJ)))
+                                                            (\TEDIT.PANE.SPLIT
 TEXTOBJ PANE))
                                                       (RETURN)) 
 
                                                (* ;; "")

@@ -1132,6 +1186,7 @@
                                                (SETQ NEWSEL (\TEDIT.COPYSEL CURSEL)) 
                                                              (* ; 
 
                                                      "Gets line-chains and consistent initial looks")

+                                               (FSETTOBJ TEXTOBJ LASTARROWX NIL)
                eachtime
 (BLOCK)                              (* ; "Give other processes a chance")

                      (GETMOUSESTATE)                         (* ; 
 
                                                             "And get the new mouse and key info")

@@ -1514,7 +1569,8 @@
                                         then
 (TEDIT.INSERT TSTREAM I])
 
 (\TEDIT.FOREIGN.COPY

-  [LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP)
            (* ; "Edited 27-Aug-2024 13:38 by rmk")


+  [LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP)
            (* ; "Edited 28-Mar-2025 12:51 by rmk")


+                                                             (* ; "Edited 27-Aug-2024 13:38 by rmk")


                                                              (* ; "Edited  7-Jul-2024 09:26 by rmk")


                                                              (* ; "Edited 29-Apr-2024 13:37 by rmk")


                                                              (* ; "Edited 22-Apr-2024 23:47 by rmk")


@@ -1534,7 +1590,7 @@
                (* ;; "Have to go character by character because COPYINSERT does (PRIN2 BKSYSBUF), which creates undesired string quotes.")

 
                (for
 CHNO CH from
 (FGETSEL SOURCESEL CH#) to
 (SUB1 (FGETSEL SOURCESEL CHLIM))
-                  while
 (SETQ CH (TEDIT.NTHCHARCODE SOURCESTREAM CHNO))
+                  while
 (SETQ CH (\TEDIT.NTHCHARCODE SOURCESTREAM CHNO))
                   do
 
                      (* ;; "Maybe should apply the preprintfn ?")

 
@@ -1946,7 +2002,8 @@
            PROMPTWINDOW])
 
 (TEDIT.PROMPTPRINT

-  [LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?)
                     (* ; "Edited 26-Nov-2023 10:10 by rmk")


+  [LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?)
                     (* ; "Edited 29-Dec-2024 14:45 by rmk")


+                                                             (* ; "Edited 26-Nov-2023 10:10 by rmk")


                                                              (* ; "Edited 10-Sep-2023 00:27 by rmk")


                                                              (* ; "Edited 30-Jul-2023 08:52 by rmk")


                                                              (* ; "Edited  9-Jul-2023 12:37 by rmk")


@@ -1956,29 +2013,31 @@
 
     (* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow).  Optionally clear the window first.")

 
-    (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
+    (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM T))
           PWINDOW MAINWINDOW)
-         (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW
 TEXTOBJ))
-             [SETQ PWINDOW (CAR (NLSETQ (SELECTQ PWINDOW
-                                            (DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
-                                                          (GETPROMPTWINDOW MAINWINDOW)))
-                                            (NIL (CL:WHEN TEXTSTREAM
-                                                     [GETPROMPTWINDOW MAINWINDOW NIL NIL
-                                                            (NOT (GETTEXTPROP TEXTOBJ 
-                                                                        'PWINDOW.ON.DEMAND]))
-                                            PWINDOW])        (* ; 
+         (if
 TEXTOBJ
+             then
 (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW
 TEXTOBJ))
+                      [SETQ PWINDOW
+                       (CAR (NLSETQ (SELECTQ PWINDOW
+                                        (DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
+                                                      (GETPROMPTWINDOW MAINWINDOW)))
+                                        (NIL (CL:WHEN TEXTSTREAM
+                                                 [GETPROMPTWINDOW MAINWINDOW NIL NIL
+                                                        (NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]))
+                                        PWINDOW])            (* ; 
 
                                              "Try to find an editor's prompt window for our message")

-         (COND
-            ((WINDOWP PWINDOW)                               (* ; 
+                  (COND
+                     ((WINDOWP PWINDOW)                      (* ; 
 
                                                      "We found a window to use.  Print the message.")

-             (CL:WHEN CLEAR? (CLEARW PWINDOW))
-             (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
-             (PRIN1 MSG PWINDOW))
-            (T                                               (* ; 
+                      (CL:WHEN CLEAR? (CLEARW PWINDOW))
+                      (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
+                      (PRIN1 MSG PWINDOW))
+                     (T                                      (* ; 
 
                                                         "Failing all else, use global PROMPTWINDOW.")

-               (FRESHLINE PROMPTWINDOW)
-               (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
-               (printout PROMPTWINDOW MSG])
+                        (FRESHLINE PROMPTWINDOW)
+                        (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
+                        (printout PROMPTWINDOW MSG)))
+           else
 (PROMPTPRINT MSG])
 
 (TEDIT.PROMPTCLEAR

   [LAMBDA (TEXTSTREAM FONT)
                                  (* ; "Edited 14-Mar-98 12:52 by rmk:")


@@ -2075,18 +2134,19 @@
 
 (DEFINEQ
 
-(\TEXTSTREAM.TITLE

-  [LAMBDA (STREAM)
                                           (* ; "Edited 18-Oct-2023 00:02 by rmk")


+(\TEDIT.FILENAME

+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 14-Mar-2025 11:44 by rmk")


+                                                             (* ; "Edited 18-Oct-2023 00:02 by rmk")


                                                             (* ; "Edited 24-Aug-2021 23:25 by rmk:")

 
     (* ;; "returns a string with which you can talk to the user about this stream. e.g. for Get and Put prompts")

 
-    (LET ((TEXTOBJ (TEXTOBJ STREAM))
+    (LET ((TEXTOBJ (TEXTOBJ TSTREAM))
           TXTFILE)
          (SETQ TXTFILE (FGETTOBJ TEXTOBJ TXTFILE))
          (OR (CL:TYPECASE TXTFILE
                  (STRINGP TXTFILE)
-                 (STREAM (fetch
 (STREAM FULLNAME) of
 TXTFILE))
+                 (STREAM (FULLNAME TXTFILE))
                  (LITATOM TXTFILE)
                  (T TXTFILE))
              ""])
@@ -2160,8 +2220,9 @@
                      (WINDOWPROP W 'TITLE TITLE))
                  TITLE)))])
 
-(\TEXTSTREAM.FILENAME

-  [LAMBDA (TEXTSTREAM UNFORMATTED?)
                          (* ; "Edited 18-Jan-2024 09:03 by rmk")


+(\TEDIT.LIKELY.FILENAME

+  [LAMBDA (TSTREAM UNFORMATTED?)
                             (* ; "Edited 14-Mar-2025 11:46 by rmk")


+                                                             (* ; "Edited 18-Jan-2024 09:03 by rmk")


                                                              (* ; "Edited 29-Dec-2023 00:33 by rmk")


                                                              (* ; "Edited 18-Dec-2023 14:06 by rmk")


                                                              (* ; "Edited 30-May-91 23:34 by jds")

@@ -2172,14 +2233,14 @@
 
     (* ;; "returns the name of the file associated with this stream if there is one.  NIL otherwise.  Version numbers suppressed.")

 
-    (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
+    (LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
            (DEFAULTEXT (CL:IF UNFORMATTED?
                            'TXT
                            'TEDIT))
            (TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
            EXT)
           (CL:WHEN (type?
 STREAM TXTFILE)
-              (SETQ TXTFILE (fetch
 FULLFILENAME of
 TXTFILE))
+              (SETQ TXTFILE (fetch
 (STREAM FULLFILENAME) of
 TXTFILE))
               [SETQ EXT (U-CASE (FILENAMEFIELD TXTFILE 'EXTENSION]
               (if
 (OR (NULL EXT)
                       (EQ EXT 'BRAVO))
@@ -2190,7 +2251,10 @@
               (PACKFILENAME 'EXTENSION EXT 'VERSION NIL 'BODY TXTFILE))])
 
 (\TEDIT.UPDATE.TITLE

-  [LAMBDA (TEXTOBJ FILENAME)
                                 (* ; "Edited 13-Dec-2024 08:59 by rmk")


+  [LAMBDA (TEXTOBJ FILENAME)
                                 (* ; "Edited 21-Mar-2025 23:41 by rmk")


+                                                             (* ; "Edited 15-Mar-2025 00:32 by rmk")


+                                                             (* ; "Edited  8-Mar-2025 12:00 by rmk")


+                                                             (* ; "Edited 13-Dec-2024 08:59 by rmk")


                                                              (* ; "Edited 22-Oct-2024 11:44 by rmk")


                                                              (* ; "Edited 28-Aug-2024 15:50 by rmk")


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


@@ -2200,20 +2264,27 @@
 
     (* ;; "find and set the title to reflect a new filename, and update the file fields of any attached menu too.")

 
-    (LET ((TITLE (\TEXTSTREAM.TITLE
 TEXTOBJ))
-          MENUSTREAM PC STATEFN)
+    (LET ((TITLE (\TEDIT.FILENAME
 TEXTOBJ))
+          MENUSTREAM SETSTATEFN FIELD FIELDS)
          (\TEDIT.WINDOW.TITLE
 TEXTOBJ NIL (\TEDIT.DEFAULT.TITLE
 (OR FILENAME TITLE)))
-         (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ))
+         (SETQ MENUSTREAM (TEDIT.MENUSTREAM TEXTOBJ))
          (CL:WHEN (AND MENUSTREAM (LITATOM TITLE))           (* ; 
-
                            "if we have a filename then put it in the GET and PUT fields of the menu")

+
                    "if we have a filename then put it in the GETFILE and PUTFILE fields of the menu")

              (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE))
-             (for
 BUTTON SETSTATEFN in
 (MB.GET '(GET PUT)
-                                              MENUSTREAM
-                                              '(OBJECT STARTPC)) when
 (SETQ SETSTATEFN
-                                                                       (IMAGEOBJPROP (CAR BUTTON)
-                                                                              'SETSTATEFN))
-                do
 (APPLY* SETSTATEFN (CADR BUTTON)
-                          FILENAME MENUSTREAM)))])
+             [SETQ FIELDS (MB.GET '(GETFILE PUTFILE)
+                                 MENUSTREAM
+                                 '(OBJECT STARTPC]
+             (CL:WHEN [AND (SETQ FIELD (LISTGET FIELDS 'GETFILE))
+                           (SETQ SETSTATEFN (IMAGEOBJPROP (CAR FIELD)
+                                                   'SETSTATEFN]
+                 (APPLY* SETSTATEFN (CADR FIELD)
+                        FILENAME MENUSTREAM))
+             (CL:WHEN [AND (SETQ FIELD (LISTGET FIELDS 'PUTFILE))
+                           (SETQ SETSTATEFN (IMAGEOBJPROP (CAR FIELD)
+                                                   'SETSTATEFN]
+                 (APPLY* SETSTATEFN (CADR FIELD)
+                        FILENAME MENUSTREAM))
+             (\TEDIT.FILL.PANES
 MENUSTREAM))])
 )
 
 
@@ -2223,7 +2294,9 @@
 (DEFINEQ
 
 (TEDIT.DEACTIVATE.WINDOW

-  [LAMBDA (PANE)
                                             (* ; "Edited 29-Nov-2024 13:10 by rmk")


+  [LAMBDA (PANE)
                                             (* ; "Edited 14-Mar-2025 16:22 by rmk")


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


+                                                             (* ; "Edited 29-Nov-2024 13:10 by rmk")


                                                              (* ; "Edited  1-Jul-2024 17:42 by rmk")


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


                                                              (* ; "Edited 12-May-2024 17:19 by rmk")


@@ -2240,7 +2313,7 @@
     (* ;; "If the session is or can be finished, deactivate this Tedit window and process, and all attached Tedit menus.  This disconnects the window and process from the textstream, which persists.  This is not used to unsplit panes.  The actual window-closing is done by setting the flag EDITFINISHEDFLG to T and  giving control to the edit process. The flag causes the command loop to exit.")

 
     (PROG* [(TSTREAM (TEXTSTREAM PANE T))
-            (TEXTOBJ (AND TSTREAM (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM]
+            (TEXTOBJ (AND TSTREAM (GETTSTR TSTREAM TEXTOBJ]
            (CL:UNLESS TEXTOBJ                                (* ; 
 
                                           "Return NIL if not an editing window (rather than error?)")

                (RETURN))
@@ -2255,7 +2328,7 @@
                (CLEARW (GETTOBJ TEXTOBJ PROMPTWINDOW)))
            (\TEDIT.SETCARET
 (TEXTSEL TEXTOBJ)
                   PANE TEXTOBJ 'OFF)                         (* ; 
-
        "Before the window is closed, make SURE that the caret is down, or the window will reappear.")

+
        "Before the window is closed, make sure that the caret is down, or the window will reappear.")

            (CL:WHEN (AND (\TEDIT.WINDOW.TITLE
 TEXTOBJ)
                          (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW))
                          (OPENWP PANE)
@@ -2279,13 +2352,14 @@
            (WINDOWDELPROP PANE 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW))
                                                              (* ; "To avoid a loop")

            (WINDOWPROP PANE 'SCROLLFN NIL)
+           (WINDOWPROP PANE 'AFTERMOVEFN NIL)
            (WINDOWDELPROP PANE 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN))
            (\TEDIT.INTERRUPT.SETUP (WINDOWPROP PANE 'PROCESS)
                   T)                                         (* ; "Restore any disarmed interrupts.")

-           (for
 MENUW in
 (ATTACHEDWINDOWS PANE) when
 (TEDITMENUP MENUW)
+           (for
 MENUW MTEXTOBJ in
 (ATTACHEDWINDOWS PANE) when
 (AND (SETQ MTEXTOBJ (TEXTOBJ MENUW T))
+                                                                   (FGETTOBJ MTEXTOBJ MENUFLG))
               do
                                             (* ; "Detach all the TEDITMENU windows.")

-                 (SETTOBJ (TEXTOBJ MENUW)
-                        EDITFINISHEDFLG T)                   (* ; 
+                 (SETTOBJ MTEXTOBJ EDITFINISHEDFLG T)        (* ; 
 
                                                             "Mark it finished so it closes itself")

                  (WINDOWPROP MENUW 'TEDITMENU NIL)           (* ; 
 
                                                             "And mark it no longer a menu window")

@@ -2490,7 +2564,8 @@
                        (\TEDIT.SCROLLCH.TOP
 TSTREAM PANE (FGETLD TOPLINE LCHARLAST])
 
 (\TEDIT.SCROLLUP

-  [LAMBDA (TSTREAM PANE DY)
                                  (* ; "Edited  1-Dec-2024 11:32 by rmk")


+  [LAMBDA (TSTREAM PANE DY)
                                  (* ; "Edited  1-Feb-2025 10:20 by rmk")


+                                                             (* ; "Edited  1-Dec-2024 11:32 by rmk")


                                                              (* ; "Edited 29-Nov-2024 09:14 by rmk")


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


                                                              (* ; "Edited 21-Nov-2024 15:04 by rmk")


@@ -2560,7 +2635,7 @@
 
           (\TEDIT.SETPANE.TOPLINE
 PANE NEWTOPLINE NEWPANEYBOT)
           (\TEDIT.SHIFTLINES
 (PANEPREFIX PANE)
-                 NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES
 PANE NEWTOPLINE)
+                 PANE TEXTOBJ (\TEDIT.BITMAPLINES
 PANE NEWTOPLINE)
                  T)
           (\TEDIT.SETCARET
 (TEXTSEL TEXTOBJ)
                  PANE TEXTOBJ 'ON])
@@ -2595,7 +2670,8 @@
           (RETURN (IPLUS NEWBOT (FGETLD NEWTOPLINE LHEIGHT])
 
 (\TEDIT.SCROLLDOWN

-  [LAMBDA (TSTREAM PANE DY)
                                  (* ; "Edited  1-Dec-2024 20:46 by rmk")


+  [LAMBDA (TSTREAM PANE DY)
                                  (* ; "Edited  1-Feb-2025 10:20 by rmk")


+                                                             (* ; "Edited  1-Dec-2024 20:46 by rmk")


                                                              (* ; "Edited 29-Nov-2024 09:14 by rmk")


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


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


@@ -2693,7 +2769,7 @@
      (* ;; "All needed lines have been constructed and linked, although there may still be some unneeded lines at the bottom.    ")

 
            (\TEDIT.SHIFTLINES
 (PANEPREFIX PANE)
-                  NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES
 PANE OLDTOPLINE)
+                  PANE TEXTOBJ (\TEDIT.BITMAPLINES
 PANE OLDTOPLINE)
                   T)
            (\TEDIT.SETCARET
 (TEXTSEL TEXTOBJ)
                   PANE TEXTOBJ 'ON])
@@ -2868,7 +2944,8 @@
          TOPLINE])
 
 (\TEDIT.SHIFTLINES

-  [LAMBDA (PREVLINE NEXTLINE PANE TEXTOBJ BITMAPLINES SCROLLING)

+  [LAMBDA (PREVLINE PANE TEXTOBJ BITMAPLINES SCROLLING)
      (* ; "Edited  1-Feb-2025 10:22 by rmk")


+                                                             (* ; "Edited  7-Jan-2025 11:54 by rmk")


                                                              (* ; "Edited 17-Dec-2024 23:40 by rmk")


                                                              (* ; "Edited  3-Dec-2024 16:08 by rmk")


                                                              (* ; "Edited  1-Dec-2024 11:31 by rmk")


@@ -2880,15 +2957,14 @@
 
     (* ;; "BITMAPLINES contains the first and last lines of the currently resuable PANE bitmap.   PANE is refilled from the next of PREVLINE to the bottom, using BITMAPLINES and BITBLT to translate the images for lines that are already known. This skips formatting and redisplaying of those lines, but more importantly, it suppresses flicker.   ")

 
-    (LINKLD PREVLINE NEXTLINE)
-
     (* ;; "Take down the caret, but importantly, don't take down the selection--that would wipe out the bitmap-highlighting that we want to translate.")

 
     (LET ((SEL (TEXTSEL TEXTOBJ))
           LASTVISIBLE)
          (\TEDIT.SETCARET
 SEL PANE TEXTOBJ 'OFF)
          (if
 BITMAPLINES
-             then
 [LET* ((VLEFT (\TEDIT.ONSCREEN?
 PANE 'LEFT))
+             then
 [LET* ((NEXTLINE (FGETLD PREVLINE NEXTLINE))
+                         (VLEFT (\TEDIT.ONSCREEN?
 PANE 'LEFT))
                          (PBOTTOM (PANEBOTTOM PANE))
                          (BMTOPL (CAR BITMAPLINES))
                          (BMTOPY (FGETLD BMTOPL YTOP))
@@ -2986,7 +3062,7 @@
                 (\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ)
                 (SETQ LASTVISIBLE (\TEDIT.LINES.BELOW PREVLINE PANE TEXTOBJ))
                 (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE)
-                (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE))
+                (\TEDIT.FIXSEL NIL TEXTOBJ NIL PANE))
          (CL:WHEN SCROLLING
 
              (* ;; "If scrolling up or down, we brute force wipe out whatever is above PREVLINE.  If not scrolling, those are the lines from the top to lastvalid that are preserved.")

@@ -3454,7 +3530,12 @@
                 (UPDATE/MENU/IMAGE MENU])
 
 (TEDIT.DEFAULT.MENUFN

-  [LAMBDA (PANE)
                                             (* ; "Edited 27-Jul-2024 20:24 by rmk")


+  [LAMBDA (PANE)
                                             (* ; "Edited 17-Mar-2025 17:28 by rmk")


+                                                             (* ; "Edited 14-Mar-2025 16:40 by rmk")


+                                                             (* ; "Edited 12-Feb-2025 16:26 by rmk")


+                                                             (* ; "Edited  9-Feb-2025 21:28 by rmk")


+                                                             (* ; "Edited  7-Jan-2025 23:46 by rmk")


+                                                             (* ; "Edited 27-Jul-2024 20:24 by rmk")


                                                              (* ; "Edited 30-Jun-2024 12:38 by rmk")


                                                              (* ; "Edited 25-Jun-2024 11:59 by rmk")


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


@@ -3480,7 +3561,7 @@
             THISMENU ITEM)
            (CL:WHEN (FGETTOBJ TEXTOBJ EDITOPACTIVE)
 
-               (* ;; "We're busy doing something, tell him to wait")

+               (* ;; "We're busy doing something, tell him to wait.  Unfortunately, this string will overwrite whatever may be in the Tedit promptwindow (e.g. a GETINPUT calling TTYINPROMPTFORWORD for a meta-F command), obscuring what the user has already typed.   Maybe an interface that tests to see if the promptwindow is in use, and enlarges it with an extra line above the current type-in?")

 
                (TEDIT.PROMPTPRINT
 TEXTOBJ (CONCAT (CL:IF (EQ T (FGETTOBJ TEXTOBJ EDITOPACTIVE))
                                                       "Edit"
@@ -3488,15 +3569,14 @@
                                                  " operation in progress; please wait")
                       T)
                (RETURN NIL))
-           (SETQ THISMENU (COND
-                             (WMENU)
-                             ((SETQ WMENU (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS))
-                              (PROG1 (SETQ WMENU (\TEDIT.CREATEMENU
 WMENU))
-                                  (WINDOWPROP PANE 'TEDIT.MENU WMENU)))
-                             (TEDIT.DEFAULT.MENU)))
-           (SETQ ITEM (MENU THISMENU))
+           (SETQ THISMENU (if
 WMENU
+                            elseif
 (SETQ WMENU (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS))
+                              then
 (PROG1 (SETQ WMENU (\TEDIT.CREATEMENU
 WMENU))
+                                       (WINDOWPROP PANE 'TEDIT.MENU WMENU))
+                            else
 TEDIT.DEFAULT.MENU))
+           (SETQ ITEM (CAR (MENU THISMENU)))
            (ERSETQ (RESETLST
-                       [SELECTQ (CAR ITEM)
+                       [SELECTQ ITEM
                            ((Put |Put Formatted Document|) 
                                 (TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT)))
                            (Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T))
@@ -3515,7 +3595,7 @@
                                            (TEDIT.SUBSTITUTE TEXTOBJ)))
                            (Find                             (* ; 
 
                                                      "Case sensitive search, with * and # wildcards")

-                                 (\TEDIT.KEY.FIND TSTREAM TEXTOBJ))
+                                 (\TEDIT.KEY.FIND TSTREAM))
                            (Looks                            (* ; 
 
                                                 "He wants to set the font for the current selection")

                                   (\TEDIT.LOOKS TEXTOBJ))
@@ -3523,24 +3603,22 @@
                                      (TEDIT.HARDCOPY TEXTOBJ))
                            (Expanded% Menu                   (* ; 
 
                                                             "Open the expanded operations menu.")

-                                (\TEDIT.EXPANDED.MENU TEXTOBJ))
+                                (\TEDIT.EXPANDEDMENU.START TEXTOBJ))
                            (Character% Looks                 (* ; 
 
                                                          "Open the menu for setting character looks")

-                                (\TEDIT.EXPANDEDCHAR.MENU TEXTOBJ))
+                                (\TEDIT.CHARMENU.START TEXTOBJ))
                            (Paragraph% Formatting            (* ; 
 
                                                             "Open the paragraph formatting menu")

-                                (\TEDIT.EXPANDEDPARA.MENU TEXTOBJ))
+                                (\TEDIT.PARAMENU.START TEXTOBJ))
                            (Page% Layout                     (* ; "Open the page-layout menu")

-                                         (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T
-                                                                   )
-                                                (\TEDIT.PRIMARYPANE
 TEXTOBJ)
-                                                "Page Layout Menu" 150 'PAGE))
-                           (CL:WHEN (CAR ITEM)               (* ; 
+                                         (\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
+                                                TSTREAM "Page Layout Menu" 150 'PAGE))
+                           (Buttons (TEDIT.BUTTONS.BUILD))
+                           (CL:WHEN ITEM                     (* ; 
 
                                                  "Apply a user-supplied function to the text stream")

                                [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ T)
                                       '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
-                               (APPLY* (CAR ITEM)
-                                      (fetch
 (TEXTWINDOW WTEXTSTREAM) of
 PANE)))])])
+                               (APPLY* ITEM (TEXTSTREAM PANE)))])])
 
 (TEDIT.REMOVE.MENUITEM

   [LAMBDA (MENU ITEM)                                        (* gbn "26-Apr-84 04:06")

@@ -3609,11 +3687,12 @@
 (RPAQ TEDIT.DEFAULT.MENU

       [\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text))
                            (Get 'Get NIL (SUBITEMS |Get Formatted Document| Unformatted% Get))
-                           Include Find Looks Substitute Quit (Expanded% Menu 'Expanded% Menu NIL
-                                                                     (SUBITEMS Expanded% Menu 
-                                                                            Character% Looks 
-                                                                            Paragraph% Formatting 
-                                                                            Page% Layout])
+                           Include Find Looks Substitute (Buttons 'Buttons "Display action buttons")
+                           Quit
+                           (Expanded% Menu 'Expanded% Menu NIL (SUBITEMS Expanded% Menu 
+                                                                      Character% Looks 
+                                                                      Paragraph% Formatting 
+                                                                      Page% Layout])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
@@ -3644,37 +3723,38 @@
 (RPAQ? TEDIT.TITLED.ICON.TEMPLATE
 (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ 
                                          TEDIT.ICON.TITLE.REGION))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (18257 19153 (TEDIT.DEFER.UPDATES 18267 . 19151)) (19154 42196 (\TEDIT.CREATEW 19164 . 
-25879) (\TEDIT.WINDOW.SETUP 25881 . 29994) (\TEDIT.MINIMAL.WINDOW.SETUP 29996 . 38198) (
-\TEDIT.CLEARPANE 38200 . 38917) (\TEDIT.FILL.PANES 38919 . 42194)) (42197 64911 (\TEDIT.CURSORMOVEDFN 
-42207 . 47080) (\TEDIT.CURSOROUTFN 47082 . 47527) (\TEDIT.ACTIVE.WINDOWP 47529 . 48580) (
-\TEDIT.EXPANDFN 48582 . 49145) (\TEDIT.MAINW 49147 . 50427) (\TEDIT.MAINSTREAM 50429 . 50696) (
-\TEDIT.PRIMARYPANE 50698 . 51468) (\TEDIT.PANELIST 51470 . 51966) (\TEDIT.NEWREGIONFN 51968 . 54484) (
-\TEDIT.SET.WINDOW.EXTENT 54486 . 59740) (\TEDIT.SHRINK.ICONCREATE 59742 . 62282) (\TEDIT.SHRINKFN 
-62284 . 62693) (\TEDIT.PANEREGION 62695 . 64909)) (64943 96398 (\TEDIT.BUTTONEVENTFN 64953 . 77506) (
-\TEDIT.BUTTONEVENTFN.DOOPERATION 77508 . 84231) (\TEDIT.BUTTONEVENTFN.GETOPERATION 84233 . 86075) (
-\TEDIT.BUTTONEVENTFN.CURSEL.INIT 86077 . 89314) (\TEDIT.BUTTONEVENTFN.INACTIVE 89316 . 91658) (
-\TEDIT.BUTTONEVENTFN.INTITLE 91660 . 93495) (\TEDIT.COPYINSERTFN 93497 . 94629) (\TEDIT.FOREIGN.COPY 
-94631 . 96396)) (96399 113508 (\TEDIT.PANE.SPLIT 96409 . 100888) (\TEDIT.SPLITW 100890 . 108349) (
-\TEDIT.UNSPLITW 108351 . 112165) (\TEDIT.LINKPANES 112167 . 112930) (\TEDIT.UNLINKPANE 112932 . 113506
-)) (114865 115756 (TEDITWINDOWP 114875 . 115754)) (115793 118896 (TEDIT.GETINPUT 115803 . 118246) (
-\TEDIT.MAKEFILENAME 118248 . 118894)) (118945 127055 (TEDIT.PROMPTWINDOW 118955 . 119269) (
-TEDIT.PROMPTPRINT 119271 . 121707) (TEDIT.PROMPTCLEAR 121709 . 123428) (TEDIT.PROMPTFLASH 123430 . 
-125362) (\TEDIT.PROMPT.PAGEFULLFN 125364 . 127053)) (127293 136119 (\TEXTSTREAM.TITLE 127303 . 127993)
- (\TEDIT.DEFAULT.TITLE 127995 . 130374) (\TEDIT.WINDOW.TITLE 130376 . 132545) (\TEXTSTREAM.FILENAME 
-132547 . 134217) (\TEDIT.UPDATE.TITLE 134219 . 136117)) (136162 144365 (TEDIT.DEACTIVATE.WINDOW 136172
- . 141965) (\TEDIT.RESHAPEFN 141967 . 144137) (\TEDIT.REPAINTFN 144139 . 144363)) (144366 186365 (
-\TEDIT.SCROLLFN 144376 . 146621) (\TEDIT.SCROLLCH.TOP 146623 . 148734) (\TEDIT.SCROLLCH.BOTTOM 148736
- . 153066) (\TEDIT.SCROLLUP 153068 . 158587) (\TEDIT.TOPLINE.YTOP 158589 . 160258) (\TEDIT.SCROLLDOWN 
-160260 . 167092) (\TEDIT.SCROLL.CARET 167094 . 169932) (\TEDIT.VISIBLECARETP 169934 . 172228) (
-\TEDIT.VISIBLECHARP 172230 . 173321) (\TEDIT.BITMAPLINES 173323 . 177243) (\TEDIT.SETPANE.TOPLINE 
-177245 . 178036) (\TEDIT.SHIFTLINES 178038 . 186363)) (186366 197235 (\TEDIT.ONSCREEN? 186376 . 190927
-) (\TEDIT.ONSCREEN.REGION 190929 . 194580) (\TEDIT.AFTERMOVEFN 194582 . 195479) (OFFSCREENP 195481 . 
-197233)) (197277 199894 (\TEDIT.PROCIDLEFN 197287 . 198824) (\TEDIT.PROCENTRYFN 198826 . 199271) (
-\TEDIT.PROCEXITFN 199273 . 199892)) (199973 213127 (\TEDIT.DOWNCARET 199983 . 200776) (
-\TEDIT.FLASHCARET 200778 . 202889) (\TEDIT.UPCARET 202891 . 203995) (TEDIT.NORMALIZECARET 203997 . 
-207215) (\TEDIT.SETCARET 207217 . 212497) (\TEDIT.CARET 212499 . 213125)) (213161 224800 (
-TEDIT.ADD.MENUITEM 213171 . 215462) (TEDIT.DEFAULT.MENUFN 215464 . 222012) (TEDIT.REMOVE.MENUITEM 
-222014 . 223011) (\TEDIT.CREATEMENU 223013 . 223578) (\TEDIT.MENU.WHENHELDFN 223580 . 224485) (
-\TEDIT.MENU.WHENSELECTEDFN 224487 . 224798)))))
+  (FILEMAP (NIL (18637 19533 (TEDIT.DEFER.UPDATES 18647 . 19531)) (19534 45844 (\TEDIT.WINDOW.CREATE 
+19544 . 26156) (\TEDIT.WINDOW.GETREGION 26158 . 29527) (\TEDIT.WINDOW.SETUP 29529 . 33642) (
+\TEDIT.MINIMAL.WINDOW.SETUP 33644 . 41846) (\TEDIT.CLEARPANE 41848 . 42565) (\TEDIT.FILL.PANES 42567
+ . 45842)) (45845 68752 (\TEDIT.CURSORMOVEDFN 45855 . 50728) (\TEDIT.CURSOROUTFN 50730 . 51175) (
+\TEDIT.ACTIVE.WINDOWP 51177 . 52228) (\TEDIT.EXPANDFN 52230 . 52793) (\TEDIT.MAINW 52795 . 54075) (
+\TEDIT.MAINSTREAM 54077 . 54344) (\TEDIT.PRIMARYPANE 54346 . 55116) (\TEDIT.PANELIST 55118 . 55614) (
+\TEDIT.NEWREGIONFN 55616 . 58132) (\TEDIT.SET.WINDOW.EXTENT 58134 . 63388) (\TEDIT.SHRINK.ICONCREATE 
+63390 . 66123) (\TEDIT.SHRINKFN 66125 . 66534) (\TEDIT.PANEREGION 66536 . 68750)) (68784 100358 (
+\TEDIT.BUTTONEVENTFN 68794 . 81356) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81358 . 88081) (
+\TEDIT.BUTTONEVENTFN.GETOPERATION 88083 . 89925) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89927 . 93164) (
+\TEDIT.BUTTONEVENTFN.INACTIVE 93166 . 95508) (\TEDIT.BUTTONEVENTFN.INTITLE 95510 . 97345) (
+\TEDIT.COPYINSERTFN 97347 . 98479) (\TEDIT.FOREIGN.COPY 98481 . 100356)) (100359 117468 (
+\TEDIT.PANE.SPLIT 100369 . 104848) (\TEDIT.SPLITW 104850 . 112309) (\TEDIT.UNSPLITW 112311 . 116125) (
+\TEDIT.LINKPANES 116127 . 116890) (\TEDIT.UNLINKPANE 116892 . 117466)) (118825 119716 (TEDITWINDOWP 
+118835 . 119714)) (119753 122856 (TEDIT.GETINPUT 119763 . 122206) (\TEDIT.MAKEFILENAME 122208 . 122854
+)) (122905 131206 (TEDIT.PROMPTWINDOW 122915 . 123229) (TEDIT.PROMPTPRINT 123231 . 125858) (
+TEDIT.PROMPTCLEAR 125860 . 127579) (TEDIT.PROMPTFLASH 127581 . 129513) (\TEDIT.PROMPT.PAGEFULLFN 
+129515 . 131204)) (131444 141085 (\TEDIT.FILENAME 131454 . 132226) (\TEDIT.DEFAULT.TITLE 132228 . 
+134607) (\TEDIT.WINDOW.TITLE 134609 . 136778) (\TEDIT.LIKELY.FILENAME 136780 . 138567) (
+\TEDIT.UPDATE.TITLE 138569 . 141083)) (141128 149656 (TEDIT.DEACTIVATE.WINDOW 141138 . 147256) (
+\TEDIT.RESHAPEFN 147258 . 149428) (\TEDIT.REPAINTFN 149430 . 149654)) (149657 192036 (\TEDIT.SCROLLFN 
+149667 . 151912) (\TEDIT.SCROLLCH.TOP 151914 . 154025) (\TEDIT.SCROLLCH.BOTTOM 154027 . 158357) (
+\TEDIT.SCROLLUP 158359 . 163976) (\TEDIT.TOPLINE.YTOP 163978 . 165647) (\TEDIT.SCROLLDOWN 165649 . 
+172579) (\TEDIT.SCROLL.CARET 172581 . 175419) (\TEDIT.VISIBLECARETP 175421 . 177715) (
+\TEDIT.VISIBLECHARP 177717 . 178808) (\TEDIT.BITMAPLINES 178810 . 182730) (\TEDIT.SETPANE.TOPLINE 
+182732 . 183523) (\TEDIT.SHIFTLINES 183525 . 192034)) (192037 202906 (\TEDIT.ONSCREEN? 192047 . 196598
+) (\TEDIT.ONSCREEN.REGION 196600 . 200251) (\TEDIT.AFTERMOVEFN 200253 . 201150) (OFFSCREENP 201152 . 
+202904)) (202948 205565 (\TEDIT.PROCIDLEFN 202958 . 204495) (\TEDIT.PROCENTRYFN 204497 . 204942) (
+\TEDIT.PROCEXITFN 204944 . 205563)) (205644 218798 (\TEDIT.DOWNCARET 205654 . 206447) (
+\TEDIT.FLASHCARET 206449 . 208560) (\TEDIT.UPCARET 208562 . 209666) (TEDIT.NORMALIZECARET 209668 . 
+212886) (\TEDIT.SETCARET 212888 . 218168) (\TEDIT.CARET 218170 . 218796)) (218832 231159 (
+TEDIT.ADD.MENUITEM 218842 . 221133) (TEDIT.DEFAULT.MENUFN 221135 . 228371) (TEDIT.REMOVE.MENUITEM 
+228373 . 229370) (\TEDIT.CREATEMENU 229372 . 229937) (\TEDIT.MENU.WHENHELDFN 229939 . 230844) (
+\TEDIT.MENU.WHENSELECTEDFN 230846 . 231157)))))
 STOP

library/tedit/tedit-exports.all

@@ -1,11 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Dec-2024 11:45:45" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196
 52876  
+
(FILECREATED "28-Mar-2025 17:12:59" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;209
 53312  
 
       :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}<library>TEDIT>tedit-exports.all;195)
+      :PREVIOUS-DATE "16-Mar-2025 00:20:08" {WMEDLEY}<library>TEDIT>tedit-exports.all;208)
 
 
 (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION 
@@ -18,7 +18,7 @@ PRINT))))))))
 (RPAQ? CHECK-TEDIT-ASSERTIONS T)
 (PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
 \TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
-(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 21:39:48"))
+(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:10:12"))
 (RPAQQ \BTREEWORDSPERSLOT 4)
 (RPAQQ \BTREEMAXCOUNT 8)
 (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -44,8 +44,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
  DLEN) of SLOT with DWNL)))
 (PUTPROPS \FINDSLOT MACRO ((BTNODE ITEM) (find S inslots BTNODE suchthat (EQ ITEM (ffetch (BTSLOT DOWN
 ) of S)))))
-(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)))
 (I.S.OPR (QUOTE inslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$BTBODY) (QUOTE (bind $$BTBODY _ BODY
  $$BTEND declare (LOCALVARS $$BTBODY $$BTEND) first (SETQ I.V. (\FIRSTSLOT $$BTBODY)) (SETQ $$BTEND (
 \LASTSLOT $$BTBODY)) repeatuntil (EQ I.V. $$BTEND) by (\ADDBASE I.V. \BTREEWORDSPERSLOT))))) T)
@@ -53,7 +52,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
  (\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
 (I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE))) 
 by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
-(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:12:27"))
+(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 20:56:54"))
 (DATATYPE SELECTION ((* ;; 
 "Description of a piece of selected text for TEdit.  Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
 ) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;; 
@@ -119,7 +118,7 @@ $$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE
 (GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
 (GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION 
 TEDIT.DELETESELECTION)
-(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 6-Dec-2024 12:50:42"))
+(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "19-Mar-2025 16:27:02"))
 (RECORD TAB (TABX . TABKIND))
 (RECORD TABSPEC (DEFAULTTAB . TABS))
 (DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ; 
@@ -149,8 +148,9 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
 "A cached textstream that this line took its text from.  Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity."
 ) NIL (* ; 
 "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit.  Now:  THISLINE comes from TEXTOBJ"
-) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC (
-* ; "The format spec for this line's paragraph (eventually)") (NIL FLAG) (* ; 
+) LFIRSTSEPR (* ; 
+"Character position of the first separator on the line, for detecting the last valid line.") 
+LPARALOOKS (* ; "The paragraph looks for this line's paragraph (eventually)") (NIL FLAG) (* ; 
 "Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ; 
 "Was FORCED-END flag") (NIL FLAG) (* ; 
 "Was DELETED: T if this line has been completely deleted since it was last formatted or displayed.  (Used by deletion routines to detect garbage lines)"
@@ -262,7 +262,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
  THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.) 
 eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.)) 
 repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
-(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:31"))
+(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 17:12:44"))
 (DATATYPE PIECE ((* ; 
 "The piece describes either a string or part of a file.  , or a generalized OBJECT.") PCONTENTS (* ; 
 "The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
@@ -270,8 +270,8 @@ repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
 PBYTELEN (* ; "Length of this character piece in bytes.  PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (* ; 
 "The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.") 
 NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ; 
-"-> Prior piece in this text object.") PLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (* ; 
-"The number of bytes per character, given that all characters in a piece are the same length.") (
+"-> Prior piece in this text object.") PCHARLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (* 
+; "The number of bytes per character, given that all characters in a piece are the same length.") (
 PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") (
 PNEW FLAG) (* ; 
 "This text is new here;  used by the tentative edit system, and anyone else interested.") (NIL FLAG) (
@@ -280,14 +280,14 @@ PNEW FLAG) (* ;
 "High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ; 
 "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
 POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
-PCHARLOOKS (PLOOKS DATUM) (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) FAST (freplace (
-PIECE PLOOKS) of DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ 
-TEDIT.DEFAULT.FMTSPEC)
+PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM) FAST (fetch (PIECE PCHARLOOKS) of DATUM)) (
+STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE) FAST (freplace (PIECE PCHARLOOKS) of 
+DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
 (DATATYPE TEXTOBJ ((* ;; 
 "This is where TEdit stores its state information, and internal data about the text being edited.") 
 PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ; 
 "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
-) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end") 
+) SUFFIXPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end") 
 CHARFN (* ; 
 "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#") 
 HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ; 
@@ -302,10 +302,11 @@ HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
 "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES."
 ) DS (* ; 
 "NOTE:  THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed") 
-SEL (* ; "The current selection within the text") NIL (* ; "Was: Scratch space for the selection code"
-) NIL (* ; "Was MOVESEL: Source for the next MOVE of text") NIL (* ; 
-"Was SHIFTEDSEL: Source for the next COPY") NIL (* ; "Was DELETESEL: Text to be deleted imminently") 
-WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") WTOP (* ; 
+SEL (* ; "The current selection within the text") LASTARROWX (* ; 
+"X for next arrow up or arrow down. Was: Scratch space for the selection code") NIL (* ; 
+"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY") 
+NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ; 
+"Right edge of the window (or subregion) where this is displayed") WTOP (* ; 
 "Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ; 
 "Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG) 
 (* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ; 
@@ -315,7 +316,7 @@ WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") W
 "Font to be used for inserted text.") WINDOWTITLE (* ; 
 "Original title for this window, of there was one.") THISLINE (* ; 
 "Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ; 
-"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ; 
+"T if this TEXTOBJ is a tedit-style menu") DEFAULTPARALOOKS (* ; 
 "Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ; 
 "Flag for paragraph formatting.  T if this document is to contain paragraph formatting information.") 
 (TXTREADONLY FLAG) (* ; "This is only available for shift selection.") (TXTEDITING FLAG) (* ; 
@@ -340,7 +341,7 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL
 "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode"
 ) TXTPAGEFRAMES (* ; "A tree of page frames, specifying how the document is to be laid out.") 
 TXTCHARLOOKSLIST (* ; "List of all the CHARLOOKSs in the document, so they can be kept unique") 
-TXTPARALOOKSLIST (* ; "List of all the FMTSPECs in the document, so they can be kept unique") (
+TXTPARALOOKSLIST (* ; "List of all the PARALOOKS in the document, so they can be kept unique") (
 TXTAPPENDONLY FLAG) (* ; 
 "Allows updates only at the end of the stream.  Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater"
 ) (TXTDON'TUPDATE FLAG) (* ; 
@@ -349,10 +350,11 @@ TXTAPPENDONLY FLAG) (* ;
 "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ; 
 "Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ; 
 "Style sheet local to this document.  Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
-(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM
-)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))))) SEL _ (create 
-SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _
- (create THISLINE) FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
+(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (FSETTOBJ DATUM LASTARROWX NIL) (CL:UNLESS (EQ 
+NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY 
+OF DATUM WITH NEWVALUE)))))) SEL _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 
+WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _ (create THISLINE) DEFAULTPARALOOKS _ 
+TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
 (ACCESSFNS TEXTSTREAM ((* ;; 
 "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;; 
 "The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3) 
@@ -362,10 +364,10 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i
  DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") (
 NIL) (* ; 
 "Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ."
-) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with 
+) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (replace (STREAM IMAGEDATA) of DATUM with 
 NEWVALUE)) (* ; 
-"The FMTSPEC that is currently applicable to characters being taken from the stream. This was  the only residual field of TEXTIMAGEDATA, now gone."
-) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ; 
+"THIS IS SOMEHOW INVOLVED IN STYLES, NOT SENSIBLE. REMOVE? The PARALOOKS that is currently applicable to characters being taken from the stream. This was  the only residual field of TEXTIMAGEDATA, now gone."
+) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (replace (STREAM F4) OF DATUM with NEWVALUE)) (* ; 
 "Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting."
 ) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? 
 (AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create 
@@ -377,8 +379,8 @@ IMAGEDATA _ NIL)))
 (PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
 (PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
 (PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
-(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
-(PUTPROPS PCHARLOOKS MACRO ((PC) (PLOOKS PC)))
+(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
+(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
 (PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
 (PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
 (PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
@@ -444,25 +446,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
 BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE 
 THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
 (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
-(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:17:20"))
-(RPAQQ NONE.TTC 0)
-(RPAQQ CHARDELETE.TTC 1)
-(RPAQQ WORDDELETE.TTC 2)
-(RPAQQ DELETE.TTC 3)
-(RPAQQ FUNCTIONCALL.TTC 4)
-(RPAQQ REDO.TTC 5)
-(RPAQQ UNDO.TTC 6)
-(RPAQQ CMD.TTC 7)
-(RPAQQ NEXT.TTC 8)
-(RPAQQ EXPAND.TTC 9)
-(RPAQQ CHARDELETE.FORWARD.TTC 10)
-(RPAQQ WORDDELETE.FORWARD.TTC 11)
-(RPAQQ PUNCT.TTC 20)
-(RPAQQ TEXT.TTC 21)
-(RPAQQ WHITESPACE.TTC 22)
-(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (
-REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) (
-WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
+(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:26:47"))
 (PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;; 
 "Test to see if only the specified mouse button is down.  DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
 ) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
@@ -471,28 +455,20 @@ WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
 I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP) 
 "TEdit consistency-check failure [RETURN to continue]:  " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
 )) (T (CONS COMMENTFLG ARGS)))))
-(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) (TTDECODE (LOGAND DATUM 31))))
-(RPAQQ NOTBEFORE.LB 1)
-(RPAQQ NOTAFTER.LB 2)
-(RPAQQ BEFORE.LB 4)
-(RPAQQ AFTER.LB 8)
-(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16)
-(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
-(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16) 
-(NEWCHAR-IF-SPLIT.LB 32))
-(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "28-Nov-2024 10:03:03"))
+(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "23-Mar-2025 15:27:20"))
 (PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
 \BIN STREAM)) BITSPERWORD)))
 (PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
 LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
-(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 23:00:13"))
-(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2024 16:09:28"))
+(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:24:34"))
+(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:09:40"))
 (DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") 
 (* ;; "NOTE:  If fields change EQCLOOKS should change too.") CLFONT (* ; 
-"The font descriptor for these characters") CLNAME (* ;; 
+"The font descriptor for these characters") CLFONTUNPARSE (* ;; 
 "Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE.  USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
-) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") (
-CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ; 
+) NIL (* ; "Was  CLSIZE. Font size, in points") (NIL FLAG) (* ; 
+"Was CLITAL: T if the characters are italic, else NIL") (NIL FLAG) (* ; 
+"Was CLBoldT if the characters are bold, else NIL") (CLULINE FLAG) (* ; 
 "T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ; 
 "T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ; 
 "T if the characters are to be struck thru, else nil.") CLOFFSET (* ; 
@@ -512,8 +488,10 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
 ) (CLMARK FLAG) (* ;; 
 "Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
 ) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields).")) 
-CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
-(DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.") 
+CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))) (ACCESSFNS (
+CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (CHARLOOKS CLFONTUNPARSE) of DATUM with 
+NEWVALUE))))
+(DATATYPE PARALOOKS ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.") 
 1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ; 
 "Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ; 
 "Right margin for the paragraph") LEADBEFORE (* ; 
@@ -521,8 +499,8 @@ CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRI
 "Leading below the paragraph's bottom line, in points.  NOT IMPLEMENTED.") LINELEAD (* ; 
 "Leading between lines, in points.  This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented."
 ) FMTBASETOBASE (* ; 
-"The baseline-to-baseline spacing between lines in this paragraph.  THIS OVERRIDES THE LINE LEADING") 
-NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width") 
+"The baseline-to-baseline spacing between lines in this paragraph.  THIS  OVERRIDES THE LINE LEADING")
+ NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width") 
 QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ; 
 "The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ; 
 "The characterstyles that control the appearance of characters in this para (maybe?  may be part of the fmtstyle.)"
@@ -546,25 +524,33 @@ QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED")
 ) FMTHARDCOPYSCALE (* ; 
 "The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T"
 ) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT (
-DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 
-0)
+DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 
+LINELEAD _ 0)
 (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
-(DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))
+(DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))
 (PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A
 )) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
 \PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V)))
 (PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF)))))
-(PUTPROPS FSETPARA MACRO ((F FIELD NEWVALUE) (freplace (FMTSPEC FIELD) of F with NEWVALUE)))
-(PUTPROPS FGETPARA MACRO ((F FIELD) (ffetch (FMTSPEC FIELD) of F)))
-(PUTPROPS GETPARA MACRO ((F FIELD) (fetch (FMTSPEC FIELD) of F)))
-(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) (replace (FMTSPEC FIELD) of F with NEWVALUE)))
 (PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL)))
 (PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE)))
 (PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL)))
 (PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
-(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC))))
 (PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
-(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46"))
+(PUTPROPS GETPLOOKS MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
+(PUTPROPS SETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
+))
+(PUTPROPS FGETPLOOKS MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
+(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with 
+NEWVALUE)))
+(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
+(PUTPROPS FSETPARA MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
+))
+(PUTPROPS FGETPARA MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
+(PUTPROPS GETPARA MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
+(PUTPROPS SETPARA MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)))
+(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:24:25"))
+(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:31:28"))
 (DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
  is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
  means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
@@ -606,6 +592,8 @@ WTEXTSTREAM) of PANE)))))
 )))
 (PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
 )
+(PUTPROPS PANERIGHT MACRO ((PANE PREG) (fetch (REGION RIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
+)))
 (PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
 )))))
 (PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
@@ -618,8 +606,8 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
 GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO 
 $$OUT)))))
 (PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
-(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:00:10"))
-(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:24:22"))
+(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:07:08"))
+(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "24-Mar-2025 09:26:13"))
 (RPAQQ PTSPERPICA 12)
 (RPAQQ PTSPERINCH 72)
 (RPAQQ PICASPERINCH 6)
@@ -630,10 +618,15 @@ $$OUT)))))
 (CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT 
 PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT 
 MICASPERINCH PTSPERINCH)))
-(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2024 21:21:48"))
-(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12"))
-(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "26-Nov-2024 23:53:32"))
-(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23"))
+(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "23-Mar-2025 14:56:57"))
+(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:07:00"))
+(RPAQQ \TEDIT.TTCCODES ((NONE 0) (CHARDELETE 1) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
+UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT 
+21) (WHITESPACE 22)))
+(CONSTANTS \TEDIT.TTCCODES)
+(PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
+(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 10:13:53"))
+(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:34:37"))
 (DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* 
 ; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?") 
 THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ; 
@@ -647,7 +640,7 @@ TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVE
 (PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
 (PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with 
 NEWVALUE)))
-(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 19:41:55"))
+(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:23:18"))
 (RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ; 
 "The current page number.  Counted from 1") FIRSTPAGE (* ;; 
 "T if the current page is the 'first page' .  Is set initially, and can be set again by the user at will.  Gets reset after each page image is printed."
@@ -678,9 +671,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
 (PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
 (PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
 )
-(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 22:39:52"))
-(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
-(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50"))
+(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "23-Feb-2025 10:06:16"))
+(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 10:13:36"))
+(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:23:07"))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP

lispusers/COMMENTHACKS

@@ -281,4 +281,3 @@ Copyright (c) 1987 by Unisys Corp..  All rights reserved.
   (FILEMAP (NIL (1135 12019 (EDITDEF.FUNCTIONS 1145 . 1784) (FIXDEFUNEDITDATE 1786 . 3426) (MYEDITDATE? 
 3428 . 4692) (MYSUPERPRINT/COMMENT 4694 . 7753) (MYSUPERPRINT/COMMENT2 7755 . 12017)))))
 STOP
-ÿ

lispusers/COMPAREDIRECTORIES

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-May-2024 14:53:20" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;260
 131326 
+
(FILECREATED "26-Mar-2025 09:41:31" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;267
 133447 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS COMPAREDIRECTORIES)
+      :CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
+                  (FNS CD-MENUFN)
 
-      :PREVIOUS-DATE "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259)
+      :PREVIOUS-DATE "18-Feb-2025 23:37:14" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;264)
 
 
 (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
@@ -15,6 +16,8 @@
        [
         (* ;; "Compare the contents of two directories.")

 
+        (FILES (SYSLOAD)
+               PDFSTREAM)
         (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES 
              CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE 
              CD.UPDATEWIDTHS)
@@ -50,6 +53,7 @@
                    CDTABLEBROWSER.HEADING.REPAINTFN)
               (FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CD-COMPARE-FILES 
                    CDBROWSER-COPY CDBROWSER-DELETE-FILE CD-SWAPDIRS)
+              (INITVARS (CD-LINELENGTH NIL))
               (VARS CDTABLEBROWSER.MENUITEMS)
               (FILES (SYSLOAD)
                      COMPARESOURCES COMPARETEXT)
@@ -59,6 +63,9 @@
 
 (* ;; "Compare the contents of two directories.")

 
+
+(FILESLOAD (SYSLOAD)
+       PDFSTREAM)
 (DEFINEQ
 
 (COMPAREDIRECTORIES

@@ -1955,6 +1962,12 @@
 (CD-MENUFN

   [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
 
+    (* ;; "Edited 26-Mar-2025 09:39 by rmk")

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

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

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

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

@@ -1967,53 +1980,86 @@
     (CL:WHEN (MEMB MENUITEM '(Compare See See% right See% both See% left))
                                                              (* ; "Close the previous ones")

         (CLOSEWITH.DOIT WINDOW))
-    (LET (CHILDREN)
-         (SETQ CHILDREN (SELECTQ MENUITEM
-                            (Compare (IF
 (AND FILE1 FILE2)
-                                         THEN
 (CD-COMPARE-FILES
 FILE1 FILE2 LABEL1 LABEL2 TYPE
-                                                     (WINDOWPROP WINDOW 'REGION))
-                                       ELSE
 (FLASHWINDOW T)
-                                            (PRIN3 "Only one file" T)))
-                            (See% left (IF
 FILE1
-                                           THEN
 (TEDIT-SEE FILE1
-                                                       (RELCREATEREGION
-                                                        700 700 'RIGHT 'TOP `(,WINDOW 0.5)
-                                                        (IPLUS (FETCH
 (REGION BOTTOM)
-                                                                  OF
 (WINDOWPROP WINDOW 'REGION))
-                                                               -1)
-                                                        T)
-                                                       NIL
-                                                       (CONCAT "SEE window for " LABEL1))
-                                         ELSE
 (FLASHWINDOW T)
-                                              (PRIN3 "No file to print" T)))
-                            (See% right (IF
 FILE2
-                                            THEN
 (TEDIT-SEE FILE2
-                                                        (RELCREATEREGION
-                                                         700 700 'LEFT 'TOP `(,WINDOW 0.5)
-                                                         (IPLUS (FETCH
 (REGION BOTTOM)
-                                                                   OF
 (WINDOWPROP WINDOW 'REGION))
-                                                                -1)
-                                                         NIL)
-                                                        NIL
-                                                        (CONCAT "SEE window for " LABEL2))
-                                          ELSE
 (FLASHWINDOW T)
-                                               (PRIN3 "No file to print" T)))
-                            ((See See% both) 
-                                 (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
-                                        (RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
-                                               (IPLUS (FETCH
 (REGION BOTTOM)
-                                                         OF
 (WINDOWPROP WINDOW 'REGION))
-                                                      -1)
-                                               NIL)))
-                            (Copy% -> (CDBROWSER-COPY
 CDBROWSER TBITEM 'LEFT))
-                            (Copy% <- (CDBROWSER-COPY
 CDBROWSER TBITEM 'RIGHT))
-                            (Delete% <- (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT T))
-                            (|Delete ALL <-| 
-                                 (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT NIL))
-                            (Delete% -> (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT T))
-                            (|Delete ALL ->| 
-                                 (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT NIL))
-                            (SHOULDNT)))
+    (LET ((SOURCEWIDTH (ITIMES (OR CD-LINELENGTH TEDIT.SOURCE.LINELENGTH)
+                              (CHARWIDTH (CHARCODE SPACE)
+                                     DEFAULTFONT)))
+          CHILDREN)
+         (SETQ CHILDREN
+          (SELECTQ MENUITEM
+              (Compare (IF
 (AND FILE1 FILE2)
+                           THEN
 (CD-COMPARE-FILES
 FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
+                                                                                  WINDOW
+                                                                                  'REGION))
+                         ELSE
 (FLASHWINDOW T)
+                              (PRIN3 "Only one file" T)))
+              (See% left (IF
 FILE1
+                             THEN
 (if
 (PDFFILEP FILE1)
+                                      then
 (SEE-PDF FILE1)
+                                    else
 (TEDIT-SEE FILE1 (RELCREATEREGION
+                                                           (CL:IF (LISPSOURCEFILEP FILE1)
+                                                               SOURCEWIDTH
+                                                               700)
+                                                           700
+                                                           'RIGHT
+                                                           'TOP
+                                                           `(,WINDOW 0.5)
+                                                           (IPLUS (FETCH
 (REGION BOTTOM)
+                                                                     OF
 (WINDOWPROP WINDOW
+                                                                               'REGION))
+                                                                  -1)
+                                                           T)
+                                                NIL
+                                                (CONCAT "SEE window for " LABEL1)))
+                           ELSE
 (FLASHWINDOW T)
+                                (PRIN3 "No file to print" T)))
+              (See% right (IF
 FILE2
+                              THEN
 (if
 (PDFFILEP FILE2)
+                                       then
 (SEE-PDF FILE2)
+                                     else
 (TEDIT-SEE FILE2 (RELCREATEREGION
+                                                            (CL:IF (LISPSOURCEFILEP FILE2)
+                                                                SOURCEWIDTH
+                                                                700)
+                                                            700
+                                                            'LEFT
+                                                            'TOP
+                                                            `(,WINDOW 0.5)
+                                                            (IPLUS (FETCH
 (REGION BOTTOM)
+                                                                      OF
 (WINDOWPROP WINDOW
+                                                                                'REGION))
+                                                                   -1)
+                                                            NIL)
+                                                 NIL
+                                                 (CONCAT "SEE window for " LABEL2)))
+                            ELSE
 (FLASHWINDOW T)
+                                 (PRIN3 "No file to print" T)))
+              ((See See% both) 
+                   (IF
 (PDFFILEP FILE1)
+                       then
 (SEE-PDF FILE1)
+                            (CL:WHEN (PDFFILEP FILE2)
+                                   (SEE-PDF FILE2))
+                     elseif
 (PDFFILEP FILE2)
+                       then
 (SEE-PDF FILE2)
+                     else
 (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
+                                 (RELCREATEREGION (ITIMES 2 (CL:IF (LISPSOURCEFILEP FILE1)
+                                                                SOURCEWIDTH
+                                                                700))
+                                        700
+                                        'LEFT
+                                        'TOP
+                                        `(,WINDOW 0.5 -701)
+                                        (IPLUS (FETCH
 (REGION BOTTOM) OF
 (WINDOWPROP WINDOW
+                                                                                'REGION))
+                                               -1)
+                                        NIL))))
+              (Copy% -> (CDBROWSER-COPY
 CDBROWSER TBITEM 'LEFT))
+              (Copy% <- (CDBROWSER-COPY
 CDBROWSER TBITEM 'RIGHT))
+              (Delete% <- (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT T))
+              (|Delete ALL <-| 
+                   (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'LEFT NIL))
+              (Delete% -> (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT T))
+              (|Delete ALL ->| 
+                   (CDBROWSER-DELETE-FILE
 CDBROWSER TBITEM 'RIGHT NIL))
+              (SHOULDNT)))
          (CLOSEWITH CHILDREN WINDOW)
          (MOVEWITH CHILDREN WINDOW])
 
@@ -2189,6 +2235,8 @@
       ELSE
 (ERROR FILE (CONCAT " doesn't begin with " FROMDIR])
 )
 
+(RPAQ? CD-LINELENGTH
 NIL)
+
 (RPAQQ CDTABLEBROWSER.MENUITEMS
 ((Compare CD-MENUFN)
                                  (Copy% -> CD-MENUFN)
                                  (Copy% <- CD-MENUFN)
@@ -2202,25 +2250,25 @@
 
 (MOVD? 'NILL 'TEDIT.FILEDATE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2526 22889 (COMPAREDIRECTORIES 2536 . 7871) (COMPAREDIRECTORIES.INFOS 7873 . 10831) (
-COMPAREDIRECTORIES.CANDIDATES 10833 . 14218) (CDENTRIES.SELECT 14220 . 18995) (
-COMPAREDIRECTORIES.INFOS.TYPE 18997 . 20123) (MATCHNAME 20125 . 20805) (CD.INSURECDVALUE 20807 . 22421
-) (CD.UPDATEWIDTHS 22423 . 22887)) (22890 33512 (CDFILES 22900 . 28914) (CDFILES.MATCH 28916 . 30541) 
-(CDFILES.PATS 30543 . 33510)) (33513 51334 (CDPRINT 33523 . 36040) (CDPRINT.HEADER 36042 . 36939) (
-CDPRINT.LINE 36941 . 40173) (CDPRINT.MAXWIDTHS 40175 . 44290) (CDPRINT.COLHEADERS 44292 . 45577) (
-CDPRINT.COLUMNS 45579 . 50699) (CDTEDIT 50701 . 51332)) (51335 60456 (CDMAP 51345 . 52777) (CDENTRY 
-52779 . 53088) (CDSUBSET 53090 . 54529) (CDMERGE 54531 . 58515) (CDMERGE.COMMON 58517 . 59832) (
-CD.SORT 59834 . 60454)) (60457 67995 (BINCOMP 60467 . 64756) (EOLTYPE 64758 . 67320) (EOLTYPE.SHOW 
-67322 . 67993)) (68523 81050 (FIND-UNCOMPILED-FILES 68533 . 72176) (FIND-UNSOURCED-FILES 72178 . 74562
-) (FIND-SOURCE-FILES 74564 . 76302) (FIND-COMPILED-FILES 76304 . 78181) (FIND-UNLOADED-FILES 78183 . 
-79036) (FIND-LOADED-FILES 79038 . 79466) (FIND-MULTICOMPILED-FILES 79468 . 81048)) (81051 89482 (
-CREATED-AS 81061 . 85858) (SOURCE-FOR-COMPILED-P 85860 . 88787) (COMPILE-SOURCE-DATE-DIFF 88789 . 
-89480)) (89483 100246 (FIX-DIRECTORY-DATES 89493 . 92943) (FIX-EQUIV-DATES 92945 . 94470) (
-COPY-COMPARED-FILES 94472 . 96293) (COPY-MISSING-FILES 96295 . 98452) (COMPILED-ON-SAME-SOURCE 98454
- . 100244)) (100440 108278 (CDBROWSER 100450 . 104377) (CDBROWSER.STRINGS 104379 . 108276)) (108440 
-110176 (CD.TABLEITEM 108450 . 108670) (CD.TABLEITEM.PRINTFN 108672 . 108871) (CD.TABLEITEM.COPYFN 
-108873 . 109931) (CDTABLEBROWSER.HEADING.REPAINTFN 109933 . 110174)) (110177 130832 (
-CDTABLEBROWSER.WHENSELECTEDFN 110187 . 110655) (CD.COMMANDSELECTEDFN 110657 . 115758) (CD-MENUFN 
-115760 . 120071) (CD-COMPARE-FILES 120073 . 123425) (CDBROWSER-COPY 123427 . 127096) (
-CDBROWSER-DELETE-FILE 127098 . 130311) (CD-SWAPDIRS 130313 . 130830)))))
+  (FILEMAP (NIL (2701 23064 (COMPAREDIRECTORIES 2711 . 8046) (COMPAREDIRECTORIES.INFOS 8048 . 11006) (
+COMPAREDIRECTORIES.CANDIDATES 11008 . 14393) (CDENTRIES.SELECT 14395 . 19170) (
+COMPAREDIRECTORIES.INFOS.TYPE 19172 . 20298) (MATCHNAME 20300 . 20980) (CD.INSURECDVALUE 20982 . 22596
+) (CD.UPDATEWIDTHS 22598 . 23062)) (23065 33687 (CDFILES 23075 . 29089) (CDFILES.MATCH 29091 . 30716) 
+(CDFILES.PATS 30718 . 33685)) (33688 51509 (CDPRINT 33698 . 36215) (CDPRINT.HEADER 36217 . 37114) (
+CDPRINT.LINE 37116 . 40348) (CDPRINT.MAXWIDTHS 40350 . 44465) (CDPRINT.COLHEADERS 44467 . 45752) (
+CDPRINT.COLUMNS 45754 . 50874) (CDTEDIT 50876 . 51507)) (51510 60631 (CDMAP 51520 . 52952) (CDENTRY 
+52954 . 53263) (CDSUBSET 53265 . 54704) (CDMERGE 54706 . 58690) (CDMERGE.COMMON 58692 . 60007) (
+CD.SORT 60009 . 60629)) (60632 68170 (BINCOMP 60642 . 64931) (EOLTYPE 64933 . 67495) (EOLTYPE.SHOW 
+67497 . 68168)) (68698 81225 (FIND-UNCOMPILED-FILES 68708 . 72351) (FIND-UNSOURCED-FILES 72353 . 74737
+) (FIND-SOURCE-FILES 74739 . 76477) (FIND-COMPILED-FILES 76479 . 78356) (FIND-UNLOADED-FILES 78358 . 
+79211) (FIND-LOADED-FILES 79213 . 79641) (FIND-MULTICOMPILED-FILES 79643 . 81223)) (81226 89657 (
+CREATED-AS 81236 . 86033) (SOURCE-FOR-COMPILED-P 86035 . 88962) (COMPILE-SOURCE-DATE-DIFF 88964 . 
+89655)) (89658 100421 (FIX-DIRECTORY-DATES 89668 . 93118) (FIX-EQUIV-DATES 93120 . 94645) (
+COPY-COMPARED-FILES 94647 . 96468) (COPY-MISSING-FILES 96470 . 98627) (COMPILED-ON-SAME-SOURCE 98629
+ . 100419)) (100615 108453 (CDBROWSER 100625 . 104552) (CDBROWSER.STRINGS 104554 . 108451)) (108615 
+110351 (CD.TABLEITEM 108625 . 108845) (CD.TABLEITEM.PRINTFN 108847 . 109046) (CD.TABLEITEM.COPYFN 
+109048 . 110106) (CDTABLEBROWSER.HEADING.REPAINTFN 110108 . 110349)) (110352 132922 (
+CDTABLEBROWSER.WHENSELECTEDFN 110362 . 110830) (CD.COMMANDSELECTEDFN 110832 . 115933) (CD-MENUFN 
+115935 . 122161) (CD-COMPARE-FILES 122163 . 125515) (CDBROWSER-COPY 125517 . 129186) (
+CDBROWSER-DELETE-FILE 129188 . 132401) (CD-SWAPDIRS 132403 . 132920)))))
 STOP