Compare commits
2 Commits
medley-250
...
fgh_lfg-lo
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d91176bc90 | ||
|
|
a55246bc59 |
6
.github/workflows/buildDocker.yml
vendored
6
.github/workflows/buildDocker.yml
vendored
@@ -154,8 +154,7 @@ 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"
|
||||
@@ -172,8 +171,7 @@ 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
|
||||
|
||||
2
.github/workflows/buildReleaseInclDocker.yml
vendored
2
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -131,7 +131,7 @@ jobs:
|
||||
run: |
|
||||
if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
|
||||
then
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref main
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
|
||||
fi
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}
|
||||
|
||||
@@ -1,352 +1,164 @@
|
||||
<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>
|
||||
<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><p>Use <em>FILE</em> as the Medley greetfile.</p>
|
||||
<p>If the given value is “-”, Medley will start up without using a greetfile.</p>
|
||||
<p>The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-x [<em>DIR</em> | - | –], --logindir [<em>DIR</em> | - | –]</dt>
|
||||
<dd>
|
||||
<p>Use <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>
|
||||
<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><p>Use <em>DIR</em> as the directory containing the Maiko emulator. For testing purposes only.</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:
|
||||
<https://github.com/Interlisp/medley/issues></p>
|
||||
<p>See GitHub Issues: <https://github.com/Interlisp/medley/issues></p>
|
||||
<h1>COPYRIGHT</h1>
|
||||
<p>Copyright(c) 2023-2024 by Interlisp.org</p>
|
||||
|
||||
@@ -1,19 +1,5 @@
|
||||
.\" Automatically generated by Pandoc 3.1.3
|
||||
.\" Automatically generated by Pandoc 2.9.2.1
|
||||
.\"
|
||||
.\" Define V font for inline verbatim, using C font in formats
|
||||
.\" that render this, and otherwise B font.
|
||||
.ie "\f[CB]x\f[]"x" \{\
|
||||
. ftr V B
|
||||
. ftr VI BI
|
||||
. ftr VB B
|
||||
. ftr VBI BI
|
||||
.\}
|
||||
.el \{\
|
||||
. ftr V CR
|
||||
. ftr VI CI
|
||||
. ftr VB CB
|
||||
. ftr VBI CBI
|
||||
.\}
|
||||
.ad l
|
||||
.TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
|
||||
.nh
|
||||
@@ -22,8 +8,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.
|
||||
@@ -305,21 +291,6 @@ 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.
|
||||
@@ -370,22 +341,6 @@ 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
|
||||
\
|
||||
|
||||
Binary file not shown.
@@ -1,4 +1,4 @@
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
|
||||
---
|
||||
adjusting: l
|
||||
@@ -210,16 +210,6 @@ 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.
|
||||
|
||||
@@ -252,12 +242,6 @@ 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
|
||||
-------------
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Mar-2025 10:31:37" {WMEDLEY}<doctools>IMINDEX.;10 37350
|
||||
(FILECREATED " 7-Apr-2024 09:25:49" {WMEDLEY}<doctools>IMINDEX.;6 37064
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS IM.INDEX.EDIT)
|
||||
:CHANGES-TO (FNS IM.INDEX.PUTFN IM.INDEX.GETFN)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2025 12:07:55" {WMEDLEY}<doctools>IMINDEX.;9)
|
||||
:PREVIOUS-DATE " 4-Apr-2024 23:17:47" {WMEDLEY}<doctools>IMINDEX.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMINDEXCOMS)
|
||||
@@ -163,13 +163,11 @@
|
||||
(TERPRI PTRFILE])
|
||||
|
||||
(IM.INDEX.EDIT
|
||||
[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")
|
||||
[LAMBDA (OBJ TEXTSTREAM) (* ; "Edited 18-Jul-88 14:10 by burns")
|
||||
|
||||
(PROG* ((W (FREEMENU IM.INDEX.OBJ.FREEMENU.SPECS))
|
||||
(REGION (WINDOWREGION W))
|
||||
(TEDIT.WINDOW (TEDITWINDOWP TEXTSTREAM))
|
||||
[TEDIT.WINDOW (CAR (fetch \WINDOW of (TEXTOBJ TEXTSTREAM]
|
||||
(TEDIT.REGION (AND TEDIT.WINDOW (WINDOWREGION TEDIT.WINDOW)))
|
||||
OBJ.DATA OBJ.DATA.PROPLIST)
|
||||
(WINDOWPROP W 'IM.INDEX.OBJ OBJ)
|
||||
@@ -642,13 +640,13 @@
|
||||
|
||||
(IM.INDEX.INIT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Mar-2025 22:37:05" {WMEDLEY}<internal>TEDIT-DEBUG.;143 131559
|
||||
(FILECREATED "16-Dec-2024 20:38:14" {WMEDLEY}<internal>TEDIT-DEBUG.;123 130350
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (MACROS DEBUGOUTPUT)
|
||||
(FNS SP SL SSP SPF STL TEST.TEMPLATE)
|
||||
:CHANGES-TO (FNS SP)
|
||||
|
||||
:PREVIOUS-DATE "28-Mar-2025 20:51:43" {WMEDLEY}<internal>TEDIT-DEBUG.;141)
|
||||
:PREVIOUS-DATE "14-Dec-2024 14:32:20" {WMEDLEY}<internal>TEDIT-DEBUG.;122)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
||||
@@ -27,14 +26,11 @@
|
||||
(COMS (* ;
|
||||
"Get/set (default) object, stream, window, selection")
|
||||
(FNS GTO GTS GTW GSEL)
|
||||
(INITVARS (LASTTEXTSTREAM NIL))
|
||||
(FNS TEST.TEMPLATE))
|
||||
(FNS TESTACTION)
|
||||
(INITVARS (LASTTEXTSTREAM NIL)))
|
||||
(COMS (* ; "Inspect")
|
||||
(FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES))
|
||||
(COMS (* ; "Show")
|
||||
(FNS SP SL SSP SPF SLF SHOWLINE SLL STBYTES SSEL)
|
||||
(FNS STL CLEARTHISLINE))
|
||||
(FNS SP SL SSP STL SPF SLF SHOWLINE SLL STBYTES))
|
||||
(COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES))
|
||||
(COMS (FNS FILEBYTES TFILEBYTES))
|
||||
(FNS TRELMOVE TSCROLL TSCROLL*)
|
||||
@@ -56,7 +52,7 @@
|
||||
(FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC))
|
||||
(INITVARS (LASTTS NIL))
|
||||
(VARS (OK.TO.MODIFY.FNS T))
|
||||
(FNS OLDWI COMP DFR)
|
||||
(FNS DFOV OLDWI DFOV.OLDEST COMP DFR)
|
||||
(FNS DFGV GDIRECTORIES)
|
||||
(COMS (FNS TTEST LTEST THC)
|
||||
(INITVARS (LASTTTESTFILE))
|
||||
@@ -74,7 +70,7 @@
|
||||
(FILES (NOERROR)
|
||||
VERSIONDEFS)
|
||||
(* ; "Until this is release")
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV DFOV)
|
||||
(NLAML DFVENUE DFR)
|
||||
(LAMA])
|
||||
|
||||
@@ -113,16 +109,14 @@
|
||||
(fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))])
|
||||
|
||||
(GTS
|
||||
[LAMBDA (ARG NOERROR) (* ; "Edited 1-Feb-2025 08:25 by rmk")
|
||||
(* ; "Edited 23-Nov-2024 11:38 by rmk")
|
||||
[LAMBDA (ARG NOERROR) (* ; "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)
|
||||
unless (WINDOWPROP W 'TEDIT-DEBUG) collect W))
|
||||
(LET* ((TWINDOWS (for W in (OPENWINDOWS) when (WINDOWPROP W 'TEDITCREATED) collect W))
|
||||
(TSTREAM (TEXTSTREAM (OR ARG (CL:IF (CDR TWINDOWS)
|
||||
(WHICHW)
|
||||
(CAR TWINDOWS)))
|
||||
@@ -154,39 +148,6 @@
|
||||
)
|
||||
|
||||
(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"])
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -360,31 +321,25 @@
|
||||
(LENGTH UNDONEEVENTS])
|
||||
|
||||
(IPCTB
|
||||
[LAMBDA (ARG) (* ; "Edited 28-Mar-2025 20:42 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:45 by rmk")
|
||||
[LAMBDA (ARG) (* ; "Edited 31-Oct-2023 19:45 by rmk")
|
||||
(* ; "Edited 4-May-2023 20:28 by rmk")
|
||||
(SETQ ARG (GTO ARG))
|
||||
(INSPECT (GETTOBJ ARG PCTB)
|
||||
'LIST)
|
||||
ARG])
|
||||
(INSPECT (FETCH (TEXTOBJ PCTB) of (GTO ARG))
|
||||
'LIST])
|
||||
|
||||
(IMB
|
||||
[LAMBDA (IDENTIFIER ARG) (* ; "Edited 28-Mar-2025 20:45 by rmk")
|
||||
(* ; "Edited 22-Aug-2024 16:34 by rmk")
|
||||
[LAMBDA (KEY ARG) (* ; "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 IDENTIFIER")
|
||||
(* ;; "Inspect the menu button for KEY")
|
||||
|
||||
(LET [(OBJ (MB.GET IDENTIFIER (GTO ARG)
|
||||
(LET [(OBJ (MB.FIND KEY (GTO ARG)
|
||||
'OBJECT]
|
||||
(CL:IF OBJ (INSPECT OBJ NIL NIL IDENTIFIER))
|
||||
OBJ])
|
||||
(CL:IF OBJ (INSPECT OBJ NIL NIL KEY])
|
||||
|
||||
(ICL
|
||||
[LAMBDA (PC ARG) (* ; "Edited 28-Mar-2025 20:39 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
[LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 13:33 by rmk")
|
||||
|
||||
(* ;; "Inspect the character looks of PC")
|
||||
@@ -392,27 +347,21 @@
|
||||
(LET ((DECODED (IPC.DECODEARGS PC ARG)))
|
||||
(SETQ PC (POP DECODED))
|
||||
(INSPECT (PCHARLOOKS PC)
|
||||
NIL NIL (CONCAT PC " " (POP DECODED)))
|
||||
(PCHARLOOKS PC])
|
||||
NIL NIL (CONCAT PC " " (POP DECODED])
|
||||
|
||||
(IPL
|
||||
[LAMBDA (PC ARG) (* ; "Edited 28-Mar-2025 20:39 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
[LAMBDA (PC ARG) (* ; "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)))
|
||||
(PPARALOOKS PC])
|
||||
NIL NIL (CONCAT PC " " (POP DECODED])
|
||||
|
||||
(ICARET
|
||||
[LAMBDA (ARG) (* ; "Edited 28-Mar-2025 20:40 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 13:48 by rmk")
|
||||
[LAMBDA (ARG) (* ; "Edited 27-Nov-2024 13:48 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 13:33 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 11:42 by rmk")
|
||||
(SETQ ARG (GTW ARG))
|
||||
(INSPECT (PANECARET ARG))
|
||||
(PANECARET ARG])
|
||||
(INSPECT (PANECARET (GTW ARG])
|
||||
|
||||
(INSPECTPIECES
|
||||
[LAMBDA (PIECE N TAG WHERE) (* ; "Edited 16-Mar-2024 10:07 by rmk")
|
||||
@@ -444,17 +393,25 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SP
|
||||
[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")
|
||||
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "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.")
|
||||
@@ -464,16 +421,13 @@
|
||||
(PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC)
|
||||
PC
|
||||
(GTO TOBJ)))
|
||||
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))
|
||||
WTYPE)
|
||||
(CL:WHEN (AND NP (LITATOM NP)
|
||||
(NULL OFILE))
|
||||
(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))
|
||||
@@ -502,8 +456,8 @@
|
||||
(SETQ NP (CL:IF NP
|
||||
20
|
||||
MAX.SMALLP)))
|
||||
(DEBUGOUTPUT OFILE WTYPE TITLE (DSPFONT (OR FONT '(TERMINAL 8))
|
||||
OFILE)
|
||||
(DEBUGOUTPUT OFILE WTYPE (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
|
||||
@@ -525,10 +479,7 @@
|
||||
(RETURN PC])
|
||||
|
||||
(SL
|
||||
[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")
|
||||
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "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")
|
||||
@@ -540,18 +491,11 @@
|
||||
|
||||
(* ;; "Shows a selection of the lines backing the display in PANE")
|
||||
|
||||
(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))
|
||||
(LET (LINES WTYPE PNO)
|
||||
(CL:UNLESS OFILE
|
||||
(CL:WHEN (EQ LASTLINE T)
|
||||
(SETQ WTYPE 'SL)
|
||||
(SETQ LASTLINE NIL)))
|
||||
(CL:WHEN [AND (type? LINEDESCRIPTOR (CAR (LISTP FIRSTLINE)))
|
||||
(NULL LASTLINE)
|
||||
(OR (NULL (CDR FIRSTLINE))
|
||||
@@ -564,8 +508,8 @@
|
||||
(SETQ TOBJ (pop LINES))
|
||||
(SETQ PANE (pop LINES))
|
||||
(SETQ PNO (pop LINES))
|
||||
(DEBUGOUTPUT OFILE WTYPE TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8)
|
||||
"Pane " PNO " = " PANE T)
|
||||
(DEBUGOUTPUT OFILE WTYPE (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)
|
||||
@@ -574,16 +518,11 @@
|
||||
finally (CL:WHEN (EQ LASTLINE (PANEBOTTOMLINE PANE))
|
||||
(SHOWLINE (PANESUFFIX PANE)
|
||||
OFILE TOBJ)))
|
||||
(TERPRI OFILE)
|
||||
(CL:WHEN (EQ FIRSTLINE LASTLINE)
|
||||
(printout OFILE (for L inlines (FGETLD LASTLINE NEXTLINE) sum 1)
|
||||
" lines below LASTLINE" T T)))
|
||||
(TERPRI OFILE))
|
||||
FIRSTLINE])
|
||||
|
||||
(SSP
|
||||
[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")
|
||||
[LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "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")
|
||||
@@ -593,23 +532,149 @@
|
||||
|
||||
(* ;; "Prints up to NP pieces from SELPIECES.")
|
||||
|
||||
(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))
|
||||
(SETQ TEXTOBJ (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 29-Mar-2025 22:36 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 21:25 by rmk")
|
||||
[LAMBDA (ARG TITLE OFILE) (* ; "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")
|
||||
@@ -627,9 +692,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 TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD)
|
||||
TITLE .FONT '(TERMINAL 8)
|
||||
T)
|
||||
(DEBUGOUTPUT OFILE 'SPF (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))
|
||||
@@ -899,160 +964,6 @@
|
||||
(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
|
||||
|
||||
@@ -1290,9 +1201,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SPPRINT
|
||||
[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")
|
||||
[LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "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")
|
||||
@@ -1355,12 +1264,12 @@
|
||||
.I4 PLEN (CL:IF (PPARALAST P)
|
||||
"*"
|
||||
"")
|
||||
(CL:IF (type? PARALOOKS PARALOOKS)
|
||||
(if (GETPLOOKS PARALOOKS FMTNEWPAGEBEFORE)
|
||||
then (CL:IF (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
|
||||
(CL:IF (type? FMTSPEC PARALOOKS)
|
||||
(if (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOKS)
|
||||
then (CL:IF (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOKS)
|
||||
"ba"
|
||||
"b")
|
||||
elseif (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
|
||||
elseif (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOKS)
|
||||
then "a"
|
||||
else "")
|
||||
"")
|
||||
@@ -1436,8 +1345,7 @@
|
||||
OSTREAM)))])
|
||||
|
||||
(SPPRINT.OBJ
|
||||
[LAMBDA (OBJ STREAM POS) (* ; "Edited 9-Jan-2025 16:48 by rmk")
|
||||
(* ; "Edited 6-Oct-2024 20:54 by rmk")
|
||||
[LAMBDA (OBJ STREAM POS) (* ; "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")
|
||||
@@ -1456,7 +1364,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)
|
||||
" ")))
|
||||
@@ -1514,15 +1422,13 @@
|
||||
P])
|
||||
|
||||
(SBT
|
||||
[LAMBDA (DONTCLOSE ARG) (* ; "Edited 28-Mar-2025 20:41 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 22:00 by rmk")
|
||||
[LAMBDA (DONTCLOSE ARG) (* ; "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
|
||||
@@ -1531,9 +1437,8 @@
|
||||
OF (WINDOWPROP W 'REGION]
|
||||
10)))
|
||||
else (CLOSEW W))
|
||||
(SETATOMVAL 'BTW (INSPECT (GETTOBJ ARG PCTB)
|
||||
'LIST POS))
|
||||
(GETTOBJ ARG PCTB])
|
||||
(SETATOMVAL 'BTW (INSPECT (fetch PCTB of (GTO ARG))
|
||||
'LIST POS])
|
||||
|
||||
(COPYPCHAIN
|
||||
[LAMBDA (PIECES I J) (* ; "Edited 23-Sep-2023 11:38 by rmk")
|
||||
@@ -1978,8 +1883,7 @@
|
||||
(for R in (fetch (PARA RUNS) of PARA) do (PRUN R BSTR)))])
|
||||
|
||||
(PRUN
|
||||
[LAMBDA (RUN BSTR) (* ; "Edited 2-Jan-2025 10:28 by rmk")
|
||||
(* ; "Edited 22-Aug-2023 10:59 by rmk")
|
||||
[LAMBDA (RUN BSTR) (* ; "Edited 22-Aug-2023 10:59 by rmk")
|
||||
(* ; "Edited 8-Aug-2023 16:47 by rmk")
|
||||
|
||||
(* ;; "Shows the characters in RUN, with font information")
|
||||
@@ -1998,15 +1902,26 @@
|
||||
(LET (FONT (CL (fetch (RUN RUNLOOKS) of RUN)))
|
||||
(SETQ FONT (fetch (CHARLOOKS CLFONT) of CL))
|
||||
(TAB 13 NIL 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))
|
||||
(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)))
|
||||
RUN)])
|
||||
|
||||
(ADDLINEPOSITIONS
|
||||
@@ -2089,12 +2004,58 @@
|
||||
(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])
|
||||
@@ -2362,27 +2323,23 @@
|
||||
|
||||
(PUTPROPS DEBUGOUTPUT MACRO
|
||||
[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))])
|
||||
`(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))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2462,37 +2419,37 @@
|
||||
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA VSEE DFGV)
|
||||
(ADDTOVAR NLAMA VSEE DFGV DFOV)
|
||||
|
||||
(ADDTOVAR NLAML DFVENUE DFR)
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4 34381
|
||||
(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3 34260
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
|
||||
|
||||
:PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
|
||||
:PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMAGEOBJCOMS)
|
||||
@@ -674,8 +674,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(GET.OBJ.FROM.USER
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Dec-2024 19:44 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 21:04 by rmk")
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "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.")
|
||||
@@ -689,7 +688,7 @@
|
||||
(TEDIT.INSERT TEXTSTREAM VAL))
|
||||
(LITATOM (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))))
|
||||
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)))
|
||||
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
|
||||
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
|
||||
(T [COND
|
||||
@@ -770,12 +769,12 @@
|
||||
|
||||
(FILESLOAD EDITBITMAP)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,22 @@
|
||||
(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
|
||||
|
||||
(FILECREATED "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28 197707
|
||||
changes to%: (FNS MSINTERPRETSET)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: " 9-Jun-2021 23:55:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
|
||||
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jul-2024 11:54:48" {WMEDLEY}<library>MASTERSCOPE.;27)
|
||||
|
||||
(* ; "
|
||||
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)
|
||||
@@ -25,13 +28,13 @@
|
||||
[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))
|
||||
@@ -39,11 +42,11 @@
|
||||
(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)
|
||||
@@ -183,9 +186,9 @@
|
||||
MSFILELST])
|
||||
|
||||
(MSSHOWUSE
|
||||
[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")
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Show/Edit where SHOWFN uses/etc. a pattern.")
|
||||
|
||||
@@ -193,7 +196,7 @@
|
||||
(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)
|
||||
'?)
|
||||
@@ -205,45 +208,43 @@
|
||||
(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)
|
||||
(DSPFONT (PROG1 (DSPFONT BOLDFONT)
|
||||
(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)
|
||||
(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
|
||||
@@ -2402,14 +2403,14 @@
|
||||
(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])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2568,7 +2569,7 @@
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS GETWORDTYPE MACRO [(WORD TYPE)
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2577,7 +2578,7 @@
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE "14-Jul-2024")
|
||||
(RPAQ MASTERSCOPEDATE "13-Jun-2021")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3526,31 +3527,8 @@
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
[LAMBDA (FILE) (* ; "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")
|
||||
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT]
|
||||
(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])
|
||||
(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))
|
||||
)
|
||||
|
||||
(MSCHECKEMPTY
|
||||
[LAMBDA NIL (* lmm "20-JAN-79 14:08")
|
||||
@@ -3643,15 +3621,15 @@
|
||||
(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))
|
||||
)
|
||||
@@ -3748,37 +3726,39 @@
|
||||
|
||||
(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 (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 191885 (MSINTERPRET 167823 . 184676)
|
||||
(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187013) (MSCHECKEMPTY 187015 . 188219) (
|
||||
CHECKFORCHANGED 188221 . 188741) (MSSOLVE 188743 . 191883)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62 14729
|
||||
(FILECREATED "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59 14133
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPEN-PDF-STREAM)
|
||||
:CHANGES-TO (VARS PDFSTREAMCOMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60)
|
||||
:PREVIOUS-DATE "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -153,8 +153,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPEN-PDF-STREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Feb-2025 12:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 14:49 by rmk")
|
||||
|
||||
@@ -172,26 +171,20 @@
|
||||
(* ;; "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)
|
||||
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])
|
||||
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])
|
||||
|
||||
(CLOSE-PDF-STREAM
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
@@ -272,14 +265,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SEE-PDF
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 25-Dec-2024 14:25 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
[LAMBDA (PDFFILE) (* ; "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 (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
|
||||
(ERROR "FILE NOT FOUND" PDFFILE])
|
||||
(ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
|
||||
)
|
||||
|
||||
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
|
||||
@@ -292,8 +283,8 @@
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
|
||||
PDF.TEDIT 5508 . 5875)) (6317 13806 (OPEN-PDF-STREAM 6327 . 8892) (CLOSE-PDF-STREAM 8894 . 10181) (
|
||||
PS-TO-PDF 10183 . 13804)) (13807 14371 (SEE-PDF 13817 . 14369)) (14422 14706 (PDFCONVERTER 14432 .
|
||||
14704)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
954
library/UNICODE
954
library/UNICODE
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 13:05:52" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;3 164570
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2 164484
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LAFITE.SET.LOOKS LAFITE.SUBSTITUTE.VP.EOL)
|
||||
:CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2)
|
||||
:PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
|
||||
@@ -560,7 +560,7 @@
|
||||
(LAFITE.SET.LOOKS TEXTSTREAM LAFITEFIXEDWIDTHFONT])
|
||||
|
||||
(LAFITE.SET.LOOKS
|
||||
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN) (* ; "Edited 15-Feb-2025 13:02 by rmk")
|
||||
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN)
|
||||
(* ; "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,56 +571,57 @@
|
||||
(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 (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")
|
||||
(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
|
||||
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
|
||||
(CONS (CONS (TEDIT.SELPROP SEL 'CH#)
|
||||
LEN)
|
||||
FIXEDLOOKS)))
|
||||
(* ;; "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)))
|
||||
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.")
|
||||
|
||||
@@ -656,31 +657,31 @@
|
||||
STR])
|
||||
|
||||
(LAFITE.SUBSTITUTE.VP.EOL
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 13:03 by rmk")
|
||||
(* ; "Edited 4-Aug-89 16:55 by bvm")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "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))
|
||||
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))))])
|
||||
(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))))])
|
||||
)
|
||||
|
||||
(RPAQ? \LAFITE.DISPLAY.COMMANDS NIL)
|
||||
@@ -2545,37 +2546,37 @@
|
||||
(ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "22-Jan-87 01:34:36" {ERIS}<LISPUSERS>LISPCORE>LAFITE-INDENT.;1 25845
|
||||
|
||||
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
|
||||
previous date%: "21-Jan-87 16:06:01" {ERIS}<LISPUSERS>KOTO>LAFITE-INDENT.;5)
|
||||
|
||||
: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
|
||||
@@ -33,14 +31,12 @@
|
||||
(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
|
||||
@@ -49,14 +45,12 @@
|
||||
("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.)
|
||||
@@ -133,10 +127,14 @@
|
||||
max-length max-length])
|
||||
|
||||
(TEDIT-INDENT-BREAK-LONG-LINES
|
||||
[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")
|
||||
[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)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -144,13 +142,11 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
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]
|
||||
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]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
||||
*eol-string*)
|
||||
@@ -185,10 +181,15 @@
|
||||
'RIGHT])
|
||||
|
||||
(TEDIT-INDENT-SELECTION
|
||||
[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")
|
||||
[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)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -196,13 +197,11 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
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]
|
||||
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]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
||||
hanging-indent)
|
||||
@@ -232,19 +231,18 @@
|
||||
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
||||
|
||||
(TEDIT-INDENT-SET-INDENT
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
|
||||
(* smL "12-Sep-86 17:09")
|
||||
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
|
||||
|
||||
(* * Prompt the user for a new indentation string)
|
||||
|
||||
(* ;;; "Prompt the user for a new indentation string")
|
||||
|
||||
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
|
||||
(LET* ((window (fetch \WINDOW of (TEXTOBJ 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
|
||||
@@ -269,34 +267,36 @@
|
||||
else string])
|
||||
|
||||
(TEDIT-MAKE-LINES-EXPLICIT
|
||||
[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")
|
||||
[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)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
[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]
|
||||
[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]
|
||||
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
|
||||
|
||||
(TEDIT-OPEN-LINE
|
||||
[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.")
|
||||
[LAMBDA (text-stream) (* 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 (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1))
|
||||
" ")))
|
||||
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
|
||||
(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))
|
||||
then (TEDIT.SETSEL text-stream selection])
|
||||
|
||||
(TEDIT-REMOVE-INDENT
|
||||
@@ -393,27 +393,21 @@
|
||||
|
||||
(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
|
||||
@@ -424,21 +418,21 @@
|
||||
("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 (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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 13:05:38" {WMEDLEY}<library>lafite>LAFITE-SEND.;4 100003
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2 100561
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \SENDMSG.CHANGE.MODE)
|
||||
:CHANGES-TO (VARS LAFITE-SENDCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-SENDCOMS)
|
||||
@@ -222,14 +222,14 @@
|
||||
(ERROR!])
|
||||
|
||||
(\SENDMSG.CHANGE.MODE
|
||||
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 15-Feb-2025 13:05 by rmk")
|
||||
(* ; "Edited 5-Jan-90 18:06 by bvm")
|
||||
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "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,51 +244,58 @@
|
||||
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 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]
|
||||
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]
|
||||
|
||||
(* ;; "Exit with error so that the window is restored to previous state")
|
||||
|
||||
@@ -1754,29 +1761,29 @@ cc: ~A
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 14:03:21" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;4 6618
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2 6592
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.ASSURE.NO.BACKING.FILE)
|
||||
:CHANGES-TO (VARS LAFITE-TEDITCOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-TEDITCOMS)
|
||||
@@ -74,8 +74,7 @@
|
||||
(TEXTPROP TEXTSTREAM '\WINDOW NIL])
|
||||
|
||||
(TEDIT.ASSURE.NO.BACKING.FILE
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 14:03 by rmk")
|
||||
(* ; "Edited 13-Jan-2024 18:08 by rmk")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "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:")
|
||||
@@ -83,17 +82,18 @@
|
||||
(* ;; "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 (GETTEXTPROP TEXTSTREAM 'FILESTREAM))
|
||||
(OFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
NEWFILE)
|
||||
(CL:WHEN [AND OFILE (NEQ 'NODIRCORE (FILENAMEFIELD (TRUEFILENAME OFILE)
|
||||
'HOST]
|
||||
(CL:WHEN [AND (TYPE? STREAM OFILE)
|
||||
(NEQ 'NODIRCORE (FETCH (FDEV DEVICENAME) OF (FETCH (STREAM DEVICE)
|
||||
OF (TRUEFILENAME OFILE]
|
||||
(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))
|
||||
(PUTTEXTPROP TEXTOBJ 'TXTFILE NIL)
|
||||
(FSETTOBJ TEXTOBJ TXTFILE NIL)
|
||||
(PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE)
|
||||
TEXTSTREAM)])
|
||||
|
||||
@@ -118,6 +118,6 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@@ -1,208 +1,98 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Mar-2025 17:09:00" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;20 15864
|
||||
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9 10946
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2025 22:21:20" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;19)
|
||||
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(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])
|
||||
(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])
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 30-May-91 19:27 by jds")
|
||||
(* ; "Expand an abbvreviation")
|
||||
(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 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])
|
||||
(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))])
|
||||
|
||||
(\TEDIT.EXPAND.DATE
|
||||
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
|
||||
@@ -219,92 +109,100 @@
|
||||
" " DAY ", " YEAR])
|
||||
|
||||
(\TEDIT.TRY.ABBREV
|
||||
[LAMBDA (KEY TSTREAM) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
[LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ")
|
||||
(* ;;
|
||||
"Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.")
|
||||
|
||||
(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")
|
||||
(* ;; "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 ((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.")
|
||||
(PROG (SEL CH# (CH NIL)
|
||||
EXPANSION)
|
||||
(SETQ EXPANSION (OR (SASSOC ABBREV TEDIT.ABBREVS)
|
||||
(SASSOC (U-CASE ABBREV)
|
||||
TEDIT.ABBREVS)))
|
||||
|
||||
(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])
|
||||
(* 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])
|
||||
)
|
||||
(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 (2933 14520 (\TEDIT.ABBREV.EXPAND 2943 . 5054) (\TEDIT.ABBREV.PARSE 5056 . 12222) (
|
||||
\TEDIT.EXPAND.DATE 12224 . 12857) (\TEDIT.TRY.ABBREV 12859 . 14518)))))
|
||||
(FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
|
||||
\TEDIT.TRY.ABBREV 6831 . 8977)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Mar-2025 09:26:13" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;223 124611
|
||||
(FILECREATED "22-Dec-2024 22:47:22" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;200 119344
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MB.FIELD.INSURETYPE MB.BUTTONEVENTINFN)
|
||||
:CHANGES-TO (FNS MB.3STATE.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "14-Mar-2025 15:29:51" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;219)
|
||||
:PREVIOUS-DATE "20-Dec-2024 22:19:48" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;198)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||
@@ -19,11 +19,12 @@
|
||||
(COMS (* ;
|
||||
"Generic functions for the various types of buttons.")
|
||||
(RECORDS MBARG)
|
||||
(FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDIT.BACKTOMAIN))
|
||||
(FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDITMENU.STREAM 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 MB.SPEC.REMAINDER)
|
||||
MB.TRACK.UNTIL MB.DON'T)
|
||||
(GLOBALVARS MB.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.INIT]
|
||||
[COMS (* ; "3STATE")
|
||||
|
||||
@@ -31,6 +32,7 @@
|
||||
|
||||
(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")
|
||||
|
||||
@@ -40,15 +42,18 @@
|
||||
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])
|
||||
|
||||
|
||||
@@ -67,8 +72,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.ADD
|
||||
[LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES) (* ; "Edited 5-Jan-2025 11:36 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 09:16 by rmk")
|
||||
[LAMBDA (MENUDESC MENUTSTREAM WHERE) (* ; "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")
|
||||
@@ -88,80 +92,73 @@
|
||||
|
||||
(* ;; "Returns the textstream character number of the character just after the last inserted character/object.")
|
||||
|
||||
(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)
|
||||
(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 (\TEDIT.SHOWSEL NIL NIL MENUTSTREAM)
|
||||
(* ;
|
||||
"User has to click to get a selection")
|
||||
(SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ))
|
||||
SET NIL)
|
||||
(RETURN CH#)))])
|
||||
(add CH# (EVAL TYPE))
|
||||
else (\ILLEGAL.ARG DESC))) finally (RETURN CH#])
|
||||
|
||||
(MB.DELETE
|
||||
[LAMBDA (IDENTIFIERS MENUSTREAM) (* ; "Edited 8-Nov-2024 08:58 by rmk")
|
||||
@@ -171,8 +168,7 @@
|
||||
(CAR CHNOS])
|
||||
|
||||
(MB.GET
|
||||
[LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "Edited 11-Jan-2025 20:49 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 09:24 by rmk")
|
||||
[LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "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")
|
||||
@@ -255,9 +251,9 @@
|
||||
(ERROR R " is not a button return"))
|
||||
finally (CL:UNLESS (CDR RETURNS)
|
||||
(RETURN (CAR $$VAL)))])
|
||||
(CL:IF (LISTP IDENTIFIERS)
|
||||
RESULT
|
||||
(CADR RESULT))))])
|
||||
(CL:IF (LITATOM IDENTIFIERS)
|
||||
(CADR RESULT)
|
||||
RESULT)))])
|
||||
|
||||
(MB.GET.MBARG
|
||||
[LAMBDA (IDPC MENUSTREAM) (* ; "Edited 17-Dec-2024 11:54 by rmk")
|
||||
@@ -288,6 +284,17 @@
|
||||
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")
|
||||
@@ -308,9 +315,6 @@
|
||||
|
||||
(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")
|
||||
@@ -321,7 +325,6 @@
|
||||
|
||||
(if [OR (EQ BUTTON 'RIGHT)
|
||||
(SHIFTDOWNP 'CTRL)
|
||||
(SHIFTDOWNP 'SHIFT)
|
||||
(LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
|
||||
(OR (ILESSP RELX 0)
|
||||
(ILESSP RELY 0)
|
||||
@@ -512,11 +515,7 @@
|
||||
'INVERT))])
|
||||
|
||||
(MB.CREATE
|
||||
[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")
|
||||
[LAMBDA (SPEC IMAGEFNS) (* ; "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")
|
||||
@@ -533,34 +532,25 @@
|
||||
|
||||
(* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields. ")
|
||||
|
||||
(for S PROP VAL IDENTIFIER LABEL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS
|
||||
(CADR (ASSOC 'IMAGEFNS SPEC))
|
||||
MB.IMAGEFNS))) in SPEC
|
||||
(for S PROP VAL (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 (SETQ LABEL (SETQ VAL (MKSTRING VAL))))
|
||||
(IDENTIFIER (SETQ IDENTIFIER VAL)
|
||||
(GO $$ITERATE))
|
||||
((LABEL IDENTIFIER)
|
||||
(SETQ VAL (MKATOM VAL)))
|
||||
NIL)
|
||||
(IMAGEOBJPROP OBJ PROP VAL)
|
||||
finally (CL:UNLESS (IMAGEOBJPROP OBJ 'FONT)
|
||||
(IMAGEOBJPROP OBJ 'FONT (FONTCREATE '(HELVETICA 8 BOLD)
|
||||
NIL NIL NIL 'DISPLAY)))
|
||||
(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: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))))
|
||||
(CL:WHEN (IMAGEOBJPROP OBJ 'INITSTATE)
|
||||
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP OBJ 'INITSTATE)))
|
||||
(MB.SETIMAGE OBJ)
|
||||
@@ -579,14 +569,12 @@
|
||||
(TEDIT.OBJECT.CHANGED TEXTOBJ OBJ])
|
||||
|
||||
(MB.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:49 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
[LAMBDA NIL (* ; "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)
|
||||
@@ -622,17 +610,10 @@
|
||||
(* ; "Edited 7-Dec-2024 08:58 by rmk")
|
||||
(CL:UNLESS (IMAGEOBJPROP OBJ 'DELETABLE)
|
||||
'DON'T])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(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])
|
||||
(GLOBALVARS MB.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -715,8 +696,7 @@
|
||||
NIL])
|
||||
|
||||
(MB.3STATE.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:49 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 12:38 by rmk")
|
||||
[LAMBDA NIL (* ; "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")
|
||||
@@ -724,7 +704,6 @@
|
||||
|
||||
(* ;; "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)
|
||||
@@ -799,6 +778,10 @@
|
||||
(TEDIT.BACKTOMAIN MENUTSTREAM)))
|
||||
'DON'T])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.3STATE.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.3STATE.INIT)
|
||||
@@ -816,10 +799,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.NWAY.CREATE
|
||||
[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")
|
||||
[LAMBDA (SPEC) (* ; "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")
|
||||
@@ -844,10 +824,6 @@
|
||||
(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)
|
||||
@@ -1010,9 +986,7 @@
|
||||
BOX])
|
||||
|
||||
(MB.NWAY.SELECT
|
||||
[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")
|
||||
[LAMBDA (OBJ SELECTED MENUWINDOW SEL) (* ; "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")
|
||||
@@ -1028,37 +1002,29 @@
|
||||
(CL:WHEN (AND SELECTED (NEQ SELECTED T)
|
||||
(LITATOM SELECTED))
|
||||
(SETQ SELECTED (MB.NWAY.FINDSUBOBJ SELECTED OBJ)))
|
||||
(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) (* ;
|
||||
(CL:UNLESS (EQ OLDSELECTED SELECTED) (* ; "Reclicking is a no-op. ")
|
||||
(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)
|
||||
@@ -1139,8 +1105,7 @@
|
||||
NEWOBJ])
|
||||
|
||||
(MB.NWAY.INIT
|
||||
[LAMBDA (BUTTONS FONT INITSTATE) (* ; "Edited 7-Jan-2025 22:50 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
[LAMBDA (BUTTONS FONT INITSTATE) (* ; "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")
|
||||
@@ -1148,7 +1113,6 @@
|
||||
|
||||
(* ;; "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)
|
||||
@@ -1191,8 +1155,7 @@
|
||||
(RETURN (DREVERSE LINES])
|
||||
|
||||
(MB.NWAY.ADDITEM
|
||||
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 9-Jan-2025 11:38 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 00:13 by rmk")
|
||||
[LAMBDA (OBJ NEWBUTTON) (* ; "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")
|
||||
@@ -1206,7 +1169,7 @@
|
||||
|
||||
(CL:WHEN NEWBUTTON
|
||||
(LET* [(SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS))
|
||||
[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,NEWBUTTON)
|
||||
[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,(U-CASE NEWBUTTON))
|
||||
(LABEL ,NEWBUTTON)
|
||||
(FONT ,(IMAGEOBJPROP OBJ 'FONT]
|
||||
(MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE]
|
||||
@@ -1267,6 +1230,10 @@
|
||||
(TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC))
|
||||
PC])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.NWAY.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.NWAY.INIT)
|
||||
@@ -1319,8 +1286,7 @@
|
||||
(BLTSHADE BLACKSHADE STREAM X Y XSIZE YSIZE 'INVERT))])
|
||||
|
||||
(MB.TOGGLE.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:50 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 12:33 by rmk")
|
||||
[LAMBDA NIL (* ; "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")
|
||||
@@ -1328,7 +1294,6 @@
|
||||
(* ; "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)
|
||||
@@ -1453,6 +1418,10 @@
|
||||
((DESELECTED HIGHLIGHTED UNHIGHLIGHTED))
|
||||
NIL])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.TOGGLE.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.TOGGLE.INIT)
|
||||
@@ -1465,11 +1434,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.FIELD.CREATE
|
||||
[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")
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "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")
|
||||
@@ -1497,21 +1462,22 @@
|
||||
[FIELDFONT (FONTCREATE (OR (CADR (ASSOC 'FIELDFONT SPEC))
|
||||
'(HELVETICA 8]
|
||||
PRE POST FIELDLOOKS PREFIXOBJ SUFFIXOBJ REMAINDER)
|
||||
(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))
|
||||
|
||||
(* ;; "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))
|
||||
|
||||
(* ;; "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)))
|
||||
@@ -1523,29 +1489,25 @@
|
||||
|
||||
(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")
|
||||
(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 MENUTSTREAM (MKSTRING INITSTATE)
|
||||
CH#
|
||||
`(FONT ,FIELDFONT]
|
||||
(add CH# (NCHARS INITSTATE)))
|
||||
(TEDIT.INSERT.OBJECT SUFFIXOBJ MENUTSTREAM CH# FIELDFONT)
|
||||
(add CH# 1])
|
||||
|
||||
@@ -1585,9 +1547,7 @@
|
||||
XKERN _ 0])
|
||||
|
||||
(MB.FIELD.PREFIXCREATE
|
||||
[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")
|
||||
[LAMBDA (SPEC PRE FIELDLOOKS) (* ; "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")
|
||||
@@ -1617,12 +1577,12 @@
|
||||
(IMAGEOBJPROP OBJ SPEC 'SETSTATEFN (FUNCTION MB.FIELD.SETSTATEFN)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDLOOKS FIELDLOOKS)
|
||||
(for S in SPEC unless (MEMB (CAR S)
|
||||
'(PRELABEL POSTLABEL LABELFONT IDENTIFIER FIELDFONT))
|
||||
'(PRELABEL POSTLABEL LABELFONT 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**))
|
||||
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Can SELECTION be initialized?")
|
||||
(CL:UNLESS (SELECTQ FIELDTYPE
|
||||
(NUMBER (NUMBERP INITSTATE))
|
||||
(SYMBOL (LITATOM INITSTATE))
|
||||
@@ -1634,12 +1594,9 @@
|
||||
((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])
|
||||
|
||||
@@ -1666,8 +1623,7 @@
|
||||
OBJ])
|
||||
|
||||
(MB.FIELD.INIT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:51 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 09:05 by rmk")
|
||||
[LAMBDA NIL (* ; "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")
|
||||
@@ -1677,7 +1633,6 @@
|
||||
|
||||
(* ;; "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)
|
||||
@@ -1885,8 +1840,7 @@
|
||||
XKERN _ 0])
|
||||
|
||||
(MB.FIELD.INSURETYPE
|
||||
[LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 24-Mar-2025 09:26 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 20:09 by rmk")
|
||||
[LAMBDA (FIELDTYPE STR TSTREAM) (* ; "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")
|
||||
@@ -1907,8 +1861,6 @@
|
||||
((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))
|
||||
@@ -1956,30 +1908,34 @@
|
||||
(\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 (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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17 12449
|
||||
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16 12363
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
|
||||
|
||||
:PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16)
|
||||
:PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-CHATCOMS)
|
||||
@@ -70,8 +70,7 @@
|
||||
(replace (CHAT.STATE HELD) of STATE with NIL])
|
||||
|
||||
(TEDITCHAT.CHARFN
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 11-Mar-2025 15:40 by rmk")
|
||||
(* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "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")
|
||||
@@ -80,7 +79,7 @@
|
||||
(TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM))
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
|
||||
(LF NIL)
|
||||
(BOUT TSTREAM CH])
|
||||
)
|
||||
@@ -214,6 +213,6 @@
|
||||
CHATDECLS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (886 4630 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4628)) (4677 11561 (TEDIT.DISPLAYTEXT 4687 . 11559)))))
|
||||
(FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,31 +1,165 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Mar-2025 15:27:20" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;163 19331
|
||||
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133 49278
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION? \TEDIT.COMMAND.LOOP)
|
||||
(VARS TEDIT-COMMANDCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
|
||||
|
||||
:PREVIOUS-DATE "16-Mar-2025 14:20:07" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;160)
|
||||
:PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
|
||||
|
||||
(RPAQQ TEDIT-COMMANDCOMS
|
||||
((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)
|
||||
[[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)
|
||||
[INITVARS (TEDIT.INTERRUPTS '((2 BREAK)
|
||||
(5 ERROR)
|
||||
(7 HELP)
|
||||
(20 CONTROL-T]
|
||||
(VARS (|| NIL))
|
||||
(* ; "Why?")
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)))
|
||||
(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])
|
||||
(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.")
|
||||
@@ -49,118 +183,39 @@
|
||||
(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")
|
||||
@@ -199,6 +254,133 @@
|
||||
(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")
|
||||
@@ -296,17 +478,445 @@
|
||||
(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 (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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Mar-2025 10:02:49" {WMEDLEY}<library>tedit>TEDIT-FILE.;607 161915
|
||||
(FILECREATED "23-Dec-2024 23:02:54" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;592 159471
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-FILECOMS)
|
||||
(FNS TEDITFROMLISPSOURCE \TEDIT.PUT.PCTB.NEXTNEW)
|
||||
:CHANGES-TO (FNS TEDIT.PUT TEDIT.PUT.STREAM)
|
||||
|
||||
:PREVIOUS-DATE "14-Mar-2025 15:29:22" {WMEDLEY}<library>tedit>TEDIT-FILE.;605)
|
||||
:PREVIOUS-DATE "16-Dec-2024 11:25:16" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;591)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -56,7 +55,6 @@
|
||||
(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 (* ;
|
||||
@@ -119,8 +117,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.GET
|
||||
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 14-Mar-2025 11:52 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 16:15 by rmk")
|
||||
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "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")
|
||||
@@ -154,7 +151,7 @@
|
||||
[SETQ FILE (\TEDIT.MAKEFILENAME (OR FILE (TEDIT.GETINPUT TEXTOBJ "GET from: "
|
||||
(OR (GETTEXTPROP TEXTOBJ
|
||||
'LASTGETFILENAME)
|
||||
(\TEDIT.LIKELY.FILENAME TEXTOBJ]
|
||||
(\TEXTSTREAM.FILENAME TEXTOBJ]
|
||||
(CL:UNLESS FILE
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "No input file--aborted" T T)
|
||||
(RETURN))
|
||||
@@ -252,8 +249,7 @@
|
||||
(GDATE IDATE)))])
|
||||
|
||||
(TEDIT.INCLUDE
|
||||
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 8-Feb-2025 20:56 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 20:17 by rmk")
|
||||
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "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")
|
||||
@@ -368,7 +364,7 @@
|
||||
[SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL START END
|
||||
`(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TOOBJ TSEL)
|
||||
PARALOOKS
|
||||
,(GETTOBJ TOOBJ DEFAULTPARALOOKS)
|
||||
,(GETTOBJ TOOBJ FMTSPEC)
|
||||
PLAINTEXT
|
||||
,PLAINTEXT]
|
||||
|
||||
@@ -393,9 +389,7 @@
|
||||
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
|
||||
|
||||
(TEDIT.PUT
|
||||
[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")
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "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")
|
||||
@@ -456,11 +450,10 @@
|
||||
(SETQ FORCENEW 'DETEMPLATE)))
|
||||
[SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Put to: "
|
||||
(CL:UNLESS FORCENEW
|
||||
(
|
||||
\TEDIT.LIKELY.FILENAME
|
||||
(\TEXTSTREAM.FILENAME
|
||||
TEXTOBJ UNFORMATTED?
|
||||
])
|
||||
(T (SETQ FILE (\TEDIT.LIKELY.FILENAME TEXTOBJ UNFORMATTED?)))
|
||||
(T (SETQ FILE (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED?)))
|
||||
NIL)
|
||||
(CL:UNLESS FILE (* ; "No file to put to.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "No output file--aborted" T T)
|
||||
@@ -486,10 +479,9 @@
|
||||
'(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS)
|
||||
'DON'T]
|
||||
(CL:UNLESS QUIET
|
||||
(SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
|
||||
"..."))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T))
|
||||
(SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
|
||||
"..."))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -516,9 +508,8 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:UNLESS QUIET
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -581,9 +572,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.FOREIGN.FILE
|
||||
[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")
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "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")
|
||||
@@ -617,16 +606,15 @@
|
||||
(SETQ FTEXTOBJ (TEXTOBJ FSTREAM))
|
||||
(\TEDIT.INSERTPIECES (\TEDIT.FIRSTPIECE FTEXTOBJ)
|
||||
NIL TTEXTOBJ)
|
||||
(FSETTOBJ TTEXTOBJ SUFFIXPIECE (FGETTOBJ FTEXTOBJ SUFFIXPIECE))
|
||||
(FSETTOBJ TTEXTOBJ LASTPIECE (FGETTOBJ FTEXTOBJ LASTPIECE))
|
||||
(* ; "Last piece have different looks")
|
||||
(FSETTOBJ TTEXTOBJ TXTPAGEFRAMES (FGETTOBJ FTEXTOBJ TXTPAGEFRAMES))
|
||||
(FSETTOBJ TTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ FTEXTOBJ DEFAULTPARALOOKS))
|
||||
(FSETTOBJ TTEXTOBJ FMTSPEC (FGETTOBJ FTEXTOBJ FMTSPEC))
|
||||
(FSETTOBJ TTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FTEXTOBJ DEFAULTCHARLOOKS)))
|
||||
TSTREAM)])
|
||||
|
||||
(\TEDIT.GET.UNFORMATTED.FILE
|
||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "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")
|
||||
@@ -645,7 +633,7 @@
|
||||
DEFAULTCHARLOOKS DEFAULTPARALOOKS PIECES)
|
||||
(PUTTEXTPROP TEXTOBJ 'CLEARGET T)
|
||||
(SETQ DEFAULTCHARLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ FMTSPEC))
|
||||
(CL:WHEN (AND (EQ FORMAT :STRING)
|
||||
(\IOMODEP STREAM 'OUTPUT T))
|
||||
(SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
|
||||
@@ -687,8 +675,7 @@
|
||||
(\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.GET.FORMATTED.FILE
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 7-Feb-2025 08:19 by rmk")
|
||||
(* ; "Edited 28-Oct-2024 17:48 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "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")
|
||||
@@ -722,14 +709,13 @@
|
||||
(\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 (\TEDIT.LASTPIECE TEXTOBJ))
|
||||
(CL:WHEN (SETQ PC (PREVPIECE (\TEDIT.LASTPIECE TEXTOBJ)))
|
||||
(FSETPC PC PPARALAST T))
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL)
|
||||
TEXTOBJ)])
|
||||
|
||||
(\TEDIT.FORMATTEDSTREAMP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -743,7 +729,7 @@
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(for PC (FORMATLEVEL _ 0)
|
||||
(DEFAULTCLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces (\TEDIT.FIRSTPIECE
|
||||
TEXTOBJ)
|
||||
do [COND
|
||||
@@ -904,8 +890,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PIECES3
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:44 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "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")
|
||||
@@ -929,8 +914,7 @@
|
||||
DEFAULTCHARLOOKS
|
||||
))
|
||||
(SETQ OLDPARALOOKS (FGETTOBJ TEXTOBJ
|
||||
DEFAULTPARALOOKS
|
||||
))
|
||||
FMTSPEC))
|
||||
(SETQ FIRSTPC (CREATE PIECE))
|
||||
(* ; "Throw away at the end")
|
||||
(SETQ PREVPC FIRSTPC)
|
||||
@@ -1415,8 +1399,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.SINGLE.CHARLOOKS
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 2-Jan-2025 11:08 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 22:59 by rmk")
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "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")
|
||||
@@ -1436,7 +1419,7 @@
|
||||
(PROG* ((LOOKS (create CHARLOOKS))
|
||||
(FILEPOS (GETFILEPTR FILE))
|
||||
(LOOKSLEN (\WIN FILE))
|
||||
FONT NAME SIZE SUPER PROPS STYLESTR BOLD ITALIC)
|
||||
FONT NAME FACE SIZE SUPER PROPS STYLESTR)
|
||||
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||
(SETQ SUPER (\SMALLPIN FILE)) (* ;
|
||||
@@ -1445,12 +1428,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]
|
||||
@@ -1459,24 +1442,31 @@
|
||||
[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))
|
||||
[if (LISTP NAME)
|
||||
then (* ;
|
||||
(SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD)
|
||||
'B
|
||||
'M)
|
||||
(CL:IF (FGETCLOOKS LOOKS CLITAL)
|
||||
'I
|
||||
'R)
|
||||
'R))
|
||||
(SETQ FONT (if (LISTP NAME)
|
||||
then (* ;
|
||||
"This was a font class. Restore it.")
|
||||
(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]
|
||||
(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))
|
||||
(FSETCLOOKS LOOKS CLFONT FONT)
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
|
||||
(RETURN LOOKS])
|
||||
|
||||
@@ -1546,9 +1536,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS
|
||||
[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")
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "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")
|
||||
@@ -1563,31 +1551,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 ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
(FILEPOS (GETFILEPTR FILE))
|
||||
(LOOKSLEN (\WIN FILE))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(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")
|
||||
(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")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
|
||||
(FSETPARA FMT 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))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -1601,42 +1589,41 @@
|
||||
(6 'DOTTEDCENTERED)
|
||||
(7 'DOTTEDDECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(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))
|
||||
(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))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTBASETOBASE (\ARBIN FILE)))
|
||||
(FSETPARA FMT FMTBASETOBASE (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTREVISED (\ARBIN FILE)))
|
||||
(FSETPARA FMT FMTREVISED (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTCOLUMN (\ARBIN FILE)))
|
||||
(FSETPARA FMT FMTCOLUMN (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))))
|
||||
(FSETPARA FMT 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)))
|
||||
PARALOOKS])
|
||||
FMT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1942,8 +1929,7 @@
|
||||
(CHARCODE (EOL LF])])])
|
||||
|
||||
(\TEDIT.PUT.UTF8.SPLITPIECES
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 19-Jan-2025 15:02 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:14 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "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")
|
||||
@@ -1960,11 +1946,13 @@
|
||||
(* ;; "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 (XTOUCODE CH)))
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
|
||||
*XCCSTOUNICODE*)))
|
||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
||||
(* ;
|
||||
"The first character defines the piece")
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
|
||||
*XCCSTOUNICODE*)))
|
||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
@@ -1980,9 +1968,11 @@
|
||||
(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 (XTOUCODE (BIN PFILE]
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
|
||||
*XCCSTOUNICODE*)))
|
||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
||||
elseif [EQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
|
||||
*XCCSTOUNICODE*)))
|
||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
@@ -1997,9 +1987,10 @@
|
||||
8)
|
||||
(BIN PFILE)))
|
||||
(if (EQ I 1)
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*))
|
||||
)
|
||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
||||
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*)))
|
||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
@@ -2009,7 +2000,6 @@
|
||||
|
||||
(\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")
|
||||
@@ -2042,9 +2032,8 @@
|
||||
(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))
|
||||
@@ -2185,8 +2174,7 @@
|
||||
(PUTHASH LOOKS I LOOKSHASH])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.CHARLOOKS
|
||||
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 2-Jan-2025 10:43 by rmk")
|
||||
(* ; "Edited 13-Aug-2024 08:47 by rmk")
|
||||
[LAMBDA (FORMATSTREAM LOOKS) (* ; "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")
|
||||
@@ -2234,10 +2222,10 @@
|
||||
(CL:IF (fetch (CHARLOOKS CLINVERTED) of LOOKS)
|
||||
1024
|
||||
0)
|
||||
(CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
|
||||
(CL:IF (fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
512
|
||||
0)
|
||||
(CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
|
||||
(CL:IF (fetch (CHARLOOKS CLITAL) of LOOKS)
|
||||
256
|
||||
0)
|
||||
(CL:IF (fetch (CHARLOOKS CLULINE) of LOOKS)
|
||||
@@ -2361,8 +2349,7 @@
|
||||
(PUTHASH PL I PARAHASH])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS
|
||||
[LAMBDA (FONTFILE LOOKS) (* ; "Edited 19-Feb-2025 12:11 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (FONTFILE LOOKS) (* ; "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")
|
||||
@@ -2377,23 +2364,23 @@
|
||||
DEFTAB TABS LEN)
|
||||
(\SMALLPOUT FONTFILE 0) (* ;
|
||||
"Reserve space to store the look length")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ;
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEFTMAR)) (* ;
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\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))
|
||||
(\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))
|
||||
|
||||
(* ;; "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 (FGETPLOOKS LOOKS QUAD)
|
||||
(\BOUT FONTFILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
@@ -2420,23 +2407,23 @@
|
||||
6)
|
||||
(DOTTEDDECIMAL 7)
|
||||
(\TEDIT.THELP])
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\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))
|
||||
(\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))
|
||||
|
||||
(* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)")
|
||||
|
||||
@@ -2470,9 +2457,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDITFROMLISPSOURCE
|
||||
[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")
|
||||
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "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")
|
||||
@@ -2486,22 +2471,19 @@
|
||||
|
||||
(* ;; "USERTEMP is the reader environment returned by LISPSOURCEFILEP")
|
||||
|
||||
(DECLARE (USEDFREE TEDIT.SOURCE.LINELENGTH))
|
||||
(CL:UNLESS TSTREAM
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM)))
|
||||
|
||||
(* ;; "Estimate 110 characters per line in the default font?")
|
||||
(* ;; "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")
|
||||
|
||||
[PUTTEXTPROPS TSTREAM `(PARABREAKCHARS NIL OPENWIDTH ,(TIMES TEDIT.SOURCE.LINELENGTH
|
||||
(CHARWIDTH (CHARCODE SPACE)
|
||||
DEFAULTFONT))
|
||||
BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
|
||||
of USERTEMP]
|
||||
(TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
|
||||
(TEXTPROP TSTREAM '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
|
||||
@@ -2524,35 +2506,33 @@
|
||||
TSTREAM])
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.SOURCE.LINELENGTH 110)
|
||||
|
||||
(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
|
||||
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT))
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5122 34670 (TEDIT.GET 5132 . 11252) (TEDIT.FORMATTEDFILEP 11254 . 12570) (
|
||||
TEDIT.FILEDATE 12572 . 13743) (TEDIT.INCLUDE 13745 . 21774) (TEDIT.RAW.INCLUDE 21776 . 22584) (
|
||||
TEDIT.PUT 22586 . 30835) (TEDIT.PUT.STREAM 30837 . 34668)) (34671 54441 (\TEDIT.GET.FOREIGN.FILE 34681
|
||||
. 38106) (\TEDIT.GET.UNFORMATTED.FILE 38108 . 42100) (\TEDIT.GET.FORMATTED.FILE 42102 . 45020) (
|
||||
\TEDIT.FORMATTEDSTREAMP 45022 . 48040) (\ARBIN 48042 . 48762) (\ATMIN 48764 . 49301) (\DWIN 49303 .
|
||||
49682) (\STRINGIN 49684 . 50392) (\TEDIT.GET.TRAILER 50394 . 52910) (\TEDIT.CACHEFILE 52912 . 54439))
|
||||
(54607 68361 (\TEDIT.GET.PIECES3 54617 . 65123) (\TEDIT.GET.IDATE3 65125 . 66520) (
|
||||
\TEDIT.MAKE.STRINGPIECE 66522 . 68359)) (68362 80737 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 68372 . 74488)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 74490 . 80735)) (80759 86781 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80769 .
|
||||
86779)) (86804 95429 (\TEDIT.GET.CHARLOOKS.LIST 86814 . 87545) (\TEDIT.GET.SINGLE.CHARLOOKS 87547 .
|
||||
92241) (\TEDIT.GET.CHARLOOKS 92243 . 93573) (\TEDIT.GET.PARALOOKS.INDEX 93575 . 94119) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 94121 . 95427)) (95430 103087 (\TEDIT.GET.PARALOOKS.LIST 95440 . 96062) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 96064 . 103085)) (103088 106678 (\TEDIT.GET.OBJECT 103098 . 106676)) (
|
||||
106740 138821 (\TEDIT.PUT.PCTB 106750 . 116400) (\TEDIT.PUT.PCTB.PIECEDATA 116402 . 119600) (
|
||||
\TEDIT.PUT.TRAILER 119602 . 120369) (\TEDIT.PUT.PCTB.MERGEABLE 120371 . 123805) (
|
||||
\TEDIT.PUT.UTF8.SPLITPIECES 123807 . 128509) (\TEDIT.PUT.PCTB.NEXTNEW 128511 . 132982) (
|
||||
\TEDIT.INSERT.NEWPIECES 132984 . 136419) (\TEDIT.PUTRESET 136421 . 136663) (\ARBOUT 136665 . 137389) (
|
||||
\ATMOUT 137391 . 137996) (\DWOUT 137998 . 138277) (\STRINGOUT 138279 . 138819)) (138822 150897 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 138832 . 140504) (\TEDIT.PUT.SINGLE.CHARLOOKS 140506 . 146241) (
|
||||
\TEDIT.PUT.CHARLOOKS 146243 . 147468) (\TEDIT.PUT.CHARLOOKS1 147470 . 148521) (\TEDIT.PUT.OBJECT
|
||||
148523 . 150895)) (150898 158537 (\TEDIT.PUT.PARALOOKS.LIST 150908 . 151810) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 151812 . 157396) (\TEDIT.PUT.PARALOOKS 157398 . 158535)) (158632 161644 (
|
||||
TEDITFROMLISPSOURCE 158642 . 160893) (SHELLSCRIPTP 160895 . 161124) (TEDITFROMSHELLSCRIPT 161126 .
|
||||
161642)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Mar-2025 11:25:45" {WMEDLEY}<library>tedit>TEDIT-FIND.;153 43667
|
||||
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134 36434
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2025 00:35:11" {WMEDLEY}<library>tedit>TEDIT-FIND.;151)
|
||||
:PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FINDCOMS)
|
||||
@@ -14,15 +14,12 @@
|
||||
(RPAQQ TEDIT-FINDCOMS (
|
||||
(* ;; "User entries")
|
||||
|
||||
(FNS TEDIT.FIND TEDIT.FIND.SETSEL TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE
|
||||
TEDIT.NEXT)
|
||||
(FNS TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD)
|
||||
(FNS TEDIT.FIND TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE TEDIT.NEXT)
|
||||
|
||||
(* ;; "Implementation")
|
||||
|
||||
(FNS \TEDIT.FIND \TEDIT.FIND.BACKWARD \TEDIT.WCFIND \TEDIT.BASICFIND
|
||||
\TEDIT.WCFIND.BACKWARD \TEDIT.BASICFIND.BACKWARD
|
||||
\TEDIT.PARSE.SEARCHSTRING)))
|
||||
(FNS \TEDIT.WCFIND \TEDIT.BASICFIND \TEDIT.WCFIND.BACKWARD
|
||||
\TEDIT.BASICFIND.BACKWARD \TEDIT.PARSE.SEARCHSTRING)))
|
||||
|
||||
|
||||
|
||||
@@ -31,50 +28,80 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.FIND
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 14-Mar-2025 23:39 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 12:33 by rmk")
|
||||
[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")
|
||||
|
||||
(* ;; "This is the documented user interface that does the silly thing with the return value--caller must know whether WILCARD? was true or not.")
|
||||
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.")
|
||||
|
||||
(LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? AGAIN START END)))
|
||||
(CL:WHEN RESULT
|
||||
(CL:IF WILDCARDS?
|
||||
RESULT
|
||||
(CAR RESULT)))])
|
||||
(* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")
|
||||
|
||||
(TEDIT.FIND.SETSEL
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 11-Mar-2025 15:29 by rmk")
|
||||
(* ;; "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?")
|
||||
|
||||
(* ;; "Sets the selection to the result of a successful FIND.")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
|
||||
(LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? NIL START END)))
|
||||
(CL:WHEN RESULT
|
||||
(TEDIT.SETSEL TSTREAM (CAR RESULT)
|
||||
(CADR RESULT)
|
||||
'RIGHT)
|
||||
(TEDIT.NORMALIZECARET TSTREAM))])
|
||||
(* ;; "* 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))))])])
|
||||
|
||||
(TEDIT.FIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 11-Mar-2025 15:06 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 30-May-91 19:17 by jds")
|
||||
|
||||
(* ;; "This is a new function that preserves the silly interface of TEDIT.FIND--caller must know whether WILCARD? was true or not.")
|
||||
(* ;; "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.")
|
||||
|
||||
(LET ((RESULT (\TEDIT.FIND.BACKWARD TARGET WILDCARDS? AGAIN START END)))
|
||||
(CL:WHEN RESULT
|
||||
(CL:IF WILDCARDS?
|
||||
RESULT
|
||||
(CAR RESULT)))])
|
||||
(* ;; "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))))])])
|
||||
|
||||
(TEDIT.SUBSTITUTE
|
||||
[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")
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "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")
|
||||
@@ -91,15 +118,16 @@
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(NREPLACEMENTS 0)
|
||||
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# CONFIRMFLG SEL REPLACE-LEN ACTIONSTRING
|
||||
CHARLOOKS)
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
|
||||
ACTIONSTRING)
|
||||
|
||||
(* ;; "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 SEARCHSTRING
|
||||
[SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
'TEDIT.LAST.SUBSTITUTE.STRING])
|
||||
[CL:UNLESS (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
|
||||
@@ -109,17 +137,16 @@
|
||||
]
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
|
||||
(RETURN))
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Substitute")
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(if (type? SELPIECES REPLACEMENT)
|
||||
elseif (OR (STRINGP REPLACEMENT)
|
||||
(LITATOM REPLACEMENT))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
|
||||
else (RETURN NIL))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
|
||||
|
||||
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
|
||||
|
||||
(SETQ REPLACE-LEN (GETSPC REPLACEMENT SPLEN))
|
||||
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
|
||||
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
|
||||
"delet"
|
||||
"substitut"))
|
||||
@@ -136,7 +163,8 @@
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
|
||||
"ing...")
|
||||
T)
|
||||
(SETQ SEL (FGETTOBJ TEXTOBJ SEL))
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(* ; "Turn off any blue pending delete")
|
||||
|
||||
@@ -146,67 +174,58 @@
|
||||
[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 HIT (LASTSEL _ (\TEDIT.COPYSEL SEL))
|
||||
while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL STARTCHAR#
|
||||
ENDCHAR#))
|
||||
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ
|
||||
SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (* ;
|
||||
"Show each substitution site and ask for permission")
|
||||
(\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
|
||||
(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
|
||||
"OK to replace? ['q' quits]" "Yes")
|
||||
1))
|
||||
(Q (GO $$OUT))
|
||||
(Q (RETURN))
|
||||
(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 SEL)
|
||||
(\TEDIT.COPYSEL SEL LASTSEL)
|
||||
(* ; "This may be where we end up")
|
||||
TEXTOBJ PENDING.SEL)
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
|
||||
(* ; "Next start, compensate for end")
|
||||
(add ENDCHAR# (IDIFFERENCE REPLACE-LEN (CADR HIT))))
|
||||
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE])
|
||||
(PROGN
|
||||
(* ;;
|
||||
"Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR HIT]
|
||||
finally (\TEDIT.COPYSEL LASTSEL SEL))
|
||||
(\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
|
||||
else
|
||||
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
|
||||
|
||||
(bind FIRSTHIT HIT HITLAST HITDIFF CHARLOOKS (TOTALDIFF _ 0)
|
||||
EVENTS while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL
|
||||
STARTCHAR# ENDCHAR#))
|
||||
(bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
|
||||
(SAVESEL _ (\TEDIT.COPYSEL SEL))
|
||||
EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
|
||||
(SETQ FIRSTHIT (CAR HIT)))
|
||||
(CL:UNLESS NEWCHARLOOKS
|
||||
(SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
|
||||
TEXTOBJ))))
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR HIT)
|
||||
(CADR HIT)
|
||||
(SETQ FIRSTHIT (CAR RANGE)))
|
||||
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE]
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
|
||||
HITLEN
|
||||
'RIGHT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ NIL CHARLOOKS)
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ SEL)
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(* ;
|
||||
@@ -214,16 +233,16 @@
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ HITLAST STARTCHAR#)
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN (CADR HIT)))
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
|
||||
(add ENDCHAR# HITDIFF)
|
||||
(add TOTALDIFF HITDIFF)
|
||||
finally (CL:UNLESS (EQ NREPLACEMENTS 0)
|
||||
|
||||
(* ;; "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. ")
|
||||
(* ;;
|
||||
"At least one replacement, update the lines that have changed.")
|
||||
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM)
|
||||
TOTALDIFF)
|
||||
(IDIFFERENCE (GETSEL SEL CHLIM)
|
||||
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?")
|
||||
@@ -232,7 +251,6 @@
|
||||
(\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:")
|
||||
@@ -251,11 +269,7 @@
|
||||
(RETURN NREPLACEMENTS))))])
|
||||
|
||||
(TEDIT.NEXT
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -264,109 +278,57 @@
|
||||
(* ; "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")
|
||||
|
||||
(* ;; "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 TEXTOBJ
|
||||
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
|
||||
TEXTOBJ 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)))])])
|
||||
(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)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -375,95 +337,6 @@
|
||||
|
||||
(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")
|
||||
@@ -518,8 +391,7 @@
|
||||
then (RETURN NIL])])
|
||||
|
||||
(\TEDIT.BASICFIND
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Feb-2025 12:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:03 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "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")
|
||||
@@ -549,9 +421,7 @@
|
||||
(BIN TSTREAM))
|
||||
(RETURN NIL))
|
||||
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
|
||||
(RETURN T))) do (FSETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
LASTARROWX NIL)
|
||||
(RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
(RETURN T))) do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
|
||||
(\TEDIT.WCFIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:05 by rmk")
|
||||
@@ -687,10 +557,8 @@
|
||||
(DREVERSE $$VAL))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (967 20027 (TEDIT.FIND 977 . 1561) (TEDIT.FIND.SETSEL 1563 . 2028) (TEDIT.FIND.BACKWARD
|
||||
2030 . 2609) (TEDIT.SUBSTITUTE 2611 . 15430) (TEDIT.NEXT 15432 . 20025)) (20028 23457 (
|
||||
TEDIT.FIND.OBJECT 20038 . 21538) (TEDIT.FIND.OBJECT.BACKWARD 21540 . 23455)) (23490 43644 (\TEDIT.FIND
|
||||
23500 . 26436) (\TEDIT.FIND.BACKWARD 26438 . 28956) (\TEDIT.WCFIND 28958 . 32477) (\TEDIT.BASICFIND
|
||||
32479 . 34838) (\TEDIT.WCFIND.BACKWARD 34840 . 38304) (\TEDIT.BASICFIND.BACKWARD 38306 . 40563) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 40565 . 43642)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170 33842
|
||||
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164 32996
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
\TEDIT.HCPYFMTSPEC)
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
|
||||
:PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -134,9 +133,7 @@
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
|
||||
|
||||
(\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "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")
|
||||
@@ -270,18 +267,16 @@
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE
|
||||
LOOKSTARTX TX (FGETLD LINE YBASE)
|
||||
CLOOKS PRSTREAM))
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED)
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED)
|
||||
of (FGETLD LINE LFMTSPEC))
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ
|
||||
(FGETLD LINE LPARALOOKS)
|
||||
(FGETLD LINE LFMTSPEC)
|
||||
PRSTREAM LINE))])])
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 26-Oct-2024 11:04 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 17:22 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:19 by rmk")
|
||||
@@ -289,20 +284,20 @@
|
||||
|
||||
(* ;; "Return setup LINE to skip a sequence of heading pieces STATE")
|
||||
|
||||
(SELECTQ (GETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
(SELECTQ (GETPARA FMTSPEC 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 PARALOOKS CHNO IMAGESTREAM
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
|
||||
FORMATTINGSTATE)
|
||||
T)
|
||||
(EVEN (* ; "Skip an odd page.")
|
||||
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
T))
|
||||
(ODD (* ; "Skip an even page")
|
||||
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
@@ -348,9 +343,7 @@
|
||||
(MOVETO CURX CURY PRSTREAM])
|
||||
|
||||
(\TEDIT.HCPYFMTSPEC
|
||||
[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")
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "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")
|
||||
@@ -358,34 +351,33 @@
|
||||
(* ; "Edited 29-Sep-2022 23:32 by rmk")
|
||||
(* ; "Edited 30-May-91 21:18 by jds")
|
||||
|
||||
(* ;; "Given a display-type PARALOOKS, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
(* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
|
||||
(LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
|
||||
(create PARALOOKS using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPLOOKS DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT FMTDEFAULTTAB
|
||||
))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPLOOKS DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
(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])
|
||||
|
||||
(\TEDIT.INTEGER.IMAGEBOX
|
||||
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
|
||||
@@ -563,11 +555,11 @@
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Mar-2025 18:50:43" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;225 53719
|
||||
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219 53094
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.UNDO1 TEDIT.REDO)
|
||||
: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)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2025 22:42:11" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;224)
|
||||
:PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
||||
@@ -225,12 +229,10 @@
|
||||
EVENT])
|
||||
|
||||
(\TEDIT.HISTORYADD.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 6-Feb-2025 15:31 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "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
|
||||
@@ -326,8 +328,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.UNDO
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 13-Mar-2025 15:47 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "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")
|
||||
@@ -373,7 +374,6 @@
|
||||
|
||||
(* ;; "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,8 +396,7 @@
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO1
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 16-Mar-2025 18:46 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "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")
|
||||
@@ -426,9 +425,9 @@
|
||||
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
(\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT))
|
||||
((LIST :Replace :Transform)
|
||||
((LIST :Replace :LowerCase :UpperCase)
|
||||
|
||||
(* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")
|
||||
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT))
|
||||
@@ -457,9 +456,7 @@
|
||||
T])
|
||||
|
||||
(TEDIT.REDO
|
||||
[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")
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -501,17 +498,15 @@
|
||||
(: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 TSTREAM TEXTOBJ SEL))
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.UCASE.SEL TSTREAM TEXTOBJ SEL))
|
||||
(:InitialCap (\TEDIT.KEY.INITIALCAP TSTREAM TEXTOBJ SEL))
|
||||
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:CharLooks (* ; "It was a character looks change")
|
||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
(\TEDIT.CHANGE.CHARLOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
(\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
|
||||
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
|
||||
@@ -641,15 +636,14 @@
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2025 22:35 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "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, uppercase, or initialcap.")
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.")
|
||||
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
NIL TEXTOBJ)
|
||||
@@ -846,14 +840,14 @@
|
||||
(\TEDIT.THELP 'Redo-composite])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4909 5930 (\TEDIT.HISTORYEVENT.DEFPRINT 4919 . 5928)) (7020 17605 (\TEDIT.HISTORYADD
|
||||
7030 . 11891) (\TEDIT.HISTORYADD.COMPOSITE 11893 . 12799) (\TEDIT.CUMULATE.EVENTS 12801 . 14395) (
|
||||
\TEDIT.COMPOSITE.EVENT 14397 . 15133) (\TEDIT.HISTORY.PROP 15135 . 16498) (\TEDIT.HISTORY.EVENT 16500
|
||||
. 17429) (\TEDIT.POPEVENT 17431 . 17603)) (17658 36127 (TEDIT.UNDO 17668 . 22227) (\TEDIT.UNDO1 22229
|
||||
. 26541) (TEDIT.REDO 26543 . 33281) (\TEDIT.UNDO.UNDO 33283 . 36125)) (36128 51335 (
|
||||
\TEDIT.UNDO.INSERT 36138 . 37051) (\TEDIT.UNDO.DELETE 37053 . 37847) (\TEDIT.UNDO.MOVE 37849 . 39438)
|
||||
(\TEDIT.UNDO.REPLACE 39440 . 40657) (\TEDIT.UNDO.CHARLOOKS 40659 . 45233) (\TEDIT.UNDO.PARALOOKS 45235
|
||||
. 49467) (\TEDIT.UNDO.PAGELOOKS 49469 . 49878) (\TEDIT.UNDO.COMPOSITE 49880 . 51107) (
|
||||
\TEDIT.UNDO.REPLACECODE 51109 . 51333)) (51336 53696 (\TEDIT.REDO.INSERT 51346 . 52079) (
|
||||
\TEDIT.REDO.REPLACE 52081 . 53412) (\TEDIT.REDO.COMPOSITE 53414 . 53694)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 12:09:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;33 72260
|
||||
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27 72985
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.GET.SINGLE.PARALOOKS2
|
||||
\TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
|
||||
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2025 22:08:39" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;31)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
|
||||
@@ -47,8 +46,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB2
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "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")
|
||||
@@ -78,7 +76,7 @@
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(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.")
|
||||
@@ -277,9 +275,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.CHARLOOKS2
|
||||
[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")
|
||||
[LAMBDA (FILE) (* ; "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")
|
||||
@@ -287,18 +283,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 BOLD ITALIC)
|
||||
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR)
|
||||
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||
(SETQ SUPER (\SMALLPIN FILE)) (* ; "Superscripting distance")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
|
||||
0))
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
|
||||
(replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE)
|
||||
0))
|
||||
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (\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]
|
||||
@@ -307,6 +303,7 @@
|
||||
[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) (* ;
|
||||
@@ -315,17 +312,26 @@
|
||||
NAME))
|
||||
((AND NAME (NOT (ZEROP SIZE)))
|
||||
(FONTCREATE NAME SIZE (COND
|
||||
((AND BOLD ITALIC)
|
||||
((AND (fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
(fetch (CHARLOOKS CLITAL) of LOOKS))
|
||||
'BOLDITALIC)
|
||||
(BOLD 'BOLD)
|
||||
(ITALIC 'ITALIC]
|
||||
(FSETCLOOKS LOOKS CLFONT FONT)
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
((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)
|
||||
(RETURN LOOKS])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "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")
|
||||
@@ -335,16 +341,16 @@
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(PROG (DEFTAB TABS OUTPUTFORMAT LEN)
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ;
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEFTMAR)) (* ;
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\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))
|
||||
(\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))
|
||||
(COND
|
||||
((AND (OR DEFTAB TABS)) (* ;
|
||||
"There are tab specs to save, or there is a default tab setting to save")
|
||||
@@ -352,7 +358,7 @@
|
||||
(T (* ;
|
||||
"There are no tab looks. Just let him go.")
|
||||
(\BOUT FILE 2)))
|
||||
(\BOUT FILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
|
||||
(\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
@@ -372,27 +378,26 @@
|
||||
(CENTERED 2)
|
||||
(DECIMAL 3)
|
||||
(\TEDIT.THELP]))
|
||||
(\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\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])
|
||||
(\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])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.CHARLOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 2-Jan-2025 10:51 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "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 (GETCLOOKS LOOKS CLFONT))
|
||||
(PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS))
|
||||
STR LEN)
|
||||
[COND
|
||||
((type? FONTCLASS FONT) (* ;
|
||||
@@ -403,54 +408,68 @@
|
||||
(\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* ; "The font family")
|
||||
(\WOUT FILE (OR (FONTPROP FONT 'SIZE)
|
||||
0)) (* ; "Size of the type, in points")
|
||||
(\SMALLPOUT FILE (OR (GETCLOOKS LOOKS CLOFFSET)
|
||||
(\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS)
|
||||
0)) (* ; "Super/subscripting distance")
|
||||
(COND
|
||||
([AND (GETCLOOKS LOOKS CLSTYLE)
|
||||
(NOT (ZEROP (GETCLOOKS LOOKS CLSTYLE]
|
||||
(\ARBOUT FILE (GETCLOOKS LOOKS CLSTYLE)))
|
||||
([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS)
|
||||
(NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS]
|
||||
(\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS)))
|
||||
(T (\WOUT FILE 0)))
|
||||
(COND
|
||||
((GETCLOOKS LOOKS CLUSERINFO)
|
||||
(\ARBOUT FILE (GETCLOOKS LOOKS CLUSERINFO LOOKS)))
|
||||
((fetch (CHARLOOKS CLUSERINFO) of LOOKS)
|
||||
(\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS)))
|
||||
(T (\WOUT FILE 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)])
|
||||
(\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])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS.LIST2
|
||||
[LAMBDA (FILE) (* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||
@@ -460,9 +479,7 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS2
|
||||
[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")
|
||||
[LAMBDA (FILE) (* ; "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")
|
||||
@@ -474,28 +491,28 @@
|
||||
(* ; "Edited 30-May-91 20:33 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(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")
|
||||
(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")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPARA FMT 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))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -505,23 +522,22 @@
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(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])
|
||||
(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])
|
||||
|
||||
(\TEDIT.PUT.CHARLOOKS.LIST2
|
||||
[LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk")
|
||||
@@ -575,8 +591,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB1
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "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")
|
||||
@@ -605,7 +620,7 @@
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(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.")
|
||||
@@ -721,8 +736,7 @@
|
||||
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST])
|
||||
|
||||
(\TEDIT.GET.CHARLOOKS1
|
||||
[LAMBDA (PC FILE) (* ; "Edited 2-Jan-2025 11:09 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "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")
|
||||
@@ -733,9 +747,7 @@
|
||||
|
||||
(* ;; "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 BOLD ITALIC (LOOKS (create
|
||||
CHARLOOKS))
|
||||
)
|
||||
(LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
|
||||
(FSETPC PC PLOOKS LOOKS)
|
||||
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||
@@ -750,13 +762,13 @@
|
||||
(FSETPC PC PNEW T))
|
||||
(CL:UNLESS (ZEROP (BIN FILE)) (* ;
|
||||
"There is style or user information to be read")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
|
||||
0))
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE)))
|
||||
(replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE)
|
||||
0))
|
||||
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)))
|
||||
(SETQ PROPS (\WIN FILE))
|
||||
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
(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 CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
@@ -764,27 +776,34 @@
|
||||
[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 (CONS 0 (CDDR NAME))
|
||||
'TEDIT-FONTCLASS))
|
||||
[(AND NAME (NOT (ZEROP SIZE)))
|
||||
(FONTCLASS (pop NAME)
|
||||
NAME))
|
||||
((AND NAME (NOT (ZEROP SIZE)))
|
||||
(FONTCREATE NAME SIZE (COND
|
||||
((AND BOLD ITALIC)
|
||||
((AND (fetch (CHARLOOKS CLBOLD) of LOOKS)
|
||||
(fetch (CHARLOOKS CLITAL) of LOOKS))
|
||||
'BOLDITALIC)
|
||||
(BOLD 'BOLD)
|
||||
(ITALIC 'ITALIC]
|
||||
(T (* ; "Should never happen")
|
||||
(FONTCREATE DEFAULTFONT]
|
||||
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
|
||||
(FSETCLOOKS LOOKS CLFONT FONT])
|
||||
((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])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS1
|
||||
[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")
|
||||
[LAMBDA (FILE) (* ; "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")
|
||||
@@ -796,54 +815,53 @@
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(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")
|
||||
(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")
|
||||
(* ; "Will be tab specs")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPARA FMT 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))
|
||||
(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))
|
||||
(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))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(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])
|
||||
(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])
|
||||
|
||||
(TEDIT.GET.OBJECT1
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
@@ -882,8 +900,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB0
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "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")
|
||||
@@ -904,8 +921,8 @@
|
||||
8))
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
for I from 1 to PCCOUNT
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) for I
|
||||
from 1 to PCCOUNT
|
||||
do (SETQ PCLEN (\DWIN TEXT))
|
||||
(SETQ PC
|
||||
(create PIECE
|
||||
@@ -945,17 +962,15 @@
|
||||
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.CHARLOOKS0
|
||||
[LAMBDA (PC FILE) (* ; "Edited 2-Jan-2025 11:09 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 00:05 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "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 BOLD ITALIC
|
||||
(LOOKS (create CHARLOOKS)))
|
||||
(SETPC PC PLOOKS LOOKS)
|
||||
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
|
||||
(replace (PIECE PLOOKS) of PC with 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]
|
||||
@@ -970,7 +985,7 @@
|
||||
|
||||
(COND
|
||||
((NOT (ZEROP (BIN FILE))) (* ; "This text is NEW. Mark it so.")
|
||||
(FSETPC PC PNEW T)))
|
||||
(replace (PIECE PNEW) of PC with T)))
|
||||
[COND
|
||||
((NOT (ZEROP (BIN FILE))) (* ;
|
||||
"There is style or user information to be read")
|
||||
@@ -978,15 +993,15 @@
|
||||
(SETQ USERSTR (\STRINGIN FILE))
|
||||
(COND
|
||||
((NOT (ZEROP (NCHARS STYLESTR))) (* ; "There IS style info")
|
||||
(FSETCLOOKS LOOKS CLSTYLE (READ STYLESTR)))
|
||||
(T (FSETCLOOKS LOOKS CLSTYLE 0)))
|
||||
(replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR)))
|
||||
(T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0)))
|
||||
(COND
|
||||
((NOT (ZEROP (NCHARS USERSTR))) (* ; "There IS user info")
|
||||
(FSETCLOOKS LOOKS CLUSERINFO (READ USERSTR]
|
||||
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR]
|
||||
(SETQ PROPS (\WIN FILE))
|
||||
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
|
||||
(with CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||
(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 CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||
@@ -994,18 +1009,22 @@
|
||||
[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 (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])
|
||||
(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])
|
||||
|
||||
(\TEDIT.GET.OBJECT0
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
@@ -1039,9 +1058,7 @@
|
||||
OBJ])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS0
|
||||
[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")
|
||||
[LAMBDA (PC FILE) (* ; "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")
|
||||
@@ -1053,29 +1070,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 ((PARALOOKS (create PARALOOKS))
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
TABFLG DEFTAB TABS)
|
||||
(SETPC PC PPARALOOKS PARALOOKS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(SETPC PC PPARALOOKS FMT)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(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")
|
||||
(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")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPARA FMT 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))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -1085,20 +1102,20 @@
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
PARALOOKS])
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
FMT])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Feb-2025 10:06:16" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;208 133418
|
||||
(FILECREATED "24-Dec-2024 21:32:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;200 121366
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
|
||||
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-2025 13:33:12" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;207)
|
||||
:PREVIOUS-DATE "11-Dec-2024 22:39:52" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;198)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||
@@ -85,11 +85,6 @@
|
||||
(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")
|
||||
|
||||
@@ -185,9 +180,10 @@
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \FIRST-COLUMN-START MACRO [(LINE PARALOOKS)
|
||||
(PUTPROPS \FIRST-COLUMN-START MACRO [(LINE FMTSPEC)
|
||||
(AND (FGETLD LINE 1STLN)
|
||||
(EQ 'FIRST (FGETPLOOKS PARALOOKS FMTCOLUMN])
|
||||
(EQ (FFETCH (FMTSPEC FMTCOLUMN) OF FMTSPEC)
|
||||
'FIRST])
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -311,8 +307,7 @@
|
||||
|
||||
(TEDIT.SINGLE.PAGEFORMAT
|
||||
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
|
||||
PAGEPROPS PAPERSIZE) (* ; "Edited 10-Jan-2025 11:41 by rmk")
|
||||
(* ; "Edited 24-Dec-2024 21:20 by rmk")
|
||||
PAGEPROPS PAPERSIZE) (* ; "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")
|
||||
@@ -354,27 +349,22 @@
|
||||
(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 (ITIMES 4 PTSPERINCH))))
|
||||
(SETQ FOLIOLEFT (IDIFFERENCE PX 288)))
|
||||
((CENTERED CENTER NIL) (* ;
|
||||
"Otherwise, center the page number around the point he specifies")
|
||||
(SETQ FOLIOLEFT (IDIFFERENCE PX (ITIMES 2 PTSPERINCH))))
|
||||
(SETQ FOLIOLEFT (IDIFFERENCE PX 144)))
|
||||
(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 _
|
||||
@@ -398,7 +388,7 @@
|
||||
(for HDG LEFT in HEADINGS when (CAR HDG)
|
||||
collect
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(if (AND (NUMBERP (CADR HDG))
|
||||
(NUMBERP (CADDR HDG)))
|
||||
@@ -630,8 +620,7 @@
|
||||
|
||||
(TEDIT.FORMAT.HARDCOPY
|
||||
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
|
||||
ENDPG QUIET) (* ; "Edited 23-Feb-2025 09:59 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:45 by rmk")
|
||||
ENDPG) (* ; "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")
|
||||
@@ -701,7 +690,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.")
|
||||
(CL:UNLESS QUIET (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
|
||||
[COND
|
||||
((AND FILE (OPENP FILE)
|
||||
(IMAGESTREAMTYPE FILE)) (* ;
|
||||
@@ -758,16 +747,15 @@
|
||||
(FUNCTION NILL))
|
||||
TEXTSTREAM))
|
||||
(SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT))
|
||||
(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))
|
||||
(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)))])
|
||||
)
|
||||
|
||||
@@ -937,9 +925,7 @@
|
||||
(SETPFS FORMATTINGSTATE CHNO CHNO])
|
||||
|
||||
(\TEDIT.FORMATHEADING
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "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")
|
||||
@@ -955,26 +941,26 @@
|
||||
(* ; "Edited 9-May-2023 20:30 by rmk")
|
||||
(* ; "Edited 9-Oct-90 13:24 by jds")
|
||||
|
||||
(* ;; "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")
|
||||
(* ;; "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.")
|
||||
|
||||
(LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
|
||||
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
|
||||
(LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
|
||||
(PAGE# (GETPFS FORMATTINGSTATE PAGE#))
|
||||
HEADINGTEXTOBJ HEADINGSTREAM HEADING)
|
||||
(DECLARE (SPECVARS PAGE#))
|
||||
(CL:WHEN [SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
|
||||
(LISTGET LOCALINFO 'HEADINGTYPE]
|
||||
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]
|
||||
|
||||
(* ;; "Bind the stream to make sure it isn't collected.")
|
||||
|
||||
[SETQ HEADINGSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
|
||||
`(PARALOOKS ,(PPARALOOKS (GETSPC HEADING SPFIRST]
|
||||
(SETQ HEADINGTEXTOBJ (GETTSTR HEADINGSTREAM TEXTOBJ))
|
||||
`(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST)
|
||||
of HEADING]
|
||||
(SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of HEADINGSTREAM))
|
||||
|
||||
(* ;; "Insert the heading pieces into HEADINGTEXTOBJ")
|
||||
|
||||
(\TEDIT.INSERTPIECES (GETSPC HEADING SPFIRST)
|
||||
(\TEDIT.INSERTPIECES (fetch (SELPIECES SPFIRST) of HEADING)
|
||||
(\TEDIT.ALIGNEDPIECE 1 HEADINGTEXTOBJ)
|
||||
HEADINGTEXTOBJ)
|
||||
|
||||
@@ -982,32 +968,30 @@
|
||||
|
||||
(* ;; "Why is BOTTOM said to be the %"top%" of the region to be filled?")
|
||||
|
||||
(bind LINE YBOT FORCENEXTPAGE (BOTTOM _ (fetch (REGION BOTTOM) of REGION))
|
||||
(TEXTLEN _ (TEXTLEN HEADINGTEXTOBJ))
|
||||
(CHNO _ 1) while (ILESSP CHNO TEXTLEN) until FORCENEXTPAGE
|
||||
(bind LINE YBOT (BOTTOM _ (fetch (REGION BOTTOM) of REGION))
|
||||
(LEN _ (TEXTLEN HEADINGTEXTOBJ))
|
||||
(CHNO _ 1) while (ILESSP CHNO LEN) until FORCENEXTPAGE
|
||||
collect
|
||||
|
||||
(* ;; "Format the next line from HEADINGTEXTOBJ pieces")
|
||||
|
||||
(SETQ LINE (\TEDIT.FORMATLINE HEADINGSTREAM CHNO NIL REGION PRSTREAM
|
||||
FORMATTINGSTATE))
|
||||
(SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ HEADINGTEXTOBJ STREAMHINT)
|
||||
CHNO NIL REGION PRSTREAM FORMATTINGSTATE))
|
||||
(SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
|
||||
(FGETLD LINE FORCED-END)))
|
||||
[SETQ YBOT (if YBOT
|
||||
then (* ;
|
||||
(GETLD LINE FORCED-END)))
|
||||
[SETQ YBOT (COND
|
||||
(YBOT (* ;
|
||||
"Take account of this line's height")
|
||||
(IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))
|
||||
else (* ;
|
||||
(IDIFFERENCE YBOT (FGETLD LINE LHEIGHT)))
|
||||
(T (* ;
|
||||
"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 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 22:39 by rmk")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "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")
|
||||
@@ -1052,7 +1036,7 @@
|
||||
(SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC)
|
||||
PC TEXTOBJ)) (* ;
|
||||
"RMK: Why both 'NEWPAGELAYOUT and :NEW-PAGE-LAYOUT ?")
|
||||
(CL:WHEN (EQ 'NEWPAGELAYOUT (GETPLOOKS NEWPARALOOKS FMTPARATYPE))
|
||||
(CL:WHEN (EQ 'NEWPAGELAYOUT (fetch (FMTSPEC FMTPARATYPE) of NEWPARALOOKS))
|
||||
|
||||
(* ;; "The first paragra ph on this page starts a new page layout.")
|
||||
|
||||
@@ -1061,11 +1045,10 @@
|
||||
(* ;; "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
|
||||
(GETPLOOKS
|
||||
NEWPARALOOKS
|
||||
FMTUSERINFO)
|
||||
'NEWPAGELAYOUT]
|
||||
[SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES
|
||||
(LISTGET (fetch (FMTSPEC FMTUSERINFO)
|
||||
of NEWPARALOOKS)
|
||||
'NEWPAGELAYOUT]
|
||||
(RETURN))
|
||||
|
||||
(* ;; "")
|
||||
@@ -1145,9 +1128,7 @@
|
||||
1])
|
||||
|
||||
(\TEDIT.FORMATTEXTBOX
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "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")
|
||||
@@ -1206,7 +1187,7 @@
|
||||
(SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES FOOTNOTELINES)
|
||||
(* ; "Remember any remaining footnotes")
|
||||
[SETQ LINES
|
||||
(bind LINE PARALOOKS LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE
|
||||
(bind LINE FMTSPEC LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE
|
||||
COLUMN-YBASE (TEXTLEN _ (TEXTLEN TEXTOBJ)) while (AND (ILEQ CHNO TEXTLEN)
|
||||
(NOT FORCENEXTPAGE))
|
||||
collect (BLOCK)
|
||||
@@ -1222,7 +1203,7 @@
|
||||
(FGETLD LINE FORCED-END))
|
||||
'USERBREAK))
|
||||
(SETQ LHEIGHT (FGETLD LINE LHEIGHT))
|
||||
(SETQ PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(COND
|
||||
((FGETLD LINE LMARK)
|
||||
|
||||
@@ -1230,7 +1211,7 @@
|
||||
|
||||
(SETQ CHNO (FGETLD LINE LCHARLIM))
|
||||
LINE)
|
||||
((LISTGET (FGETPLOOKS PARALOOKS FMTUSERINFO)
|
||||
((LISTGET (FGETPARA FMTSPEC FMTUSERINFO)
|
||||
'FOOTNOTE)
|
||||
|
||||
(* ;; "This paragraph is a footnote para.")
|
||||
@@ -1284,14 +1265,14 @@
|
||||
(* ;; "So that only the first line of a specially-placed paragraph is guaranteed to appear in the current box.")
|
||||
|
||||
[SETQ YBOT (COND
|
||||
((AND (FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALY)))
|
||||
((AND (FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY)))
|
||||
(FGETLD LINE 1STLN))
|
||||
(* ;
|
||||
"There is a special Y location for this paragraph. Move there")
|
||||
(SETQ SPECIALYPOS (FGETPLOOKS PARALOOKS FMTSPECIALY)))
|
||||
(SETQ SPECIALYPOS (FGETPARA FMTSPEC FMTSPECIALY)))
|
||||
((AND COLUMN-YBASE (FGETLD LINE 1STLN)
|
||||
(EQ (FGETPLOOKS PARALOOKS FMTCOLUMN)
|
||||
(EQ (FGETPARA FMTSPEC FMTCOLUMN)
|
||||
'NEXT))
|
||||
|
||||
(* ;;
|
||||
@@ -1302,22 +1283,20 @@
|
||||
|
||||
(* ;; "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 (FGETPLOOKS PARALOOKS FMTBASETOBASE)
|
||||
(CL:WHEN (FGETPARA FMTSPEC FMTBASETOBASE)
|
||||
[SETQ LHEIGHT
|
||||
(IPLUS (FGETLD LINE LDESCENT)
|
||||
(FGETPLOOKS PARALOOKS FMTBASETOBASE)
|
||||
(FGETPARA FMTSPEC FMTBASETOBASE)
|
||||
(COND
|
||||
((FGETLD LINE 1STLN)
|
||||
(IPLUS (FGETPLOOKS PARALOOKS
|
||||
LEADBEFORE)
|
||||
(FGETPLOOKS (GETLD PREVLINE
|
||||
|
||||
LPARALOOKS
|
||||
)
|
||||
(IPLUS (FGETPARA FMTSPEC LEADBEFORE
|
||||
)
|
||||
(FGETPARA (GETLD PREVLINE
|
||||
LFMTSPEC)
|
||||
LEADAFTER)))
|
||||
(T 0])
|
||||
(COND
|
||||
((\FIRST-COLUMN-START LINE PARALOOKS)
|
||||
((\FIRST-COLUMN-START LINE FMTSPEC)
|
||||
(IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT)
|
||||
LHEIGHT))
|
||||
(T (IDIFFERENCE YBOT LHEIGHT]
|
||||
@@ -1336,7 +1315,7 @@
|
||||
NIL)
|
||||
((AND (NOT FIRSTLINE)
|
||||
(FGETLD LINE 1STLN)
|
||||
(SETQ NEWPAGETYPE (OR (FGETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
(SETQ NEWPAGETYPE (OR (FGETPARA (FGETLD LINE LFMTSPEC)
|
||||
FMTNEWPAGEBEFORE)
|
||||
BREAKAFTERLASTPARA)))
|
||||
|
||||
@@ -1353,7 +1332,7 @@
|
||||
(SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE NEWPAGETYPE))
|
||||
NIL)
|
||||
(T (* ; "This line is good; use it.")
|
||||
(CL:WHEN (AND (FGETPLOOKS PARALOOKS FMTNEWPAGEAFTER))
|
||||
(CL:WHEN (AND (FGETPARA FMTSPEC 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))
|
||||
@@ -1361,7 +1340,7 @@
|
||||
(IMIN PRIOR-COLUMN-YBOT YBOT)
|
||||
YBOT))
|
||||
(SETYBOT LINE YBOT)
|
||||
(CL:WHEN (\FIRST-COLUMN-START LINE PARALOOKS)
|
||||
(CL:WHEN (\FIRST-COLUMN-START LINE FMTSPEC)
|
||||
|
||||
(* ;; "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.")
|
||||
|
||||
@@ -1379,9 +1358,7 @@
|
||||
TEXTOBJ FORMATTINGSTATE FINAL-CHNO)))])
|
||||
|
||||
(\TEDIT.FORMATFOLIO
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "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")
|
||||
@@ -1401,8 +1378,7 @@
|
||||
(LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
|
||||
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
|
||||
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
|
||||
FOLIOSTREAM PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
|
||||
(DECLARE (SPECVARS PAGE#))
|
||||
FOLIOSTREAM FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
|
||||
(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.")
|
||||
@@ -1428,25 +1404,29 @@
|
||||
`(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 (GETTSTR FOLIOSTREAM TEXTOBJ)))
|
||||
(bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ))
|
||||
(BOTTOM _ (fetch (REGION BOTTOM) of REGION))
|
||||
(CHNO _ 1) while (ILEQ CHNO TEXTLEN) until FORCENEXTPAGE
|
||||
collect (SETQ LINE (\TEDIT.FORMATLINE FOLIOSTREAM CHNO NIL REGION PRSTREAM
|
||||
FORMATTINGSTATE))
|
||||
collect (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ FOLIOTEXTOBJ STREAMHINT)
|
||||
CHNO NIL REGION PRSTREAM FORMATTINGSTATE))
|
||||
(SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
|
||||
(FGETLD LINE FORCED-END)))
|
||||
(GETLD LINE FORCED-END)))
|
||||
(* ; "Format the next possible line")
|
||||
[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]
|
||||
(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))
|
||||
(SETYBOT LINE YBOT) (* ; "This line is still good")
|
||||
(SETQ CHNO (FGETLD LINE LCHARLIM)) (* ; "Set the start of the next line")
|
||||
LINE))])
|
||||
|
||||
(\TEDIT.FORMAT.FOUNDBOX?
|
||||
@@ -1481,8 +1461,7 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.SKIP.SPECIALCOND
|
||||
[LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
[LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "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")
|
||||
@@ -1501,11 +1480,11 @@
|
||||
(FSETLD LINE LDESCENT 0)
|
||||
(FSETLD LINE LTRUEASCENT 0)
|
||||
(FSETLD LINE LTRUEDESCENT 0)
|
||||
(FSETLD LINE LCHARLIM (IPLUS CHNO (for PC (HEADINGTYPE _ (GETPLOOKS PARALOOKS FMTPARASUBTYPE))
|
||||
(FSETLD LINE LCHARLIM (IPLUS CHNO (for PC (HEADINGTYPE _ (GETPARA PARALOOKS FMTPARASUBTYPE))
|
||||
inpieces (fetch (TEXTSTREAM PIECE) of TSTREAM)
|
||||
while (AND (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS PC)
|
||||
while (AND (EQ 'PAGEHEADING (GETPARA (PPARALOOKS PC)
|
||||
FMTPARATYPE))
|
||||
(EQ HEADINGTYPE (GETPLOOKS (PPARALOOKS PC)
|
||||
(EQ HEADINGTYPE (GETPARA (PPARALOOKS PC)
|
||||
FMTPARASUBTYPE)))
|
||||
sum (PLEN PC])
|
||||
)
|
||||
@@ -1517,33 +1496,27 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.HARDCOPY.PAGEHEADINGS
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "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 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. ")
|
||||
(* ;; "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. ")
|
||||
|
||||
(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 (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)))
|
||||
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]
|
||||
do
|
||||
(* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the selpieces")
|
||||
(* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the piecerange")
|
||||
|
||||
(add CHNO (PLEN P)) finally (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
|
||||
HEADINGSUBTYPE
|
||||
@@ -1554,30 +1527,6 @@
|
||||
"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])
|
||||
)
|
||||
|
||||
@@ -1589,9 +1538,7 @@
|
||||
|
||||
(\TEDIT.HARDCOPY-COLUMN-END
|
||||
[LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE
|
||||
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")
|
||||
FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "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")
|
||||
@@ -1654,24 +1601,23 @@
|
||||
LCHARLIM))]
|
||||
([AND (NEQ FORCENEXTPAGE 'USERBREAK)
|
||||
(ILEQ CHNO (TEXTLEN TEXTOBJ))
|
||||
(OR (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
(OR (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
FMTHEADINGKEEP)
|
||||
(AND (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
(AND (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
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 (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
(for LASTLINE in (REVERSE LINES) while [OR (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
FMTHEADINGKEEP)
|
||||
(AND (GETPLOOKS (GETLD LASTLINE
|
||||
LPARALOOKS)
|
||||
(AND (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
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 (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
((AND LASTLINE (AND (NOT (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
FMTHEADINGKEEP))
|
||||
(GETLD LASTLINE LSTLN)))
|
||||
|
||||
@@ -1904,141 +1850,6 @@
|
||||
|
||||
|
||||
|
||||
(* ; "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
|
||||
@@ -2084,18 +1895,15 @@
|
||||
(RETURN (DREMOVE NIL $$VAL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248 68998
|
||||
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243 67795
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
:CHANGES-TO (FNS \TEDIT.DELETEPIECES)
|
||||
|
||||
:PREVIOUS-DATE " 7-Feb-2025 08:31:28" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;246)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -25,7 +25,7 @@
|
||||
(RECORDS BTREENODE BTSLOT)
|
||||
(MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT
|
||||
\FINDSLOT)
|
||||
(MACROS \SUFFIXPIECEP)
|
||||
(MACROS \LASTPIECEP)
|
||||
(I.S.OPRS inslots inpieces backpieces))
|
||||
(MACROS \INSURE.VACANT.BTREESLOT)
|
||||
(ADDVARS (INSPECTDONTSORTFIELDS BTREENODE)))
|
||||
@@ -138,9 +138,9 @@
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE))
|
||||
PC)))
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ))
|
||||
PC)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -215,9 +215,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MAKEPCTB
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ) (* ; "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")
|
||||
@@ -238,8 +236,8 @@
|
||||
PLEN _ 0
|
||||
PTREENODE _ NODE
|
||||
PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(FSETTOBJ TEXTOBJ SUFFIXPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(FSETTOBJ TEXTOBJ LASTPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ TEXTLEN 0)
|
||||
(FSETTOBJ TEXTOBJ PCTB (CONS NODE])
|
||||
@@ -274,8 +272,7 @@
|
||||
DELTA])
|
||||
|
||||
(\TEDIT.FIRSTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "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")
|
||||
@@ -288,7 +285,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 SUFFIXPIECE))
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
NODE])
|
||||
|
||||
(\TEDIT.DELETETREE
|
||||
@@ -386,16 +383,16 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.LASTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:20 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "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 last real piece of the text, NIL for an empty document.")
|
||||
(* ;; "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.")
|
||||
|
||||
(PREVPIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE])
|
||||
(bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD)
|
||||
do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD])
|
||||
|
||||
(\TEDIT.PCTOCH
|
||||
[LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk")
|
||||
@@ -424,8 +421,7 @@
|
||||
of TOPNODE])
|
||||
|
||||
(\TEDIT.CHTOPC
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 7-Feb-2025 08:29 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "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")
|
||||
@@ -439,7 +435,7 @@
|
||||
|
||||
(* ;; "There are 2 acceleration cases:")
|
||||
|
||||
(* ;; " 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 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 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.")
|
||||
|
||||
@@ -451,7 +447,7 @@
|
||||
(if (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (CL:WHEN TELL-PC-START?
|
||||
(SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
elseif (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC))
|
||||
(IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)))
|
||||
(ILESSP (IDIFFERENCE CH# STARTCH)
|
||||
@@ -467,7 +463,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 SUFFIXPIECE 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 LASTPIECE 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)))
|
||||
@@ -632,17 +628,16 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.LINKNEWPIECE
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Feb-2025 08:26 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "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 SUFFIXPIECE 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 LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
|
||||
(CL:UNLESS NEXT
|
||||
(SETQ NEXT (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(SETQ NEXT (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)))
|
||||
(LET ((NEXTPREV (PREVPIECE NEXT)))
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\SUFFIXPIECEP NEXT TEXTOBJ)
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ)
|
||||
NEXT))
|
||||
(* ; "NIL for last piece")
|
||||
(freplace (PIECE PREVPIECE) of NEW with NEXTPREV) (* ;
|
||||
@@ -656,8 +651,7 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
@@ -667,7 +661,7 @@
|
||||
(CL:WHEN PREV
|
||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
||||
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
|
||||
|
||||
(\TEDIT.SPLITPIECE
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
@@ -738,8 +732,7 @@
|
||||
PC])
|
||||
|
||||
(\TEDIT.INSERTPIECE
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:28 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "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")
|
||||
@@ -748,15 +741,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 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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;; "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 SUFFIXPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(* ; "Inserting at the very end")
|
||||
(LET ((PCTB (FGETTOBJ TEXTOBJ PCTB))
|
||||
LASTTREECONS)
|
||||
@@ -792,8 +785,7 @@
|
||||
NEWPC])
|
||||
|
||||
(\TEDIT.INSERTPIECES
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "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")
|
||||
@@ -811,7 +803,7 @@
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(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. ")
|
||||
@@ -827,7 +819,7 @@
|
||||
|
||||
(* ;; "PC is the final piece of the chain")
|
||||
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(FSETPC PC NEXTPIECE NEXTPC))
|
||||
(FSETPC NEXTPC PREVPIECE PC)
|
||||
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES))
|
||||
@@ -835,8 +827,7 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "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")
|
||||
@@ -849,7 +840,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 SUFFIXPIECE'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 LASTPIECE'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.")
|
||||
|
||||
@@ -860,7 +851,7 @@
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
(SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
|
||||
do (UNINTERRUPTABLY
|
||||
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
|
||||
@@ -884,8 +875,7 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
|
||||
|
||||
(\TEDIT.ALIGNEDPIECE
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 7-Feb-2025 08:05 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "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")
|
||||
@@ -900,7 +890,7 @@
|
||||
then
|
||||
(* ;; "Doesn't return NIL in this case, returns the last piece.")
|
||||
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
elseif (ILEQ CHNO 1)
|
||||
then (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
else (LET (PC START-OF-PIECE)
|
||||
@@ -966,14 +956,13 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.CHECK-BTREE
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 7-Feb-2025 08:07 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "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 (SUFFIXPIECE _ (FGETTOBJ TEXTOBJ SUFFIXPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS SUFFIXPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS LASTPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
do (SELECTC (PTYPE PC)
|
||||
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
|
||||
@@ -1000,8 +989,7 @@
|
||||
'VALID])
|
||||
|
||||
(\TEDIT.CHECK-BTREE1
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 7-Feb-2025 08:31 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "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")
|
||||
@@ -1011,30 +999,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 SUFFIXPIECE))
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE))
|
||||
(ADD DEPTH 1)
|
||||
(if (type? PIECE NODE)
|
||||
then [if (EQ NODE SUFFIXPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE SUFFIXPIECE)
|
||||
(NEXTPIECE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of SUFFIXPIECE is not NULL" SUFFIXPIECE))
|
||||
then [if (EQ NODE LASTPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE LASTPIECE)
|
||||
(NEXTPIECE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
|
||||
else (CL:UNLESS (IGEQ (PLEN NODE)
|
||||
0)
|
||||
(\TEDIT.BTFAIL "Negative PLEN" NODE))
|
||||
(CL:UNLESS (OR (NEXTPIECE NODE)
|
||||
(EQ NODE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of SUFFIXPIECE" NODE))
|
||||
(EQ NODE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" 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 SUFFIXPIECE)))
|
||||
(EQ NODE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PREVPIECE is not consistent" NODE)))
|
||||
(CL:WHEN (OR (NEXTPIECE NODE)
|
||||
SUFFIXPIECE)
|
||||
LASTPIECE)
|
||||
(CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
|
||||
SUFFIXPIECE)))
|
||||
LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "NEXTPIECE is not consistent" NODE)))]
|
||||
(add NPIECES 1)
|
||||
(add [CDR (OR (SASSOC DEPTH DEPTHHIST)
|
||||
@@ -1110,13 +1098,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Mar-2025 11:42:48" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;867 189057
|
||||
(FILECREATED "24-Dec-2024 22:16:22" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;845 185725
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
|
||||
|
||||
:PREVIOUS-DATE "25-Feb-2025 10:40:05" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;866)
|
||||
:PREVIOUS-DATE "19-Dec-2024 11:51:04" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;840)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||
@@ -53,9 +53,9 @@
|
||||
(GLOBALVARS TEDIT.LINELEADING.BELOW)
|
||||
(FNS \TLVALIDATE)
|
||||
(* ; "Consistency checking")
|
||||
(INITVARS *TEDIT-CACHED-PARALOOKS*)
|
||||
(INITVARS *TEDIT-CACHED-FMTSPEC*)
|
||||
(* ; "Heuristic for \FORMATLINE")
|
||||
(GLOBALVARS *TEDIT-CACHED-PARALOOKS*)
|
||||
(GLOBALVARS *TEDIT-CACHED-FMTSPEC*)
|
||||
(FNS \TEDIT.DISPLAYLINE \TEDIT.DISPLAYLINE.TABS \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE
|
||||
\TEDIT.BLTCHAR \TEDIT.DIACRITIC.SHIFT)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -136,8 +136,8 @@
|
||||
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.")
|
||||
LPARALOOKS (* ;
|
||||
"The paragraph looks for this line's paragraph (eventually)")
|
||||
LFMTSPEC (* ;
|
||||
"The format spec 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")
|
||||
@@ -687,11 +687,6 @@
|
||||
|
||||
(\TEDIT.FORMATLINE
|
||||
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 6-Mar-2025 11:42 by rmk")
|
||||
(* ; "Edited 25-Feb-2025 10:39 by rmk")
|
||||
(* ; "Edited 19-Feb-2025 13:36 by rmk")
|
||||
(* ; "Edited 10-Feb-2025 09:59 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:36 by rmk")
|
||||
(* ; "Edited 24-Dec-2024 22:15 by rmk")
|
||||
(* ; "Edited 23-Dec-2024 19:47 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:46 by rmk")
|
||||
@@ -714,7 +709,7 @@
|
||||
(DECLARE (SPECVARS TSTREAM))
|
||||
|
||||
(* ;;
|
||||
"Note that lines lie within paragraphs, and all pieces within a paragraph have the same PARALOOKS.")
|
||||
"Note that lines lie within paragraphs, and all pieces within a paragraph have the same FMTSPEC.")
|
||||
|
||||
(* ;; "The SPECVARS are accessed and reset under the subfunction\FORMATLINE.UPDATELOOKS, IMAGESTREAM and FORMATTINGSTATE are passed only for hardcopy. ")
|
||||
|
||||
@@ -760,8 +755,8 @@
|
||||
(SPACELEFT 0)
|
||||
(TX 0)
|
||||
(BOXSTREAM IMAGESTREAM)
|
||||
THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS RIGHTMARGIN HASKERN PC CHARSLOT PREVSP
|
||||
1STLN CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH
|
||||
THISLINE LINETYPE WIDTH WMARGIN SCALE FMTSPEC RIGHTMARGIN HASKERN PC CHARSLOT PREVSP 1STLN
|
||||
CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH
|
||||
START-OF-PIECE UNBREAKABLE OLDPIECE OLDPCCHARSLEFT OLDCARETLOOKS)
|
||||
(DECLARE (SPECVARS TEXTOBJ LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT
|
||||
START-OF-PIECE HASKERN UNBREAKABLE))
|
||||
@@ -822,16 +817,16 @@
|
||||
|
||||
(SETQ LINETYPE (if (NOT (DISPLAYSTREAMP IMAGESTREAM))
|
||||
then 'TRUEHARDCOPY
|
||||
elseif (FGETPLOOKS (PPARALOOKS PC)
|
||||
elseif (FGETPARA (PPARALOOKS PC)
|
||||
FMTHARDCOPY)
|
||||
then 'HARDCOPYDISPLAY
|
||||
else 'TRUEDISPLAY))
|
||||
(SETQ IMAGESTREAM (\TEDIT.FORMATLINE.SETUP.PARA TEXTOBJ PC LINE IMAGESTREAM LINETYPE))
|
||||
|
||||
(* ;; "The unchanging paragraph look has now been established and scaled appropriately. It is returned in the LPARALOOKS, the IMAGESTREAM is unmodified.")
|
||||
(* ;; "The unchanging paragraph look has now been established and scaled appropriately. It is returned in the LFMTSPEC, the IMAGESTREAM is unmodified.")
|
||||
|
||||
(SETQ PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(SETQ SCALE (FGETPLOOKS PARALOOKS FMTHARDCOPYSCALE))
|
||||
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(SETQ SCALE (FGETPARA FMTSPEC FMTHARDCOPYSCALE))
|
||||
[if (REGIONP REGION)
|
||||
then (SETQ WMARGIN (ffetch (REGION LEFT) of REGION))
|
||||
(* ;
|
||||
@@ -841,14 +836,14 @@
|
||||
"A little more display margin on both sides")
|
||||
(SETQ WIDTH (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT)
|
||||
(UNFOLD WMARGIN 2]
|
||||
(SETQ RIGHTMARGIN (if (ZEROP (FGETPLOOKS PARALOOKS RIGHTMAR))
|
||||
(SETQ RIGHTMARGIN (if (ZEROP (FGETPARA FMTSPEC RIGHTMAR))
|
||||
then
|
||||
(* ;; "RIGHTMAR = 0 => follow the window/region's width")
|
||||
|
||||
(CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(ITIMES SCALE WIDTH)
|
||||
WIDTH)
|
||||
else (FGETPLOOKS PARALOOKS RIGHTMAR)))
|
||||
else (FGETPARA FMTSPEC RIGHTMAR)))
|
||||
|
||||
(* ;; "Account for first-line indentation from the true left margin (LEFTMAR)")
|
||||
|
||||
@@ -859,8 +854,8 @@
|
||||
(OR (NOT (\PREV.VISIBLE.PIECE PC))
|
||||
(PPARALAST (\PREV.VISIBLE.PIECE PC]
|
||||
(SETQ LX1 (CL:IF 1STLN
|
||||
(FGETPLOOKS PARALOOKS 1STLEFTMAR)
|
||||
(FGETPLOOKS PARALOOKS LEFTMAR)))
|
||||
(FGETPARA FMTSPEC 1STLEFTMAR)
|
||||
(FGETPARA FMTSPEC LEFTMAR)))
|
||||
(SETQ WIDTH (IDIFFERENCE RIGHTMARGIN LX1))
|
||||
|
||||
(* ;; "")
|
||||
@@ -886,7 +881,7 @@
|
||||
(bind CH DX BOX INSPACES FIRSTWHITESLOT PREVCH KERN (FIRSTWHITEX _ TX)
|
||||
(INWORD _ T)
|
||||
(LASTCHARSLOT _ (LASTCHARSLOT THISLINE))
|
||||
(JUSTIFIED _ (EQ 'JUSTIFIED (FGETPLOOKS PARALOOKS QUAD)))
|
||||
(JUSTIFIED _ (EQ 'JUSTIFIED (FGETPARA FMTSPEC QUAD)))
|
||||
(TEXTLEN _ (TEXTLEN TEXTOBJ)) for old CHNO by 1 while (ILEQ CHNO TEXTLEN)
|
||||
while (SETQ CH (BIN TSTREAM))
|
||||
do
|
||||
@@ -939,8 +934,7 @@
|
||||
(SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN)
|
||||
CH BOXSTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(SCALEDOWN SCALE WIDTH)
|
||||
WIDTH)
|
||||
TSTREAM))
|
||||
WIDTH)))
|
||||
(IMAGEOBJPROP CH 'BOUNDBOX BOX)
|
||||
(SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE (fetch (IMAGEBOX YSIZE)
|
||||
of BOX)
|
||||
@@ -992,8 +986,8 @@
|
||||
(* ;
|
||||
"Start with 0 width, then set up the next tab")
|
||||
(FILLCHARSLOT CHARSLOT CH 0)
|
||||
(SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE CHARSLOT
|
||||
LX1 TX TABPENDING))
|
||||
(SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE CHARSLOT LX1
|
||||
TX TABPENDING))
|
||||
(* ;
|
||||
"Proper width is already in CHARSLOT")
|
||||
(SETQ DX (CL:IF (FIXP TABPENDING)
|
||||
@@ -1012,9 +1006,7 @@
|
||||
(SETQ INSPACES NIL)
|
||||
(CL:UNLESS (DIACRITICP CH)
|
||||
|
||||
(* ;; "Assume that diacritics have zero width. DISPLAYLINE and HARDCOPY.DISPLAYLINE adjust their alignment, centering on the next character. However, if a diacritic is wider than the the next character, here the next character should be assigned the diacritic's width. ")
|
||||
|
||||
(* ;; "CHTOLINEX under FIXSEL also needs to deal with this.")
|
||||
(* ;; "Assume that diacritics have zero width. \DISPLAYLINE and \TEDIT.HARDCOPY.DISPLAYLINE adjust their alignment, centering on the next character. However, if a diacritic is wider than the the next character, here the next character should be assigned the diacritic's width. ")
|
||||
|
||||
(add TX DX))
|
||||
(CL:WHEN (IGREATERP TX WIDTH)
|
||||
@@ -1092,8 +1084,8 @@
|
||||
DX) (* ;
|
||||
"Adjust the tab stop's X value so that the LEFT edge of the decimal point goes there.")
|
||||
(SETQ TABPENDING
|
||||
(\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE CHARSLOT
|
||||
LX1 TX TABPENDING T))
|
||||
(\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE CHARSLOT LX1
|
||||
TX TABPENDING T))
|
||||
(* ;
|
||||
"Tab over to the LEFT side of the decimal point.")
|
||||
(add TX (CL:IF (FIXP TABPENDING)
|
||||
@@ -1169,8 +1161,8 @@
|
||||
(CL:WHEN TABPENDING
|
||||
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
|
||||
(* ; "Don't justify spaces before tabs")
|
||||
(add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE (fetch (PENDINGTAB PTCHARSLOT)
|
||||
of TABPENDING)
|
||||
(add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE (fetch (PENDINGTAB PTCHARSLOT)
|
||||
of TABPENDING)
|
||||
LX1
|
||||
(IDIFFERENCE TX OVERHANG)
|
||||
TABPENDING T)))
|
||||
@@ -1192,19 +1184,19 @@
|
||||
(* ;; "For display, the value of LMARK (GREY) just causes the little grey box to show up in the left margin, but is not interpreted in any other way. The hardcopy code uses this field for other purposes.")
|
||||
|
||||
(FSETLD LINE LMARK (CL:WHEN [AND 1STLN (NEQ LINETYPE 'TRUEHARDCOPY)
|
||||
(OR (EQ (FGETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
(OR (EQ (FGETPARA FMTSPEC FMTPARATYPE)
|
||||
'PAGEHEADING)
|
||||
(FGETPLOOKS PARALOOKS FMTNEWPAGEBEFORE)
|
||||
(FGETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
|
||||
[AND (FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALX]
|
||||
(AND (FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALY]
|
||||
(FGETPARA FMTSPEC FMTNEWPAGEBEFORE)
|
||||
(FGETPARA FMTSPEC FMTNEWPAGEAFTER)
|
||||
[AND (FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALX]
|
||||
(AND (FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY]
|
||||
'GREY))
|
||||
(FSETLD LINE FORCED-END FORCED-END)
|
||||
(FSETLD LINE LEFTMARGIN (CL:IF 1STLN
|
||||
(FGETPLOOKS PARALOOKS 1STLEFTMAR)
|
||||
(FGETPLOOKS PARALOOKS LEFTMAR)))
|
||||
(FGETPARA FMTSPEC 1STLEFTMAR)
|
||||
(FGETPARA FMTSPEC LEFTMAR)))
|
||||
(FSETLD LINE RIGHTMARGIN RIGHTMARGIN)
|
||||
(CL:UNLESS FONT
|
||||
|
||||
@@ -1224,7 +1216,7 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(FSETLD LINE LPARALOOKS PARALOOKS)
|
||||
(FSETLD LINE LFMTSPEC FMTSPEC)
|
||||
(CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY)
|
||||
|
||||
(* ;; "Used temporarily and cleared by \TEDIT.FORMATBOX; not an XPOINTER")
|
||||
@@ -1237,12 +1229,12 @@
|
||||
(* ;; "Finally translate to the left edge, perhsps a specialx if true hardcopy.")
|
||||
|
||||
(CL:WHEN [AND (EQ LINETYPE 'TRUEHARDCOPY)
|
||||
(FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALX]
|
||||
(FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALX]
|
||||
|
||||
(* ;; "Maybe SETQ instead of add ??")
|
||||
|
||||
(add WMARGIN (FGETPLOOKS PARALOOKS FMTSPECIALX)))
|
||||
(add WMARGIN (FGETPARA FMTSPEC FMTSPECIALX)))
|
||||
(add (FGETLD LINE LEFTMARGIN)
|
||||
WMARGIN)
|
||||
(add (FGETLD LINE RIGHTMARGIN)
|
||||
@@ -1261,10 +1253,7 @@
|
||||
(RETURN LINE])
|
||||
|
||||
(\TEDIT.FORMATLINE.SETUP.PARA
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:36 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:09 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 11:14 by rmk")
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 22-Nov-2024 11:14 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 15:08 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:01 by rmk")
|
||||
@@ -1275,59 +1264,57 @@
|
||||
(* ; "Edited 6-Mar-2023 00:25 by rmk")
|
||||
(* ; "Edited 2-Mar-2023 12:06 by rmk")
|
||||
|
||||
(* ;; "The paragraph looks of a line are the same for every piece of every line in a paragraph, only the character looks can change from piece to piece. We retrieve the para looks from the starting piece, or the stream's default. The possibly-modified PARALOOKS of PC is stored in LINE.")
|
||||
(* ;; "The paragraph looks of a line are the same for every piece of every line in a paragraph, only the character looks can change from piece to piece. We retrieve the para looks from the starting piece, or the stream's default. The possibly-modified FMTSPEC of PC is stored in LINE.")
|
||||
|
||||
(* ;; "The global variable *TEDIT-CACHED-PARALOOKS* is a heuristic optimization to speed up construction of the PARALOOKS for successive lines in the same paragraph (or maybe even in a sequence of same-format paragraphs.")
|
||||
(* ;; "The global variable *TEDIT-CACHED-FMTSPEC* is a heuristic optimization to speed up construction of the FMTSPEC for successive lines in the same paragraph (or maybe even in a sequence of same-format paragraphs.")
|
||||
|
||||
(* ;; "In hardcopy-display mode, the verticals (lineleading etc.) are in screen points, only the horizontals are upscaled according to the points-to-hardcopy scalefactor installed in the retrieved PARALOOKS.")
|
||||
(* ;; "In hardcopy-display mode, the verticals (lineleading etc.) are in screen points, only the horizontals are upscaled according to the points-to-hardcopy scalefactor installed in the retrieved FMTSPEC.")
|
||||
|
||||
(* ;; "See comments in TEDIT-LOOKSCOMS about the style-cache variables. Probably not completely or correctly coordinated with this code.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(LET ([PLOOKS (PARALOOKS! (PPARALOOKS (OR PC (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE]
|
||||
(LET ([PLOOKS (PARALOOKS! (PPARALOOKS (OR PC (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE]
|
||||
SCALE)
|
||||
(SETQ PLOOKS (\TEDIT.APPLY.PARASTYLES PLOOKS PC TEXTOBJ))
|
||||
(SELECTQ LINETYPE
|
||||
(TRUEHARDCOPY (SETQ PLOOKS (\TEDIT.HCPYFMTSPEC PLOOKS IMAGESTREAM)))
|
||||
(TRUEDISPLAY (CL:UNLESS (FGETPLOOKS PLOOKS FMTHARDCOPYSCALE)
|
||||
(FSETPLOOKS PLOOKS FMTHARDCOPYSCALE 1)))
|
||||
(TRUEDISPLAY (CL:UNLESS (FGETPARA PLOOKS FMTHARDCOPYSCALE)
|
||||
(FSETPARA PLOOKS FMTHARDCOPYSCALE 1)))
|
||||
(HARDCOPYDISPLAY
|
||||
(* ;; "Coerce the image stream and PARALOOKS for HARDCOPYDISPLAY.")
|
||||
(* ;; "Coerce the image stream and FMTSPEC for HARDCOPYDISPLAY.")
|
||||
|
||||
[SETQ IMAGESTREAM (OR (FGETTOBJ TEXTOBJ DISPLAYHCPYDS)
|
||||
(FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM
|
||||
'{NODIRCORE}
|
||||
'POSTSCRIPT]
|
||||
(SETQ SCALE (DSPSCALE NIL IMAGESTREAM))
|
||||
[SETQ PLOOKS (create PARALOOKS using PLOOKS FMTHARDCOPYSCALE _ SCALE RIGHTMAR _
|
||||
(SCALEUP SCALE (FGETPLOOKS PLOOKS RIGHTMAR))
|
||||
1STLEFTMAR _ (SCALEUP SCALE (FGETPLOOKS PLOOKS
|
||||
1STLEFTMAR)
|
||||
)
|
||||
LEFTMAR _ (SCALEUP SCALE (FGETPLOOKS PLOOKS
|
||||
LEFTMAR))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS
|
||||
PLOOKS FMTTABS)
|
||||
SCALE)
|
||||
FMTDEFAULTTAB _ (SCALEUP SCALE
|
||||
(FGETPLOOKS PLOOKS
|
||||
FMTDEFAULTTAB])
|
||||
[SETQ PLOOKS (create FMTSPEC using PLOOKS FMTHARDCOPYSCALE _ SCALE RIGHTMAR _
|
||||
(SCALEUP SCALE (FGETPARA PLOOKS RIGHTMAR))
|
||||
1STLEFTMAR _ (SCALEUP SCALE (FGETPARA PLOOKS
|
||||
1STLEFTMAR))
|
||||
LEFTMAR _ (SCALEUP SCALE (FGETPARA PLOOKS
|
||||
LEFTMAR))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA PLOOKS
|
||||
FMTTABS)
|
||||
SCALE)
|
||||
FMTDEFAULTTAB _ (SCALEUP SCALE (FGETPARA PLOOKS
|
||||
|
||||
FMTDEFAULTTAB
|
||||
])
|
||||
(\TEDIT.THELP "BAD LINE TYPE" LINETYPE))
|
||||
(CL:UNLESS (OR (EQ PLOOKS *TEDIT-CACHED-PARALOOKS*)
|
||||
(NOT (FGETPLOOKS PLOOKS FMTCHARSTYLES)))
|
||||
(CL:UNLESS (OR (EQ PLOOKS *TEDIT-CACHED-FMTSPEC*)
|
||||
(NOT (FGETPARA PLOOKS FMTCHARSTYLES)))
|
||||
|
||||
(* ;; "The cache of styles for the current paragraph is invalid; flush it, and note the new paragraph to cache for.")
|
||||
|
||||
(SETQ *TEDIT-CURRENTPARA-CACHE* NIL)
|
||||
(SETQ *TEDIT-CACHED-PARALOOKS* PLOOKS))
|
||||
(SETLD LINE LPARALOOKS PLOOKS)
|
||||
(SETQ *TEDIT-CACHED-FMTSPEC* PLOOKS))
|
||||
(SETLD LINE LFMTSPEC PLOOKS)
|
||||
IMAGESTREAM])
|
||||
|
||||
(\TEDIT.FORMATLINE.HORIZONTAL
|
||||
[LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 19-Feb-2025 13:35 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:37 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:35 by rmk")
|
||||
[LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 15-Mar-2024 19:35 by rmk")
|
||||
(* ; "Edited 3-Dec-2023 16:49 by rmk")
|
||||
(* ; "Edited 29-Oct-2023 18:24 by rmk")
|
||||
(* ; "Edited 2-Jul-2023 15:15 by rmk")
|
||||
@@ -1350,13 +1337,13 @@
|
||||
|
||||
(* ;; "Also for HARDCOPYDISPLAY the horizontal positions (margins and character widths) are in hardcopy units. At the end we scale them back to screen points. ")
|
||||
|
||||
(LET* ((PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(SCALE (FGETPLOOKS PARALOOKS FMTHARDCOPYSCALE)))
|
||||
(LET* ((FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(SCALE (ffetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC)))
|
||||
|
||||
(* ;; "Distribute SPACELEFT according to QUAD. ")
|
||||
|
||||
(freplace (THISLINE TLSPACEFACTOR) of THISLINE with 1)
|
||||
(CL:WHEN (EQ 'JUSTIFIED (GETPLOOKS PARALOOKS QUAD))
|
||||
(CL:WHEN (EQ 'JUSTIFIED (fetch (FMTSPEC QUAD) of FMTSPEC))
|
||||
(\TEDIT.FORMATLINE.JUSTIFY LINE THISLINE PREVSP SPACELEFT LINETYPE))
|
||||
(\TEDIT.FORMATLINE.PURGE.SPACES PREVSP)
|
||||
|
||||
@@ -1383,7 +1370,7 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(SELECTQ (FGETPLOOKS PARALOOKS QUAD)
|
||||
(SELECTQ (ffetch (FMTSPEC QUAD) of FMTSPEC)
|
||||
(RIGHT (* ; "Move over to the right margin")
|
||||
(add (FGETLD LINE LX1 LINE)
|
||||
SPACELEFT)
|
||||
@@ -1397,9 +1384,7 @@
|
||||
NIL])
|
||||
|
||||
(\TEDIT.FORMATLINE.VERTICAL
|
||||
[LAMBDA (LINE TEXTOBJ) (* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:37 by rmk")
|
||||
(* ; "Edited 29-Oct-2024 11:07 by rmk")
|
||||
[LAMBDA (LINE TEXTOBJ) (* ; "Edited 29-Oct-2024 11:07 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 10:26 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 07:26 by rmk")
|
||||
(* ; "Edited 17-Dec-2023 00:43 by rmk")
|
||||
@@ -1410,17 +1395,17 @@
|
||||
|
||||
(* ;; "This calculates vertical sizes based on inherent line/paragraph parameters.It cannot deal with base-to-base positioning because that is context dependent, involving the position and descent of the previous line (\TEDIT.LINE.BOTTOM).")
|
||||
|
||||
(LET ((PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(LET ((FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(ASCENT (FGETLD LINE LTRUEASCENT))
|
||||
(DESCENT (FGETLD LINE LTRUEDESCENT)))
|
||||
(CL:WHEN (FGETLD LINE 1STLN LINE) (* ; "Set pre-paragraph leading")
|
||||
(add ASCENT (FGETPLOOKS PARALOOKS LEADBEFORE)))
|
||||
(add ASCENT (FGETPARA FMTSPEC LEADBEFORE)))
|
||||
(CL:WHEN (FGETLD LINE LSTLN) (* ; "Set post-paragraph leading")
|
||||
(add DESCENT (FGETPLOOKS PARALOOKS LEADAFTER)))
|
||||
(add DESCENT (FGETPARA FMTSPEC LEADAFTER)))
|
||||
|
||||
(* ;; "Documentation says that lineleading goes above the line, which automatically makes for reasonable selection marking. It went below in the original implementation, selections were very odd for large line leadings. Documentation also says that the lineleading is added to the paragraph leading, so we add it to the ascent even of the 1STLN. I.e. it is not just between-the-lines spacing.")
|
||||
|
||||
(add ASCENT (FGETPLOOKS PARALOOKS LINELEAD))
|
||||
(add ASCENT (FGETPARA FMTSPEC LINELEAD))
|
||||
(FSETLD LINE LASCENT ASCENT)
|
||||
(FSETLD LINE LDESCENT DESCENT)
|
||||
(FSETLD LINE LHEIGHT (IPLUS ASCENT DESCENT])
|
||||
@@ -1502,9 +1487,7 @@
|
||||
NATURALWIDTHS))))])
|
||||
|
||||
(\TEDIT.FORMATLINE.TABS
|
||||
[LAMBDA (TEXTOBJ PARALOOKS SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP)
|
||||
(* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 20:18 by rmk")
|
||||
[LAMBDA (TEXTOBJ FMTSPEC SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP)
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 18:29 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 20:49 by rmk")
|
||||
@@ -1537,8 +1520,8 @@
|
||||
(add TX LX1) (* ; "Margin relative")
|
||||
(PROG (NEXTTAB NEXTTABTYPE NEXTTABX DFLTTABX GRAIN (PRIORTABWIDTH 0)
|
||||
(THISTABWIDTH 0)
|
||||
(TABS (FGETPLOOKS PARALOOKS FMTTABS))
|
||||
(DEFTAB (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)))
|
||||
(TABS (FGETPARA FMTSPEC FMTTABS))
|
||||
(DEFTAB (FGETPARA FMTSPEC FMTDEFAULTTAB)))
|
||||
(CL:WHEN PRIORTAB
|
||||
|
||||
(* ;; "If there is a prior tab to resolve, do that first--it affects the perceived current X value, which affects later tabs")
|
||||
@@ -1656,10 +1639,7 @@
|
||||
finally (RETURN CS)))])
|
||||
|
||||
(\TEDIT.FORMATLINE.EMPTY
|
||||
[LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:37 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:09 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 22:29 by rmk")
|
||||
[LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 22-Nov-2024 22:29 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 16:00 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 14:51 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 14:51 by rmk")
|
||||
@@ -1686,17 +1666,17 @@
|
||||
(\TEDIT.FORMATLINE.SETUP.PARA TEXTOBJ NIL LINE (WINDOWPROP (\TEDIT.PRIMARYPANE TEXTOBJ)
|
||||
'DSP)
|
||||
'TRUEDISPLAY)
|
||||
(SETQ PLOOKS (FGETLD LINE LPARALOOKS))
|
||||
(SETQ PLOOKS (FGETLD LINE LFMTSPEC))
|
||||
|
||||
(* ;; "Get the current caret looks, so that LHEIGHT and \DISPLAYLINE work. Font preferences: the font of the previous piece, else the default (from the last piece). Previous code preferred the current caret looks, but that might have nothing to do with the end-of-document.")
|
||||
|
||||
[SETQ CLOOKS (PCHARLOOKS (OR (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE]
|
||||
[SETQ CLOOKS (PCHARLOOKS (OR (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE]
|
||||
(SETQ FONT (GETCLOOKS CLOOKS CLFONT))
|
||||
(SETQ TRUEASCENT (FONTPROP FONT 'ASCENT))
|
||||
(SETQ TRUEDESCENT (FONTPROP FONT 'DESCENT))
|
||||
(SETQ LM (IPLUS \TEDIT.LINEREGION.WIDTH (FGETTOBJ TEXTOBJ WLEFT)
|
||||
(FGETPLOOKS PLOOKS 1STLEFTMAR)))
|
||||
(FGETPARA PLOOKS 1STLEFTMAR)))
|
||||
(with LINEDESCRIPTOR LINE (SETQ LDUMMY T)
|
||||
(SETQ LCHAR1 CH#1)
|
||||
(SETQ LCHARLAST CH#1)
|
||||
@@ -1707,12 +1687,12 @@
|
||||
(SETQ LXLIM LM)
|
||||
(SETQ FORCED-END (CHARCODE EOL))
|
||||
(SETQ LHASPROT NIL)
|
||||
(SETQ LPARALOOKS PLOOKS)
|
||||
(SETQ LFMTSPEC PLOOKS)
|
||||
(SETQ LEFTMARGIN LM)
|
||||
(SETQ RIGHTMARGIN (CL:IF (ZEROP (FGETPLOOKS PLOOKS RIGHTMAR))
|
||||
(SETQ RIGHTMARGIN (CL:IF (ZEROP (FGETPARA PLOOKS RIGHTMAR))
|
||||
(IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT)
|
||||
\TEDIT.LINEREGION.WIDTH)
|
||||
(FGETPLOOKS PLOOKS RIGHTMAR)))
|
||||
(FGETPARA PLOOKS RIGHTMAR)))
|
||||
(SETQ LTRUEASCENT TRUEASCENT)
|
||||
(SETQ LTRUEDESCENT TRUEDESCENT)
|
||||
(SETQ LHEIGHT (IPLUS TRUEASCENT TRUEDESCENT)))
|
||||
@@ -1939,7 +1919,7 @@
|
||||
(* ; "Consistency checking")
|
||||
|
||||
|
||||
(RPAQ? *TEDIT-CACHED-PARALOOKS* NIL)
|
||||
(RPAQ? *TEDIT-CACHED-FMTSPEC* NIL)
|
||||
|
||||
|
||||
|
||||
@@ -1947,14 +1927,12 @@
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-CACHED-PARALOOKS*)
|
||||
(GLOBALVARS *TEDIT-CACHED-FMTSPEC*)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.DISPLAYLINE
|
||||
[LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 19-Feb-2025 13:35 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:37 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:51 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 13-Dec-2024 23:51 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 23:14 by rmk")
|
||||
(* ; "Edited 31-Oct-2024 09:56 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 10:43 by rmk")
|
||||
@@ -2125,10 +2103,10 @@
|
||||
'INPUT
|
||||
'REPLACE) (* ;
|
||||
"Paint the cached image on the screen (this lessens flicker during update)")
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED) (* ;
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED) of (FGETLD LINE LFMTSPEC))
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LPARALOOKS)
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LFMTSPEC)
|
||||
WINDOWDS LINE))
|
||||
(SELECTQ (FGETLD LINE LMARK)
|
||||
(GREY (* ;
|
||||
@@ -2143,8 +2121,6 @@
|
||||
|
||||
(\TEDIT.DISPLAYLINE.TABS
|
||||
[LAMBDA (CW DS TX TERMSA LINE CLOOKS DISPLAYDATA DDPILOTBBT CLIPRIGHT TEXTOBJ)
|
||||
(* ; "Edited 19-Feb-2025 13:36 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:37 by rmk")
|
||||
(* ; "Edited 10-Oct-2023 23:29 by rmk")
|
||||
(* ; "Edited 4-Oct-2023 21:16 by rmk")
|
||||
(* ; "Edited 3-Jul-2023 22:02 by rmk")
|
||||
@@ -2152,20 +2128,20 @@
|
||||
(* ; "Edited 1-Oct-2022 11:35 by rmk")
|
||||
(* ; "Edited 24-Sep-2022 21:19 by rmk")
|
||||
|
||||
(* ;; "Fills in tab-space CW with dotted leaders. LINE is only needed to get the PARALOOKS. TEXTOBJ only needed to get the hardcopy-display stream. ")
|
||||
(* ;; "Fills in tab-space CW with dotted leaders. LINE is only needed to get the FMTSPEC. TEXTOBJ only needed to get the hardcopy-display stream. ")
|
||||
|
||||
(bind TTX DOTWIDTH (PARALOOKS _ (GETLD LINE LPARALOOKS))
|
||||
(bind TTX DOTWIDTH (FMTSPEC _ (GETLD LINE LFMTSPEC))
|
||||
first
|
||||
(* ;; "The dots on successive lines may not align so well, in hardcopy display mode. But that's not a mode that looks good anyway. The TERMSA probably screws it anyway.")
|
||||
|
||||
[SETQ DOTWIDTH (CL:IF (GETPLOOKS PARALOOKS FMTHARDCOPY)
|
||||
[HCUNSCALE (FGETPLOOKS PARALOOKS FMTHARDCOPYSCALE)
|
||||
[SETQ DOTWIDTH (CL:IF (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC)
|
||||
[HCUNSCALE (fetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC)
|
||||
(CHARWIDTH (CHARCODE %.)
|
||||
(FONTCOPY (GETCLOOKS CLOOKS CLFONT)
|
||||
(FONTCOPY (fetch CLFONT of CLOOKS)
|
||||
'DEVICE
|
||||
(FGETTOBJ TEXTOBJ DISPLAYHCPYDS]
|
||||
(CHARWIDTH (CHARCODE %.)
|
||||
(GETCLOOKS CLOOKS CLFONT)))]
|
||||
(fetch CLFONT of CLOOKS)))]
|
||||
[SETQ TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER TX DOTWIDTH]
|
||||
while (ILEQ TTX (IPLUS TX CW)) do (if TERMSA
|
||||
then (* ; "Using special instrns from TERMSA")
|
||||
@@ -2346,10 +2322,7 @@
|
||||
1)])
|
||||
|
||||
(\TEDIT.UPDATE.LINES
|
||||
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 1-Feb-2025 10:34 by rmk")
|
||||
(* ; "Edited 21-Jan-2025 13:25 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 11:55 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 21:52 by rmk")
|
||||
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 7-Dec-2024 21:52 by rmk")
|
||||
(* ; "Edited 29-Nov-2024 22:56 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 03:35 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 17:57 by rmk")
|
||||
@@ -2380,6 +2353,10 @@
|
||||
else (CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO 1))
|
||||
(CL:UNLESS NCHARSCHANGED
|
||||
(SETQ NCHARSCHANGED (FGETTOBJ TEXTOBJ TEXTLEN)))]
|
||||
|
||||
(* ;;
|
||||
"If DONTDISPLAY, we ensure lines that are properly formatted and positioned but not displayed.")
|
||||
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(for PANE VALIDS LASTVALID NEXTVALID LASTGAPLINE UPPERBITMAPLINES BITMAPLINES inpanes TEXTOBJ
|
||||
when (SETQ VALIDS (\TEDIT.VALID.LINES PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON
|
||||
@@ -2390,10 +2367,10 @@
|
||||
|
||||
(SETQ LASTVALID (CAR VALIDS))
|
||||
(SETQ NEXTVALID (CDR VALIDS)) (* ; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.")
|
||||
[SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TEXTOBJ
|
||||
(CL:IF NEXTVALID
|
||||
(SUB1 (FGETLD NEXTVALID LCHAR1))
|
||||
(TEXTLEN TEXTOBJ))]
|
||||
(SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID (CL:IF NEXTVALID
|
||||
(SUB1 (FGETLD NEXTVALID LCHAR1))
|
||||
(TEXTLEN TEXTOBJ))
|
||||
PANE TEXTOBJ))
|
||||
|
||||
(* ;;
|
||||
"The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.")
|
||||
@@ -2401,19 +2378,12 @@
|
||||
(LINKLD LASTGAPLINE NEXTVALID)
|
||||
(if NEXTVALID
|
||||
then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID))
|
||||
else (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTGAPLINE))
|
||||
|
||||
(* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix")
|
||||
|
||||
(CL:WHEN (IGEQ (FGETLD LASTVALID YBOT)
|
||||
(PANETOP PANE))
|
||||
(LINKLD (PANEPREFIX PANE)
|
||||
(FGETLD LASTVALID NEXTLINE)))
|
||||
(\TEDIT.SHIFTLINES LASTVALID PANE TEXTOBJ BITMAPLINES UPPERBITMAPLINES)))])
|
||||
else (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTGAPLINE))
|
||||
(\TEDIT.SHIFTLINES LASTVALID (FGETLD LASTVALID NEXTLINE)
|
||||
PANE TEXTOBJ BITMAPLINES UPPERBITMAPLINES)))])
|
||||
|
||||
(\TEDIT.PANE.CREATELINES
|
||||
[LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 8-Feb-2025 23:52 by rmk")
|
||||
(* ; "Edited 29-Nov-2024 09:14 by rmk")
|
||||
[LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 29-Nov-2024 09:14 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 14:26 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 19:53 by rmk")
|
||||
(* ; "Edited 10-Nov-2024 18:45 by rmk")
|
||||
@@ -2453,7 +2423,7 @@
|
||||
LDESCENT _ 0
|
||||
LTRUEASCENT _ 0
|
||||
LTRUEDESCENT _ 0
|
||||
LPARALOOKS _ TEDIT.DEFAULT.FMTSPEC
|
||||
LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC
|
||||
1STLN _ NIL
|
||||
LSTLN _ NIL))
|
||||
(SETYBOT PREFIX (OR YBOT (PANEHEIGHT PANE)))
|
||||
@@ -2486,8 +2456,7 @@
|
||||
SUFFIX])
|
||||
|
||||
(\TEDIT.LINES.BELOW
|
||||
[LAMBDA (PREVLINE PANE TEXTOBJ) (* ; "Edited 21-Jan-2025 13:31 by rmk")
|
||||
(* ; "Edited 24-Nov-2024 14:57 by rmk")
|
||||
[LAMBDA (PREVLINE PANE TEXTOBJ) (* ; "Edited 24-Nov-2024 14:57 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 00:53 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 18-Nov-2024 21:12 by rmk")
|
||||
@@ -2507,27 +2476,26 @@
|
||||
(* ; "Edited 15-Mar-2024 19:22 by rmk")
|
||||
(* ; "Edited 23-Dec-2023 23:38 by rmk")
|
||||
(* ; "Edited 14-Dec-2023 12:46 by rmk")
|
||||
(CL:UNLESS PREVLINE
|
||||
(SETQ PREVLINE (PANEPREFIX PANE)))
|
||||
|
||||
(* ;; "Formats and displays lines after PREVLINE down to the one is at least partially visible at the bottom of PANE. Each line is positioned with respect to its predecessor and linked to it. The last visible line is set as the BOTTOMLINE of PANE, PANE's suffix is adjusted to cover the bitmap and all the unseen later characters. Returns the last displayed line.")
|
||||
|
||||
(for L NEXT YBOT (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines PREVLINE
|
||||
(for L NEXT YBOT (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines (OR PREVLINE (PANEPREFIX
|
||||
PANE))
|
||||
eachtime (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (FGETLD L LCHARLIM)))
|
||||
until (FGETLD NEXT LDUMMY) do (SETQ YBOT (\TEDIT.LINE.BOTTOM L NEXT))
|
||||
(SETYBOT NEXT YBOT)
|
||||
(CL:WHEN (ILESSP YBOT BOTTOM)
|
||||
(* ; "Ran off the bottom")
|
||||
(RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE)
|
||||
then (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)
|
||||
(LINKLD L NEXT)
|
||||
(* ; "Keep NEXT with partial display")
|
||||
then (LINKLD L NEXT)
|
||||
(* ; "Keep it with partial display")
|
||||
(\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)
|
||||
NEXT
|
||||
else (* ; "Overshot, throw NEXT away")
|
||||
else (* ; "Overshot")
|
||||
L)))
|
||||
(LINKLD L NEXT)
|
||||
(CL:WHEN (FGETLD NEXT LDUMMY)
|
||||
(* ; "Suffix line: end of pane")
|
||||
(* ; "Suffix line")
|
||||
(RETURN L))
|
||||
(\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)
|
||||
(* ;
|
||||
@@ -2539,8 +2507,7 @@
|
||||
(RETURN L])
|
||||
|
||||
(\TEDIT.MEASURED.LINES
|
||||
[LAMBDA (PREVLINE PANE TEXTOBJ LASTCHAR) (* ; "Edited 21-Jan-2025 13:30 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 16:55 by rmk")
|
||||
[LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 7-Dec-2024 16:55 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 11:26 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 18-Nov-2024 20:01 by rmk")
|
||||
@@ -2555,9 +2522,9 @@
|
||||
(SETYBOT NEXT YBOT)
|
||||
(CL:WHEN (ILESSP YBOT PBOTTOM) (* ; "NEXT runs off the bottom")
|
||||
(RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE)
|
||||
then (LINKLD L NEXT) (* ; "Keep NEXT with partial display")
|
||||
then (LINKLD L NEXT) (* ; "Keep it with partial display")
|
||||
NEXT
|
||||
else (* ; "Overshot, throw NEXT away")
|
||||
else (* ; "Overshot")
|
||||
L)))
|
||||
(LINKLD L NEXT) (* ; "Keeps the iteration going")
|
||||
finally
|
||||
@@ -2568,14 +2535,17 @@
|
||||
|
||||
(\TEDIT.VALID.LINES
|
||||
[LAMBDA (PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON TSTREAM)
|
||||
(* ; "Edited 21-Jan-2025 15:22 by rmk")
|
||||
(* ; "Edited 6-Jan-2025 15:19 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 16:54 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:58 by rmk")
|
||||
(* ; "Edited 4-Jul-2024 10:48 by rmk")
|
||||
(* ; "Edited 28-Jun-2024 15:27 by rmk")
|
||||
(* ; "Edited 15-Jun-2024 17:32 by rmk")
|
||||
(* ; "Edited 12-Jun-2024 23:59 by rmk")
|
||||
(* ; "Edited 23-May-2024 12:48 by rmk")
|
||||
(* ; "Edited 20-Apr-2024 22:11 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 06:46 by rmk")
|
||||
(* ; "Edited 22-Feb-2024 01:05 by rmk")
|
||||
(* ; "Edited 3-Nov-2023 12:07 by rmk")
|
||||
(* ; "Edited 14-Jun-2023 15:55 by rmk")
|
||||
@@ -2584,18 +2554,18 @@
|
||||
|
||||
(* ;; "Called when changes have been made to the document that affect the lines displayed in PANE. Return NIL if the change is not visible in PANE. Otherwise, this divides the lines in PANE into 3 segments:")
|
||||
|
||||
(* ;; " 1. a prefix of lines from the top visible line (next of PANEPREFIX) to the LASTVALID line, the line just before the first changed line.")
|
||||
(* ;; " 1. a prefix of lines from the top visible line (next of PREFIXLINE) to the LASTVALID line, the line just before the first changed line.")
|
||||
|
||||
(* ;; " 2. an intermediate sequence of lines that are (or may be) no longer valid because of the change.")
|
||||
|
||||
(* ;;
|
||||
" 3. a suffix of post-change lines, starting with NEXTVALID, that are known still to be valid.")
|
||||
" 3. a suffix of post-chamge lines, starting with NEXTVALID, that are known still to be valid.")
|
||||
|
||||
(* ;; "A line is %"valid%" if its line breaking is unaffected by the change and the bits in the screen bitmap that represented it before the change are still correct.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from the prefix line to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID and PREVLINE of NEXTVALID).")
|
||||
(* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from PREFIXLINE to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID).")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -2632,28 +2602,31 @@
|
||||
(CL:UNLESS SUFFIXLINE
|
||||
(\TEDIT.THELP "NO SUFFIXLINE")
|
||||
(RETURN NIL))
|
||||
(SETQ FIRSTVISIBLECHNO (FGETLD PREFIXLINE LCHARLIM))
|
||||
(SETQ LASTVISIBLECHNO (SUB1 (FGETLD SUFFIXLINE LCHAR1)))
|
||||
(CL:WHEN (IGREATERP FIRSTCHANGEDCHNO LASTVISIBLECHNO)
|
||||
(* ;
|
||||
"Change after previously visible lines")
|
||||
(CL:UNLESS (ILEQ LASTCHANGEDCHNO (TEXTLEN TEXTOBJ))
|
||||
(* ;
|
||||
"Change is after PANE, nothing to do")
|
||||
(RETURN NIL))
|
||||
(RETURN NIL)) (* ;
|
||||
"Unless adding past the end, nothing to do ")
|
||||
|
||||
(* ;; "Adding at the end of the document: insert a new line")
|
||||
|
||||
(\TEDIT.INSERTLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO)
|
||||
SUFFIXLINE))
|
||||
(SETQ FIRSTVISIBLECHNO (FGETLD PREFIXLINE LCHARLIM))
|
||||
(SETQ FIRSTCHANGEDLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO))
|
||||
(LINKLD (FGETLD SUFFIXLINE PREVLINE)
|
||||
FIRSTCHANGEDLINE)
|
||||
(LINKLD FIRSTCHANGEDLINE SUFFIXLINE)) (* ;
|
||||
"Change is after PANE, nothing to do")
|
||||
|
||||
(* ;;; "Change is visible in PANE, there's gotta be a FIRSTCHANGEDLINE")
|
||||
|
||||
(SETQ FIRSTCHANGEDLINE (find L inlines (FGETLD PREFIXLINE NEXTLINE)
|
||||
suchthat (FWITHINLINEP FIRSTCHANGEDCHNO L)))
|
||||
(CL:UNLESS FIRSTCHANGEDLINE (* ; "Changes are not visible")
|
||||
(RETURN NIL))
|
||||
|
||||
(* ;; "Change is visible in PANE, look for the last valid line (in PANE).")
|
||||
(* ;; "Updates may be required in lines before the FIRSTCHANGEDLINE, if words jump around.")
|
||||
|
||||
(SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTVISIBLECHNO PANE TSTREAM))
|
||||
(SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM))
|
||||
|
||||
(* ;; "Now for the after-change lines")
|
||||
|
||||
@@ -2665,26 +2638,23 @@
|
||||
"Last changed line is visible, its changes may cause character to shift to or from lower lines.")
|
||||
|
||||
(SETQ NEXTVALIDLINE (\TEDIT.NEXTVALIDLINE LASTCHANGEDLINE TSTREAM)))
|
||||
(CL:WHEN NEXTVALIDLINE
|
||||
(FSETLD NEXTVALIDLINE PREVLINE NIL)
|
||||
(CL:WHEN DELTA
|
||||
(CL:WHEN (AND NEXTVALIDLINE DELTA)
|
||||
|
||||
(* ;; "If the modification added or substracted to the number of characters, translate the character positions of the still-valid lines that are visible later than the change. ")
|
||||
(* ;; "If the modification added or substracted to the number of characters, translate the character positions of the still-valid lines that are visible later than the change. ")
|
||||
|
||||
(for L inlines NEXTVALIDLINE do (add (FGETLD L LCHAR1)
|
||||
DELTA)
|
||||
(add (FGETLD L LCHARLAST)
|
||||
DELTA))))
|
||||
(for L inlines NEXTVALIDLINE do (add (FGETLD L LCHAR1)
|
||||
DELTA)
|
||||
(add (FGETLD L LCHARLAST)
|
||||
DELTA)))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:WHEN LASTVALIDLINE
|
||||
(FSETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop out the now useless lines")
|
||||
(FSETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop off the now useless lines")
|
||||
(RETURN (CONS LASTVALIDLINE NEXTVALIDLINE)))])
|
||||
|
||||
(\TEDIT.LASTVALIDLINE
|
||||
[LAMBDA (FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 18-Feb-2025 12:45 by rmk")
|
||||
(* ; "Edited 29-Nov-2024 09:14 by rmk")
|
||||
[LAMBDA (FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 29-Nov-2024 09:14 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 18-Nov-2024 23:16 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 19:08 by rmk")
|
||||
@@ -2736,23 +2706,22 @@
|
||||
(SUB1 FIRSTPANECHAR)
|
||||
(FGETLD FIRSTCHANGEDLINE
|
||||
YTOP)))
|
||||
suchthat (IGEQ (FGETLD L YBOT)
|
||||
PTOP])
|
||||
suchthat (IGREATERP (FGETLD L YBOT)
|
||||
PTOP])
|
||||
|
||||
(\TEDIT.NEXTVALIDLINE
|
||||
[LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 21-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 29-Nov-2024 23:31 by rmk")
|
||||
[LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 29-Nov-2024 23:31 by rmk")
|
||||
(* ; "Edited 16-Nov-2024 11:00 by rmk")
|
||||
|
||||
(* ;; "We know we can stop when we see a forced end-- characters won't move around after that. In the usual case, the forced-end is a also the last line of a paragraph, but we can't just take the first line of the next paragraph because we can't deal here with whatever paragraph leading it might have (and the venue sysout also screwed up in that case).")
|
||||
|
||||
(* ;; "So we go for the second line of the next paragraph, if there is one")
|
||||
(* ;; "So we got for the second line of the next paragraph, if there is one")
|
||||
|
||||
(* ;; "The line after a forced end is valid. But maybe we can figure out how to stop sooner?")
|
||||
|
||||
(for L inlines LASTCHANGEDLINE when (FGETLD L FORCED-END)
|
||||
do
|
||||
(* ;; "A forced end is usually the last line of a paragraph, and its next line is probably valid. But we skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading to worry about.")
|
||||
(* ;; "If we reach the end of a paragraph, the next line may be the start of the next paragraph. We skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading.")
|
||||
|
||||
(CL:WHEN (FGETLD L LSTLN)
|
||||
(SETQ L (FGETLD L NEXTLINE)))
|
||||
@@ -2813,9 +2782,7 @@
|
||||
NEWLINE])
|
||||
|
||||
(\TEDIT.LINE.BOTTOM
|
||||
[LAMBDA (PREVLINE LINE) (* ; "Edited 19-Feb-2025 13:36 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:38 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 00:38 by rmk")
|
||||
[LAMBDA (PREVLINE LINE) (* ; "Edited 17-Nov-2024 00:38 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 16:57 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 15:45 by rmk")
|
||||
(* ; "Edited 16-Jun-2024 23:43 by rmk")
|
||||
@@ -2831,8 +2798,8 @@
|
||||
(LINEDESCRIPTOR! PREVLINE)
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(LET* ((PREVYBOT (FGETLD PREVLINE YBOT))
|
||||
(PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(BASETOBASE (GETPLOOKS PARALOOKS FMTBASETOBASE))
|
||||
(FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(BASETOBASE (GETPARA FMTSPEC FMTBASETOBASE))
|
||||
NEWYBOT)
|
||||
[SETQ NEWYBOT (if (NOT BASETOBASE)
|
||||
then
|
||||
@@ -2844,9 +2811,9 @@
|
||||
then
|
||||
(* ;; "This is the first line of a new paragraph, and the previous line must therefore have been a last. Both paragraph leadings apply in the gap, but the line leading is irrelevant.")
|
||||
|
||||
(IDIFFERENCE PREVYBOT (IPLUS (GETPLOOKS (FGETLD PREVLINE LPARALOOKS)
|
||||
(IDIFFERENCE PREVYBOT (IPLUS (GETPARA (FGETLD PREVLINE LFMTSPEC)
|
||||
LEADAFTER)
|
||||
(GETPLOOKS PARALOOKS LEADBEFORE)
|
||||
(GETPARA FMTSPEC LEADBEFORE)
|
||||
(FGETLD LINE LTRUEHEIGHT)))
|
||||
else
|
||||
(* ;; "Between lines inside a paragraph, make the baselines BASETOBASE apart. Oldcode subtracted paragraph leading")
|
||||
@@ -2887,21 +2854,21 @@
|
||||
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27983 30199 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 27993 . 30197)) (37604 120468 (
|
||||
\TEDIT.FORMATLINE 37614 . 73135) (\TEDIT.FORMATLINE.SETUP.PARA 73137 . 78303) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 78305 . 82878) (\TEDIT.FORMATLINE.VERTICAL 82880 . 85331) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 85333 . 91354) (\TEDIT.FORMATLINE.TABS 91356 . 99384) (\TEDIT.SCALE.TABS
|
||||
99386 . 100177) (\TEDIT.FORMATLINE.PURGE.SPACES 100179 . 101606) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
101608 . 102509) (\TEDIT.FORMATLINE.EMPTY 102511 . 107538) (\TEDIT.FORMATLINE.UPDATELOOKS 107540 .
|
||||
113662) (\TEDIT.FORMATLINE.LASTLEGAL 113664 . 117204) (\TEDIT.LINES.ABOVE 117206 . 120466)) (120585
|
||||
122500 (\TLVALIDATE 120595 . 122498)) (122698 144236 (\TEDIT.DISPLAYLINE 122708 . 136348) (
|
||||
\TEDIT.DISPLAYLINE.TABS 136350 . 139154) (\TEDIT.LINECACHE 139156 . 139884) (\TEDIT.CREATE.LINECACHE
|
||||
139886 . 140722) (\TEDIT.BLTCHAR 140724 . 143351) (\TEDIT.DIACRITIC.SHIFT 143353 . 144234)) (144851
|
||||
189034 (\TEDIT.BACKFORMAT 144861 . 147415) (\TEDIT.PREVIOUS.LINEBREAK 147417 . 150140) (
|
||||
\TEDIT.UPDATE.LINES 150142 . 155012) (\TEDIT.PANE.CREATELINES 155014 . 158117) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 158119 . 159494) (\TEDIT.LINES.BELOW 159496 . 163957) (\TEDIT.MEASURED.LINES
|
||||
163959 . 165859) (\TEDIT.VALID.LINES 165861 . 174122) (\TEDIT.LASTVALIDLINE 174124 . 179049) (
|
||||
\TEDIT.NEXTVALIDLINE 179051 . 180481) (\TEDIT.CLEARPANE.BELOW.LINE 180483 . 182589) (\TEDIT.INSERTLINE
|
||||
182591 . 183977) (\TEDIT.LINE.BOTTOM 183979 . 187209) (\TEDIT.SHOW.AT.BOTTOMP 187211 . 188321) (
|
||||
\TEDIT.SHOW.AT.TOPP 188323 . 189032)))))
|
||||
(FILEMAP (NIL (27979 30195 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 27989 . 30193)) (37600 118360 (
|
||||
\TEDIT.FORMATLINE 37610 . 72350) (\TEDIT.FORMATLINE.SETUP.PARA 72352 . 77175) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 77177 . 81573) (\TEDIT.FORMATLINE.VERTICAL 81575 . 83792) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 83794 . 89815) (\TEDIT.FORMATLINE.TABS 89817 . 97617) (\TEDIT.SCALE.TABS
|
||||
97619 . 98410) (\TEDIT.FORMATLINE.PURGE.SPACES 98412 . 99839) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
99841 . 100742) (\TEDIT.FORMATLINE.EMPTY 100744 . 105430) (\TEDIT.FORMATLINE.UPDATELOOKS 105432 .
|
||||
111554) (\TEDIT.FORMATLINE.LASTLEGAL 111556 . 115096) (\TEDIT.LINES.ABOVE 115098 . 118358)) (118477
|
||||
120392 (\TLVALIDATE 118487 . 120390)) (120586 141750 (\TEDIT.DISPLAYLINE 120596 . 134043) (
|
||||
\TEDIT.DISPLAYLINE.TABS 134045 . 136668) (\TEDIT.LINECACHE 136670 . 137398) (\TEDIT.CREATE.LINECACHE
|
||||
137400 . 138236) (\TEDIT.BLTCHAR 138238 . 140865) (\TEDIT.DIACRITIC.SHIFT 140867 . 141748)) (142365
|
||||
185702 (\TEDIT.BACKFORMAT 142375 . 144929) (\TEDIT.PREVIOUS.LINEBREAK 144931 . 147654) (
|
||||
\TEDIT.UPDATE.LINES 147656 . 152101) (\TEDIT.PANE.CREATELINES 152103 . 155095) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 155097 . 156472) (\TEDIT.LINES.BELOW 156474 . 160836) (\TEDIT.MEASURED.LINES
|
||||
160838 . 162610) (\TEDIT.VALID.LINES 162612 . 171255) (\TEDIT.LASTVALIDLINE 171257 . 176079) (
|
||||
\TEDIT.NEXTVALIDLINE 176081 . 177383) (\TEDIT.CLEARPANE.BELOW.LINE 177385 . 179491) (\TEDIT.INSERTLINE
|
||||
179493 . 180879) (\TEDIT.LINE.BOTTOM 180881 . 183877) (\TEDIT.SHOW.AT.BOTTOMP 183879 . 184989) (
|
||||
\TEDIT.SHOW.AT.TOPP 184991 . 185700)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Mar-2025 16:27:02" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;674 154655
|
||||
(FILECREATED "17-Dec-2024 14:29:31" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;638 151180
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.SELPIECES.COPY \TEDIT.SELPIECES \TEDIT.RESET.EXTEND.PENDING.DELETE)
|
||||
(I.S.OPRS inselpieces)
|
||||
:CHANGES-TO (FNS \TEDIT.XYTOSEL)
|
||||
|
||||
:PREVIOUS-DATE "16-Mar-2025 10:06:15" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;665)
|
||||
:PREVIOUS-DATE " 6-Dec-2024 12:50:42" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;637)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||
@@ -443,13 +442,13 @@
|
||||
(add START-OF-PIECE (PLEN PC])
|
||||
|
||||
(\TEDIT.WORD.BOUND
|
||||
[LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 13-Mar-2025 21:41 by rmk")
|
||||
(* ; "Edited 16-Jul-2024 19:52 by rmk")
|
||||
[LAMBDA (TEXTOBJ PREVCH CH) (* ; "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 25-Sep-2022 23:48 by rmk")
|
||||
(* ; "Edited 30-May-91 23:02 by jds")
|
||||
(if (AND (FIXP PREVCH)
|
||||
(FIXP CH))
|
||||
then (LET [(READSA (fetch READSA of (OR (GETTOBJ TEXTOBJ TXTWTBL)
|
||||
then (LET [(READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ)
|
||||
TEDIT.WORDBOUND.READTABLE]
|
||||
(NEQ (\SYNCODE READSA PREVCH)
|
||||
(\SYNCODE READSA CH)))
|
||||
@@ -570,13 +569,15 @@
|
||||
(\TEDIT.FIXSEL CURSEL TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.SCAN.LINE
|
||||
[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")
|
||||
[LAMBDA (LINE X Y NEWSEL SELOPERATION PANE BUTTON WORDSELFLG)
|
||||
(* ; "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")
|
||||
@@ -587,24 +588,26 @@
|
||||
(* ; "Edited 9-Apr-2023 18:21 by rmk")
|
||||
(* ; "Edited 31-May-91 12:26 by jds")
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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.")
|
||||
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(* ;; "The button pressed on an image object is decoded from the EXTENDFLG and WORDFLG.")
|
||||
|
||||
(SELECTION! NEWSEL)
|
||||
(FSETSEL NEWSEL SET NIL)
|
||||
(PROG (CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED)
|
||||
(PROG ((TSTREAM (PANESTREAM PANE))
|
||||
(TEXTOBJ (PANETOBJ PANE))
|
||||
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 TEXTOBJ (FGETLD LINE LCHAR1)
|
||||
(SETQ LINE (\TEDIT.FORMATLINE TSTREAM (GETLD LINE LCHAR1)
|
||||
LINE))) (* ;
|
||||
"Convert X's display units to LINE's scale")
|
||||
(SETQ XLIM (FGETLD LINE LX1)) (* ;
|
||||
(SETQ XLIM (GETLD LINE LX1)) (* ;
|
||||
"Pretend the %"last%" character ended at the margin")
|
||||
(SETQ X (IMAX X XLIM))
|
||||
(SETQ CHNO (FGETLD LINE LCHAR1))
|
||||
@@ -614,11 +617,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 30 past the end, put it inside the last character.")
|
||||
(CL:WHEN (IGREATERP (IDIFFERENCE X
|
||||
(FGETLD LINE LXLIM)) 30)
|
||||
(RETURN NIL)))
|
||||
(* ;
|
||||
"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))
|
||||
(SETQ X (SUB1 (FGETLD LINE LXLIM))))
|
||||
[SETQ CHARSLOT (for CS incharslots THISLINE
|
||||
do (if CHAR
|
||||
@@ -705,18 +708,11 @@
|
||||
(FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL]
|
||||
(FSETSEL NEWSEL CHLIM (IPLUS (FGETSEL NEWSEL CH#)
|
||||
(FGETSEL NEWSEL DCH)))
|
||||
(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]
|
||||
(FSETSEL NEWSEL POINT (if [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.")
|
||||
@@ -835,7 +831,6 @@
|
||||
|
||||
(\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")
|
||||
@@ -872,7 +867,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 NEWSEL SELOPERATION TEXTOBJ BUTTON
|
||||
(CL:WHEN (AND (\TEDIT.SCAN.LINE LINE X Y NEWSEL SELOPERATION PANE BUTTON
|
||||
(SELECTQ BUTTON
|
||||
(RIGHT (MEMB (FGETSEL CURSEL SELKIND)
|
||||
'(WORD PARA)))
|
||||
@@ -1133,8 +1128,7 @@
|
||||
SEL])
|
||||
|
||||
(\TEDIT.CHTOLINEX
|
||||
[LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 6-Mar-2025 11:57 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 14:41 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "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")
|
||||
@@ -1168,17 +1162,10 @@
|
||||
(IEQP CH# (FGETLD LINE LCHAR1)))
|
||||
then (FGETLD LINE LX1)
|
||||
else (for CHARSLOT (X _ (FGETLD LINE LX1))
|
||||
(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)
|
||||
(CHNO _ (FGETLD LINE LCHAR1)) incharslots THISLINE unless (type? CHARLOOKS CHARW
|
||||
)
|
||||
do
|
||||
(* ;;
|
||||
"Update the running X-position in the line, skiping look-slots and skipping diacritics")
|
||||
(* ;; "Update the running X-position in the line, skiping look-slots")
|
||||
|
||||
(CL:WHEN (IEQP CHNO CH#)
|
||||
(if AFTER
|
||||
@@ -1204,8 +1191,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 19-Mar-2025 13:24 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:44 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "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")
|
||||
@@ -1215,18 +1201,12 @@
|
||||
|
||||
(* ;; "Reset the 'Extend Pending Delete' status")
|
||||
|
||||
(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 (TEXTSEL TEXTOBJ)
|
||||
'NORMAL)
|
||||
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
|
||||
|
||||
(\TEDIT.SET.SEL.LOOKS
|
||||
[LAMBDA (SEL OPERATION) (* ; "Edited 28-Feb-2025 17:45 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
[LAMBDA (SEL OPERATION) (* ; "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")
|
||||
@@ -1267,10 +1247,9 @@
|
||||
"For people who really want to see what's selected.")
|
||||
(FSETSEL SEL HOW BLACKSHADE)
|
||||
(FSETSEL SEL HOWHEIGHT 16384)
|
||||
(FSETSEL SEL HASCARET T))
|
||||
(NIL)
|
||||
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
|
||||
SEL])
|
||||
(FSETSEL SEL HASCARET T)
|
||||
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
|
||||
SEL])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1458,105 +1437,55 @@
|
||||
(\TEDIT.THELP "ILLEGAL POINT" (GETSEL SEL POINT))))])
|
||||
|
||||
(\TEDIT.SEL.L1
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 9-Mar-2025 20:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 08:34 by rmk")
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "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 9-Mar-2025 20:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 08:34 by rmk")
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "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 6-Feb-2025 15:53 by rmk")
|
||||
(* ; "Edited 4-Feb-2025 23:05 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 22:31 by rmk")
|
||||
[LAMBDA (SELTOFIX FIRSTCHAR LEN) (* ; "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 or will be removed.")
|
||||
(* ;; "Adjust SELTOFIX to reflect character number translations after LEN characters starting at FIRSTCHAR have been removed.")
|
||||
|
||||
(CL:WHEN (type? SELECTION FIRSTCHAR)
|
||||
(SETQ LEN (FGETSEL FIRSTCHAR DCH))
|
||||
(SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#)))
|
||||
(LET ((LASTCHAR (IPLUS FIRSTCHAR LEN -1))
|
||||
(B (FGETSEL SELTOFIX CH#))
|
||||
(E (FGETSEL SELTOFIX CHLAST))
|
||||
(DCH (FGETSEL SELTOFIX DCH)))
|
||||
(CL:WHEN (IGEQ (FGETSEL SELTOFIX CHLIM)
|
||||
FIRSTCHAR)
|
||||
|
||||
(* ;; "No overlap")
|
||||
(* ;; "Nothing to do if the deletion happened after the selection.")
|
||||
|
||||
(* ;; " 1 FddL F gt E")
|
||||
[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")
|
||||
|
||||
(* ;; " B23E nothing")
|
||||
(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.")
|
||||
|
||||
(* ;; " 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])
|
||||
(\TEDIT.UPDATE.SEL SELTOFIX FIRSTCHAR (IMAX 0 (IDIFFERENCE LASTCHAR
|
||||
(FGETSEL SELTOFIX CHLAST])])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1778,8 +1707,7 @@
|
||||
`(PROGN (DSPCLIPPINGREGION OLDVALUE ,DS])
|
||||
|
||||
(\TEDIT.OPERATE.OBJECT
|
||||
[LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "Edited 31-Dec-2024 17:24 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 11:55 by rmk")
|
||||
[LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "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")
|
||||
@@ -1807,6 +1735,7 @@
|
||||
(* ;; "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)
|
||||
@@ -1841,8 +1770,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.SELPIECES
|
||||
[LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 19-Mar-2025 16:10 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 17:49 by rmk")
|
||||
[LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "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")
|
||||
@@ -1874,17 +1802,15 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ. ")
|
||||
|
||||
(LET (FIRSTCHAR LEFTPC RIGHTPC)
|
||||
(if (type? SELECTION SEL/FIRSTCHAR)
|
||||
then (if (FGETSEL SEL/FIRSTCHAR SET)
|
||||
then (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#))
|
||||
[SETQ LASTCHAR (SUB1 (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH))
|
||||
FIRSTCHAR
|
||||
(FGETSEL SEL/FIRSTCHAR CHLIM))]
|
||||
[SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH))
|
||||
FIRSTCHAR
|
||||
(SUB1 (FGETSEL SEL/FIRSTCHAR CHLIM)))]
|
||||
else (SETQ FIRSTCHAR 0)
|
||||
(SETQ LASTCHAR -1))
|
||||
elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR)
|
||||
@@ -1907,9 +1833,7 @@
|
||||
SPLASTCHAR _ LASTCHAR))])
|
||||
|
||||
(\TEDIT.SELPIECES.COPY
|
||||
[LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ CHARLOOKS)
|
||||
(* ; "Edited 19-Mar-2025 16:26 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:31 by rmk")
|
||||
[LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ) (* ; "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")
|
||||
@@ -1923,14 +1847,13 @@
|
||||
|
||||
(CL:WHEN SELPIECES
|
||||
(CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ))
|
||||
(for PC NPC PREVPC NEWFIRSTPIECE inselpieces (PROGN SELPIECES)
|
||||
(for PC NPC PREVPC NEWFIRSTPIECE inselpieces 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))
|
||||
@@ -1967,32 +1890,29 @@
|
||||
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
||||
|
||||
(\TEDIT.SELPIECES.CHARTRANSFORM
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "Edited 16-Mar-2025 10:03 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "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. Image objects would be lost if we had to go through strings.")
|
||||
(* ;; "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 smashes the pieces, use crosscopy \TEDIT.SELPIECES.COPY first to protect the document pieces.")
|
||||
|
||||
[for PC PCONTENTS (INDEX _ 0) inselpieces SELPIECES
|
||||
[for PC PCONTENTS 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 (add INDEX 1)
|
||||
TEXTOBJ))))
|
||||
do (RPLCHARCODE STR I (APPLY* CHARFN CH 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)
|
||||
(add INDEX 1]
|
||||
TEXTOBJ PC I]
|
||||
(if (fetch (STRINGP FATSTRINGP) of STR)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2003,15 +1923,15 @@
|
||||
(FSETPC PC PCONTENTS STR)
|
||||
(FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
|
||||
(PLEN PC])
|
||||
(OBJECT.PTYPE (add INDEX 1)
|
||||
(CL:WHEN OBJECTSTOO
|
||||
(FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX))))
|
||||
(OBJECT.PTYPE (CL:WHEN OBJECTSTOO
|
||||
(FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS TEXTOBJ))))
|
||||
(SUBSTREAM.PTYPE
|
||||
(\TEDIT.THELP "SUBSTREAM PIECES NOT IMPLEMENTED"))
|
||||
(\TEDIT.THELP "ILLEGAL PIECE TYPE" (PTYPE PC]
|
||||
SELPIECES])
|
||||
|
||||
(\TEDIT.SELPIECES.FROM.STRING
|
||||
[LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:57 by rmk")
|
||||
[LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "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")
|
||||
@@ -2026,7 +1946,7 @@
|
||||
(CL:UNLESS CHARLOOKS
|
||||
(SETQ CHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)))
|
||||
(CL:UNLESS PARALOOKS
|
||||
(SETQ PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(SETQ PARALOOKS (FGETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP))
|
||||
(SETQ CHECKFOREOL T))
|
||||
(LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1)
|
||||
@@ -2170,9 +2090,7 @@
|
||||
(FGETSEL SCRSEL CH#])
|
||||
|
||||
(TEDIT.SELPROP
|
||||
[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")
|
||||
[LAMBDA X (* ; "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")
|
||||
@@ -2193,6 +2111,8 @@
|
||||
'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))
|
||||
@@ -2203,14 +2123,13 @@
|
||||
(FGETSEL SEL SELKIND))
|
||||
(CHLAST (if (EQ 0 (FGETSEL SEL DCH))
|
||||
then (FGETSEL SEL CH#)
|
||||
else (FGETSEL SEL CHLAST)))
|
||||
else (SUB1 (FGETSEL SEL CHLIM))))
|
||||
(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))
|
||||
@@ -2227,12 +2146,9 @@
|
||||
(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))
|
||||
(CL:WHEN (FGETSEL SEL SELTEXTSTREAM)
|
||||
(\TEDIT.FIXSEL SEL (FGETSEL SEL SELTEXTSTREAM)))))])
|
||||
[\TEDIT.FIXSEL SEL (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (GETSEL SEL
|
||||
SELTEXTSTREAM]))])
|
||||
|
||||
(TEDIT.GETPOINT
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 31-Oct-2024 17:46 by rmk")
|
||||
@@ -2329,19 +2245,20 @@
|
||||
|
||||
(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")
|
||||
|
||||
@@ -2350,48 +2267,67 @@
|
||||
(* ;; "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))
|
||||
(CL:WHEN (AND LEN (ILESSP LEN 0))
|
||||
(ERROR "Selection length cannot be negative" LEN))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
(TEXTLEN (TEXTLEN TEXTOBJ))
|
||||
PC)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ; "First turn the old sel off.")
|
||||
[if (type? SELECTION CH#)
|
||||
then (* ;
|
||||
"He gave us a selection; just plug it in")
|
||||
(\TEDIT.COPYSEL CH# SEL) (* ;
|
||||
[COND
|
||||
((type? SELECTION CH#) (* ;
|
||||
"He gave use a selection; just plug it in")
|
||||
(\TEDIT.COPYSEL CH# SEL) (* ;
|
||||
"And make sure it can be turned on.")
|
||||
(SETSEL SEL ONFLG NIL)
|
||||
else (* ;
|
||||
(SETSEL SEL ONFLG NIL))
|
||||
(T (* ;
|
||||
"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")
|
||||
(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)
|
||||
(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")
|
||||
(CL:UNLESS LEAVECARETLOOKS (* ;
|
||||
"Set the insertion looks to follow.")
|
||||
"And set the insertion looks to follow.")
|
||||
(SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX NIL)
|
||||
(TEDIT.GETSEL TSTREAM])
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ;
|
||||
"Update the selection's screen location")
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ) (* ; "Highlight it on the screen")
|
||||
SEL])
|
||||
|
||||
(TEDIT.SHOWSEL
|
||||
[LAMBDA (TSTREAM ONFLG SEL) (* ; "Edited 7-Jul-2024 11:25 by rmk")
|
||||
@@ -2414,8 +2350,7 @@
|
||||
(\TEDIT.SHOWSEL SEL ONFLG TEXTOBJ))])
|
||||
|
||||
(TEDIT.SEL.AS.STRING
|
||||
[LAMBDA (TSTREAM SEL/CH# LEN CODEFOROBJECT) (* ; "Edited 15-Feb-2025 12:47 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 00:12 by rmk")
|
||||
[LAMBDA (TSTREAM SEL CODEFOROBJECT) (* ; "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")
|
||||
@@ -2428,34 +2363,30 @@
|
||||
"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/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 (* ;
|
||||
(CL:UNLESS SEL
|
||||
(SETQ SEL (GETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
SEL)))
|
||||
(LET (RESULT (LEN (GETSEL SEL DCH)))
|
||||
(COND
|
||||
((ZEROP LEN) (* ;
|
||||
"There is no selection, or it's zero-width. Return ''")
|
||||
(CONCAT "")
|
||||
else (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE)))
|
||||
(CONCAT ""))
|
||||
(T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE)))
|
||||
(* ; "The resulting string")
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)) (* ;
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (GETSEL SEL 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-Dec-2024 08:47 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:49 by rmk")
|
||||
[LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "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")
|
||||
@@ -2468,7 +2399,7 @@
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
[\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (\TEDIT.WORD.FIRST TSTREAM (TEDIT.GETPOINT TSTREAM SEL)
|
||||
(TEDIT.ATOMBOUND.READTABLE (OR RDTBL *READTABLE*]
|
||||
(CAR (NLSETQ (READ TSTREAM RDTBL FLG])
|
||||
(READ TSTREAM RDTBL FLG])
|
||||
|
||||
(TEDIT.SELECTALL
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Jun-2023 16:58 by rmk")
|
||||
@@ -2485,25 +2416,25 @@
|
||||
(ADDTOVAR LAMA TEDIT.SELPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Mar-2025 00:29:46" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;865 175471
|
||||
(FILECREATED "22-Dec-2024 00:24:17" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;835 172312
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.INSERTCH)
|
||||
:CHANGES-TO (FNS \TEDIT.TEXTPROP)
|
||||
|
||||
:PREVIOUS-DATE "22-Mar-2025 21:37:13" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;863)
|
||||
:PREVIOUS-DATE "20-Dec-2024 12:19:41" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;834)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||
@@ -102,7 +102,7 @@
|
||||
NEXTPIECE (* ; "-> Next piece in this textobj.")
|
||||
(PREVPIECE FULLXPOINTER) (* ;
|
||||
"-> Prior piece in this text object.")
|
||||
PCHARLOOKS (* ; "Character formatting info ")
|
||||
PLOOKS (* ; "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,12 +121,10 @@
|
||||
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
||||
(type? IMAGEOBJ (PCONTENTS DATUM))
|
||||
(PCONTENTS DATUM)))
|
||||
(PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM)
|
||||
FAST
|
||||
(fetch (PIECE PCHARLOOKS) of DATUM))
|
||||
(STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE)
|
||||
(PCHARLOOKS (PLOOKS DATUM)
|
||||
(STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE)
|
||||
FAST
|
||||
(freplace (PIECE PCHARLOOKS) of DATUM with NEWVALUE]
|
||||
(freplace (PIECE PLOOKS) of DATUM with NEWVALUE]
|
||||
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
|
||||
|
||||
(DATATYPE TEXTOBJ
|
||||
@@ -137,7 +135,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")
|
||||
SUFFIXPIECE (* ;
|
||||
LASTPIECE (* ;
|
||||
"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#")
|
||||
@@ -159,8 +157,8 @@
|
||||
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
||||
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: Scratch space for the selection code")
|
||||
NIL (* ;
|
||||
"Was MOVESEL: Source for the next MOVE of text")
|
||||
NIL (* ;
|
||||
@@ -189,7 +187,7 @@
|
||||
"Cache of line-related info, to speed up selection &c")
|
||||
(MENUFLG FLAG) (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu")
|
||||
DEFAULTPARALOOKS (* ;
|
||||
FMTSPEC (* ;
|
||||
"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.")
|
||||
@@ -227,7 +225,7 @@
|
||||
TXTCHARLOOKSLIST (* ;
|
||||
"List of all the CHARLOOKSs in the document, so they can be kept unique")
|
||||
TXTPARALOOKSLIST (* ;
|
||||
"List of all the PARALOOKS in the document, so they can be kept unique")
|
||||
"List of all the FMTSPECs 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 (* ;
|
||||
@@ -238,15 +236,13 @@
|
||||
"Style sheet local to this document. Not currently saved as part of the file.")
|
||||
)
|
||||
[ACCESSFNS TEXTOBJ ((\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))]
|
||||
(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)
|
||||
DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
|
||||
(ACCESSFNS TEXTSTREAM
|
||||
(
|
||||
@@ -269,10 +265,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))
|
||||
(* ; "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.")
|
||||
(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))
|
||||
(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)))
|
||||
@@ -404,10 +400,10 @@
|
||||
(ffetch (PIECE PCONTENTS) of PC)))
|
||||
|
||||
(PUTPROPS PLOOKS MACRO ((PC)
|
||||
(ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(ffetch (PIECE PLOOKS) of PC)))
|
||||
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC)
|
||||
(ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(PLOOKS PC)))
|
||||
|
||||
(PUTPROPS PCHARSET MACRO ((PC)
|
||||
(ffetch (PIECE PCHARSET) of PC)))
|
||||
@@ -1229,13 +1225,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPENTEXTSTREAM
|
||||
[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")
|
||||
[LAMBDA (TEXT WINDOW START END PROPS)
|
||||
|
||||
(* ;; "Edited 21-Nov-2024 00:18 by rmk")
|
||||
|
||||
@@ -1297,17 +1287,11 @@
|
||||
"Empty string means empty document, not illegal file name")
|
||||
(SETQ TEXT NIL))
|
||||
(RESETLST
|
||||
(LET ((TSTREAM (TEXTSTREAM TEXT T))
|
||||
TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE START)
|
||||
(LET ((TSTREAM (TEXTSTREAMP TEXT))
|
||||
TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE)
|
||||
(DECLARE (SPECVARS TEDIT.GET.FINISHEDFORMS)) (* ;
|
||||
"Undocumented, but available for special-purpose actions specified somewhere below.")
|
||||
(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
|
||||
(if TSTREAM
|
||||
then (SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(CL:WHEN (OR START END) (* ; "Do the end first")
|
||||
(CL:WHEN (AND END (ILESSP END (TEXTLEN TEXTOBJ)))
|
||||
@@ -1320,13 +1304,14 @@
|
||||
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.WINDOW.CREATE WINDOW TSTREAM PROPS)))
|
||||
else (\TEDIT.CREATEW WINDOW TSTREAM PROPS)))
|
||||
(\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS)
|
||||
(\TEDIT.REOPENTEXTSTREAM TSTREAM)
|
||||
else (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM PROPS))
|
||||
(SETQ TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ))
|
||||
(CL:WHEN TEXT (* ;
|
||||
@@ -1334,23 +1319,23 @@
|
||||
(SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS))
|
||||
(FSETTOBJ TEXTOBJ TXTFILE TEXT))
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "Get the window before populating pieces, so that the local promptwindow is availabe for messages and queries")
|
||||
|
||||
(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))
|
||||
(CL:WHEN WINDOW (* ;
|
||||
"WINDOW is Tedit on call from TEDIT")
|
||||
(SETQ WINDOW (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))]
|
||||
(\TEDIT.OPENTEXTSTREAM.PIECES TEXT TSTREAM START END 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))
|
||||
@@ -1360,9 +1345,7 @@
|
||||
TSTREAM))])
|
||||
|
||||
(COPYTEXTSTREAM
|
||||
[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")
|
||||
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "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")
|
||||
@@ -1382,16 +1365,13 @@
|
||||
"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 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))
|
||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) do (\TEDIT.INSERTPIECE (\TEDIT.COPYPIECE
|
||||
PC TEXTOBJ NEWTEXTOBJ
|
||||
NIL 'COPY)
|
||||
NIL NEWTEXTOBJ))
|
||||
(FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
|
||||
(FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(FSETTOBJ NEWTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(FSETTOBJ NEWTEXTOBJ FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
(FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL))
|
||||
(FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET))
|
||||
@@ -1512,8 +1492,7 @@
|
||||
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Feb-2025 08:56 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 14:33 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -1534,53 +1513,53 @@
|
||||
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
SELPROP)
|
||||
(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 (* ;
|
||||
(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
|
||||
@@ -1622,10 +1601,7 @@
|
||||
WINDOW])
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ) (* ; "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")
|
||||
@@ -1644,8 +1620,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)
|
||||
(FONTCREATE DEFAULTFONT)))
|
||||
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'CHARLOOKS))
|
||||
DEFAULTFONT))
|
||||
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'LOOKS))
|
||||
(SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
|
||||
(AND (type? CHARLOOKS FONT)
|
||||
FONT)
|
||||
@@ -1653,14 +1629,13 @@
|
||||
(SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ))
|
||||
(SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
|
||||
(OR (GETTEXTPROP TEXTOBJ 'PARALOOKS)
|
||||
(create PARALOOKS using
|
||||
TEDIT.DEFAULT.FMTSPEC
|
||||
))
|
||||
(create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)
|
||||
)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ))
|
||||
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
|
||||
(SETTOBJ TEXTOBJ FMTSPEC PARALOOKS])
|
||||
|
||||
(\TEDIT.OPENTEXTFILE
|
||||
[LAMBDA (TEXT PROPS) (* ; "Edited 21-Nov-2024 11:38 by rmk")
|
||||
@@ -1691,8 +1666,7 @@
|
||||
(ERROR TEXT " does not identify a Tedit document")))])
|
||||
|
||||
(\TEDIT.CREATE.TEXTSTREAM
|
||||
[LAMBDA (PROPS) (* ; "Edited 7-Feb-2025 08:09 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 09:52 by rmk")
|
||||
[LAMBDA (PROPS) (* ; "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")
|
||||
@@ -1705,7 +1679,7 @@
|
||||
(SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
|
||||
(\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
|
||||
(\TEDIT.MAKEPCTB TEXTOBJ)
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
0)
|
||||
TSTREAM])
|
||||
|
||||
@@ -1980,8 +1954,7 @@
|
||||
(\TEDIT.DELETE TEXTOBJ TAILSEL)))])
|
||||
|
||||
(\TEDIT.TEXTGETFILEPTR
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Feb-2025 08:12 by rmk")
|
||||
(* ; "Edited 7-May-2024 21:14 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -1995,7 +1968,7 @@
|
||||
(PC (ffetch (TEXTSTREAM PIECE) of TSTREAM))
|
||||
PCCHARSLEFT)
|
||||
(if (OR (NULL PC)
|
||||
(\SUFFIXPIECEP PC TEXTOBJ))
|
||||
(\LASTPIECEP PC TEXTOBJ))
|
||||
then
|
||||
(* ;; "Not set or off the end")
|
||||
|
||||
@@ -2004,7 +1977,7 @@
|
||||
then
|
||||
(* ;; "Replace a lingering piece from a delete-everything?")
|
||||
|
||||
(freplace (TEXTSTREAM PIECE) of TSTREAM with (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(freplace (TEXTSTREAM PIECE) of TSTREAM with (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
0
|
||||
else (* ; "Somewhere inside the document")
|
||||
(SETQ PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))
|
||||
@@ -2114,18 +2087,13 @@
|
||||
THEN (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE])
|
||||
|
||||
(\TEDIT.TEXTLEFTMARGIN
|
||||
[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")
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 17-Mar-2024 12:30 by rmk")
|
||||
(* ; "Edited 31-May-91 14:03 by jds")
|
||||
(IPLUS 8 (GETPLOOKS (FGETTOBJ (TEXTOBJ TSTREAM)
|
||||
DEFAULTPARALOOKS)
|
||||
LEFTMAR])
|
||||
(IPLUS 8 (fetch (FMTSPEC LEFTMAR) of (FGETTOBJ (TEXTOBJ TSTREAM)
|
||||
FMTSPEC])
|
||||
|
||||
(\TEDIT.TEXTRIGHTMARGIN
|
||||
[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")
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 28-Jun-2024 22:07 by rmk")
|
||||
(* ; "Edited 21-Sep-2023 12:38 by rmk")
|
||||
(* ; "Edited 31-May-91 14:03 by jds")
|
||||
|
||||
@@ -2137,25 +2105,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 PARALOOKS or the PARALOOKS 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 FMTSPEC or the FMTSPEC of the current piece.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(if (FGETTOBJ TEXTOBJ PRIMARYPANE)
|
||||
then (LET* ((PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(RIGHTMAR (FGETPLOOKS PARALOOKS RIGHTMAR))
|
||||
then (LET* ((FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))
|
||||
LEFTMAR NEWPOS)
|
||||
(CL:WHEN (ZEROP RIGHTMAR)
|
||||
(SETQ RIGHTMAR (FGETTOBJ TEXTOBJ WRIGHT)))
|
||||
(SETQ RIGHTMAR (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)))
|
||||
(CL:WHEN (AND XPOSITION (NEQ XPOSITION RIGHTMAR))
|
||||
(* ; "Changing the default PARALOOKS")
|
||||
(SETQ LEFTMAR (FGETPLOOKS PARALOOKS LEFTMAR))
|
||||
(* ; "Changing the default FMTSPEC")
|
||||
(SETQ LEFTMAR (fetch (FMTSPEC LEFTMAR) of FMTSPEC))
|
||||
(CL:WHEN (ILEQ RIGHTMAR LEFTMAR)
|
||||
(\ILLEGAL.ARG XPOSITION))
|
||||
(FSETTOBJ TEXTOBJ DEFAULTPARALOOKS
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS (create PARALOOKS
|
||||
using PARALOOKS RIGHTMAR _ XPOSITION
|
||||
)
|
||||
TEXTOBJ))
|
||||
(FSETTOBJ TEXTOBJ FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS (create FMTSPEC
|
||||
using FMTSPEC
|
||||
RIGHTMAR _
|
||||
XPOSITION)
|
||||
TEXTOBJ))
|
||||
(LINELENGTH (IQUOTIENT (IDIFFERENCE RIGHTMAR XPOSITION)
|
||||
(CHARWIDTH (CHARCODE A)
|
||||
TSTREAM))
|
||||
@@ -2223,8 +2191,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.DELETE.SELPIECES
|
||||
[LAMBDA (TEXTOBJ FIRSTCHAR LEN DONTCHECK) (* ; "Edited 5-Feb-2025 23:33 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 22:31 by rmk")
|
||||
[LAMBDA (TEXTOBJ FIRSTCHAR LEN) (* ; "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")
|
||||
@@ -2244,10 +2211,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))
|
||||
(OR DONTCHECK (for PC inselpieces (PROGN SELPIECES)
|
||||
always (OBJECT.ALLOWS PC 'DELETE TEXTOBJ]
|
||||
(for PC inselpieces (PROGN SELPIECES) always (OBJECT.ALLOWS PC
|
||||
'DELETE TEXTOBJ)))
|
||||
(SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST)))
|
||||
(\TEDIT.DELETEPIECES SELPIECES TEXTOBJ)
|
||||
|
||||
@@ -2273,8 +2240,7 @@
|
||||
T)))])
|
||||
|
||||
(\TEDIT.INSERTCH
|
||||
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 26-Mar-2025 00:29 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 13:48 by rmk")
|
||||
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "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")
|
||||
@@ -2364,11 +2330,12 @@
|
||||
(FSETPC PREVPC PBYTELEN ILEN)
|
||||
(FSETPC PREVPC PBINABLE T)
|
||||
(FSETPC PREVPC PCHARSET 0))
|
||||
(FATSTRING.PTYPE (* ; "PCHARSET is not relevant")
|
||||
(FATSTRING.PTYPE
|
||||
(FSETPC PREVPC PBYTESPERCHAR 2)
|
||||
(FSETPC PREVPC PBYTELEN (UNFOLD ILEN 2))
|
||||
(FSETPC PREVPC PBINABLE NIL))
|
||||
(\TEDIT.THELP "Unexpected PTYPE"))
|
||||
(FSETPC PREVPC PBINABLE NIL)
|
||||
(FSETPC PREVPC PCHARSET \NORUNCODE))
|
||||
NIL)
|
||||
(\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))
|
||||
|
||||
(* ;; "The insertion is done and the pieces are properly integrated into the stream. ")
|
||||
@@ -2714,9 +2681,7 @@
|
||||
(CADR PTAIL])
|
||||
|
||||
(\TEDIT.TEXTPROP
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "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")
|
||||
@@ -2758,7 +2723,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 NEWVALUE))))
|
||||
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE T))))
|
||||
(DIRTY (PROG1 (FGETTOBJ TEXTOBJ \XDIRTY)
|
||||
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ \DIRTY NEWVALUE))))
|
||||
(LENGTH (PROG1 (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
@@ -2786,11 +2751,6 @@
|
||||
(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)
|
||||
@@ -2879,31 +2839,31 @@
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (37107 67708 (\TEDIT.TEXTBIN 37117 . 47867) (\TEDIT.TEXTPEEKBIN 47869 . 53419) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53421 . 59094) (\TEDIT.TEXTBOUT 59096 . 63498) (\TEDIT.INSTALL.FILEBUFFER 63500
|
||||
. 67706)) (68606 72654 (\TEDIT.TEXTOUTCHARFN 68616 . 70172) (\TEDIT.TEXTINCCODEFN 70174 . 70913) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70915 . 71507) (\TEDIT.TEXTFORMATBYTESTREAM 71509 . 72212) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72214 . 72652)) (72701 84222 (OPENTEXTSTREAM 72711 . 79663) (
|
||||
COPYTEXTSTREAM 79665 . 83445) (TEDIT.STREAMCHANGEDP 83447 . 83749) (TXTFILE 83751 . 84220)) (84223
|
||||
114083 (\TEDIT.REOPENTEXTSTREAM 84233 . 85585) (\TEDIT.OPENTEXTSTREAM.PIECES 85587 . 90017) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 90019 . 91121) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91123 . 96209) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 96211 . 98892) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98894 . 101864) (
|
||||
\TEDIT.OPENTEXTFILE 101866 . 103579) (\TEDIT.CREATE.TEXTSTREAM 103581 . 104626) (\TEDIT.REOPEN.STREAM
|
||||
104628 . 106964) (\TEDIT.TEXTINIT 106966 . 114081)) (114121 115309 (\TEDIT.TTYBOUT 114131 . 115307)) (
|
||||
115427 134219 (\TEDIT.TEXTCLOSEF 115437 . 116761) (\TEDIT.TEXTDSPFONT 116763 . 117733) (
|
||||
\TEDIT.TEXTEOFP 117735 . 119490) (\TEDIT.TEXTGETEOFPTR 119492 . 119815) (\TEDIT.TEXTSETEOFPTR 119817
|
||||
. 120907) (\TEDIT.TEXTGETFILEPTR 120909 . 123744) (\TEDIT.TEXTSETFILEINFO 123746 . 124254) (
|
||||
\TEDIT.TEXTOPENF 124256 . 125187) (\TEDIT.TEXTSETEOF 125189 . 125805) (\TEDIT.TEXTSETFILEPTR 125807 .
|
||||
127848) (\TEDIT.TEXTDSPXPOSITION 127850 . 128867) (\TEDIT.TEXTDSPYPOSITION 128869 . 129610) (
|
||||
\TEDIT.TEXTLEFTMARGIN 129612 . 130203) (\TEDIT.TEXTRIGHTMARGIN 130205 . 133368) (
|
||||
\TEDIT.TEXTDSPCHARWIDTH 133370 . 133674) (\TEDIT.TEXTDSPSTRINGWIDTH 133676 . 133982) (
|
||||
\TEDIT.TEXTDSPLINEFEED 133984 . 134217)) (135266 156139 (\TEDIT.DELETE.SELPIECES 135276 . 138789) (
|
||||
\TEDIT.INSERTCH 138791 . 146721) (\TEDIT.INSERTCH.HISTORY 146723 . 150187) (\TEDIT.INSERTEOL 150189 .
|
||||
152014) (\TEDIT.INSERTCH.INSERTION 152016 . 154853) (\TEDIT.INSERTCH.EXTEND 154855 . 156137)) (156140
|
||||
157644 (\TEDIT.NEXTCHANGEABLE.CHNO 156150 . 156865) (\TEDIT.LASTCHANGEABLE.CHNO 156867 . 157642)) (
|
||||
157645 159349 (\SETUPGETCH 157655 . 159347)) (159407 163865 (\TEDIT.INSTALL.PIECE 159417 . 163863)) (
|
||||
163903 172652 (TEXTPROP 163913 . 164260) (GETTEXTPROP 164262 . 164506) (PUTTEXTPROP 164508 . 164765) (
|
||||
GETTEXTPROPS 164767 . 165211) (PUTTEXTPROPS 165213 . 166117) (\TEDIT.TEXTPROP 166119 . 172650)) (
|
||||
172653 174723 (\TEDIT.TEXTOBJ.PROPNAMES 172663 . 173615) (\TEDIT.TEXTOBJ.PROPFETCHFN 173617 . 174133)
|
||||
(\TEDIT.TEXTOBJ.PROPSTOREFN 174135 . 174721)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,234 +0,0 @@
|
||||
(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
|
||||
Binary file not shown.
@@ -1,15 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 12:18:40" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;175 94753
|
||||
(FILECREATED "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163 92210
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (RECORDS PARA)
|
||||
(FNS TEDITFROMBRAVO \TFBRAVO.READ.PARALOOKS \TFBRAVO.HANDLE.HEADING
|
||||
\TFBRAVO.PARSE.PROFILE.PARA \TFBRAVO.SPLIT.PARA \TFBRAVO.RUN.TABSPEC
|
||||
\TFBRAVO.ADD.NAMEDTAB)
|
||||
:CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:19:34" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;174)
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;162)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||
@@ -75,10 +72,10 @@
|
||||
(RECORD BRAVOFONT (BFFONTNUM BRFAMILY BRSIZE BRWEIGHT BRSLOPE))
|
||||
|
||||
(RECORD PARA (PARAFMTSPEC RUNS FORMATPTRS)
|
||||
(ACCESSFNS (PARATABDEFS (GETPLOOKS (fetch (PARA PARAFMTSPEC) of DATUM)
|
||||
FMTUSERINFO)
|
||||
(FSETPLOOKS (fetch (PARA PARAFMTSPEC) of DATUM)
|
||||
FMTUSERINFO NEWVALUE))))
|
||||
(ACCESSFNS (PARATABDEFS (fetch (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC)
|
||||
of DATUM))
|
||||
(replace (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC)
|
||||
of DATUM) with NEWVALUE))))
|
||||
|
||||
(RECORD RUN (RUNLENGTH RUNLOOKS RUNSTART RUNLAST)
|
||||
(ACCESSFNS (RUNTABS (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of DATUM))
|
||||
@@ -173,10 +170,7 @@
|
||||
(RETURN T])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "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")
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "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")
|
||||
@@ -191,9 +185,9 @@
|
||||
(CL:UNLESS TEXTSTREAM
|
||||
(SETQ TEXTSTREAM (OPENTEXTSTREAM NIL))) (* ;
|
||||
" Produce the USER.CM's alist of default values")
|
||||
(bind PARA NEXTPARALOOKS USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST START
|
||||
(BSTREAM _ BFILE)
|
||||
(TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare (SPECVARS USER.CM.PARALOOKS USER.CM.CHARLOOKS
|
||||
(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)
|
||||
first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ))
|
||||
(* ; "Go for plain text")
|
||||
@@ -207,32 +201,28 @@
|
||||
(PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT)
|
||||
[RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
`(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE]
|
||||
(SETQ NEXTPARALOOKS USER.CM.PARALOOKS) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(SETQ NEXTFMTSPEC USER.CM.FMTSPEC) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(* ;
|
||||
"Profiles and headings have to back up")
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA
|
||||
NEXTPARALOOKS BSTREAM
|
||||
TEXTOBJ))
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA NEXTFMTSPEC
|
||||
BSTREAM TEXTOBJ))
|
||||
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTPARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
|
||||
(* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text")
|
||||
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (GETPLOOKS NEXTPARALOOKS
|
||||
FMTPARATYPE))
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE)
|
||||
of NEXTFMTSPEC))
|
||||
(\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA
|
||||
TEXTOBJ START))
|
||||
(\TFBRAVO.INSERT.PARA PARA BSTREAM TEXTOBJ))
|
||||
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
|
||||
(* ;; "Named tab information is collected in the userinfo fields, but then ignored.")
|
||||
|
||||
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
do (SETPLOOKS PARALOOKS FMTUSERINFO NIL))
|
||||
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
|
||||
do (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
|
||||
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
|
||||
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
do (replace (FMTSPEC FMTUSERINFO) of PARALOOKS with NIL))
|
||||
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
|
||||
do (replace (CHARLOOKS CLUSERINFO) of CHARLOOKS with NIL))
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ)
|
||||
(TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
|
||||
(RETURN TEXTSTREAM)))])
|
||||
@@ -292,23 +282,22 @@
|
||||
(RETURN USER.CM])
|
||||
|
||||
(\TFBRAVO.USER.CM.LOOKS
|
||||
[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")
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "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.PARALOOKS USER.CM.ALIST))
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC 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.GETFONT 0 BRFAMILY)
|
||||
(\TFBRAVO.GETFONT 0 BRSIZE))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS)
|
||||
(\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ)
|
||||
(SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ))
|
||||
(SETQ USER.CM.PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.PARALOOKS TEXTOBJ))
|
||||
(SETQ USER.CM.FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.FMTSPEC TEXTOBJ))
|
||||
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS USER.CM.CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS USER.CM.PARALOOKS])
|
||||
(SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
|
||||
|
||||
(\TFBRAVO.READ.USER.CM
|
||||
[LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk")
|
||||
@@ -389,8 +378,7 @@
|
||||
(GO LLP)))])
|
||||
|
||||
(\TFBRAVO.INIT.PARALOOKS
|
||||
[LAMBDA (ALIST) (* ; "Edited 8-Feb-2025 22:09 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 22:17 by rmk")
|
||||
[LAMBDA (ALIST) (* ; "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")
|
||||
@@ -399,12 +387,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 ((INITPARALOOKS (create PARALOOKS using TEDIT.DEFAULT.FMTSPEC)))
|
||||
(LET ((INITFMTSPEC (create FMTSPEC 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 PARALOOKS INITPARALOOKS (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
|
||||
85))
|
||||
(with FMTSPEC INITFMTSPEC (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
|
||||
85))
|
||||
(SETQ 1STLEFTMAR (OR (CADR (ASSOC 'FirstLineLeftMargin ALIST))
|
||||
LEFTMAR))
|
||||
(SETQ RIGHTMAR (OR (CADR (ASSOC 'RightMargin ALIST))
|
||||
@@ -418,7 +406,7 @@
|
||||
DEFAULTTAB))
|
||||
(SETQ FMTSPECIALX 0)
|
||||
(SETQ FMTSPECIALY 0))
|
||||
INITPARALOOKS])
|
||||
INITFMTSPEC])
|
||||
|
||||
(\TFBRAVO.INIT.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:03 by rmk")
|
||||
@@ -505,8 +493,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.PARSE.PARA
|
||||
[LAMBDA (OLDPARALOOKS BSTREAM TEXTOBJ) (* ; "Edited 8-Feb-2025 23:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "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")
|
||||
@@ -514,17 +501,17 @@
|
||||
(* ; "Edited 16-Aug-2023 21:28 by rmk")
|
||||
(* ; "Edited 13-Jun-2021 09:46 by rmk:")
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;; "^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.PARALOOKS))
|
||||
(LET (BYTE PLEN ^ZPTR ENDCHAR PARALOOKS RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
|
||||
BSTREAM))
|
||||
(PARALOOKS USER.CM.PARALOOKS))
|
||||
(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))
|
||||
|
||||
(* ;; "BYTE=NIL at EOF, no terminating ^Z")
|
||||
|
||||
@@ -553,19 +540,17 @@
|
||||
(NIL T)
|
||||
NIL))
|
||||
(SELCHARQ BYTE
|
||||
(^Z (SETQ PARALOOKS (\TFBRAVO.READ.PARALOOKS OLDPARALOOKS BSTREAM TEXTOBJ))
|
||||
(^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS OLDFMTSPEC BSTREAM TEXTOBJ))
|
||||
(SETQ RUNS (\TFBRAVO.CREATE.RUNS BSTREAM PSTART PLEN)))
|
||||
(NIL)
|
||||
(\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF"))
|
||||
(create PARA
|
||||
PARAFMTSPEC _ PARALOOKS
|
||||
PARAFMTSPEC _ FMTSPEC
|
||||
RUNS _ RUNS
|
||||
FORMATPTRS _ FORMATPTRS])
|
||||
|
||||
(\TFBRAVO.READ.PARALOOKS
|
||||
[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")
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "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")
|
||||
@@ -577,48 +562,46 @@
|
||||
(* ; "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.PARALOOKS))
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
|
||||
(* ;;
|
||||
"Decodes bravo paragraph looks into a TEDIT PARALOOKS. OLDPARALOOKS is used just for its tabs.")
|
||||
"Decodes bravo paragraph looks into a TEDIT FMTSPEC. OLDFMTSPEC is used just for its tabs.")
|
||||
|
||||
(PARALOOKS! OLDPARALOOKS)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPLOOKS USER.CM.PARALOOKS
|
||||
(\DTEST OLDFMTSPEC 'FMTSPEC)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC
|
||||
FMTDEFAULTTAB))
|
||||
(NEWPARALOOKS _ (create PARALOOKS using USER.CM.PARALOOKS))
|
||||
first (CL:UNLESS (EQ 'PROFILE (FGETPLOOKS OLDPARALOOKS FMTPARATYPE))
|
||||
(NEWFMTSPEC _ (create FMTSPEC using USER.CM.FMTSPEC))
|
||||
first (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC FMTPARATYPE))
|
||||
|
||||
(* ;; "It appears that heading-tabs don't carry over to other paragraphs. Although maybe the default interval-tab does?")
|
||||
|
||||
(SETQ TABDEFAULT (OR (FGETPLOOKS OLDPARALOOKS FMTDEFAULTTAB)
|
||||
(FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
|
||||
(SETQ TABDEFAULT (OR (FGETPARA OLDFMTSPEC FMTDEFAULTTAB)
|
||||
(FGETPARA USER.CM.FMTSPEC 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 (FGETPLOOKS OLDPARALOOKS FMTUSERINFO))))
|
||||
(SETQ NAMEDTABS (COPY (FGETPARA OLDFMTSPEC FMTUSERINFO))))
|
||||
do (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(l (SETQ LMFLAG T)
|
||||
(FSETPLOOKS NEWPARALOOKS LEFTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(FSETPARA NEWFMTSPEC LEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)))
|
||||
(d (SETQ 1LMFLAG 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)))
|
||||
(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)))
|
||||
(y (* ; "vertical tabs are supported")
|
||||
(FSETPLOOKS NEWPARALOOKS FMTSPECIALX 0)
|
||||
(FSETPLOOKS NEWPARALOOKS FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (FSETPLOOKS NEWPARALOOKS FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(FSETPARA NEWFMTSPEC FMTSPECIALX 0)
|
||||
(FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(w 'HardcopyMode)
|
||||
(j (FSETPLOOKS NEWPARALOOKS QUAD 'JUSTIFIED))
|
||||
(c (FSETPLOOKS NEWPARALOOKS QUAD 'CENTERED))
|
||||
(j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED))
|
||||
(c (FSETPARA NEWFMTSPEC QUAD 'CENTERED))
|
||||
(q
|
||||
(* ;; "Profiles are marked here but then interpreted at the top")
|
||||
|
||||
(FSETPLOOKS NEWPARALOOKS FMTPARATYPE 'PROFILE))
|
||||
(FSETPARA NEWFMTSPEC FMTPARATYPE 'PROFILE))
|
||||
(%( (* ; "Collect the named tabs")
|
||||
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position")
|
||||
|
||||
@@ -649,13 +632,13 @@
|
||||
((CR \)
|
||||
(CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;
|
||||
"If there was a Left margin but no firstline left then default it")
|
||||
(FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (FGETPLOOKS NEWPARALOOKS LEFTMAR)))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB TABDEFAULT)
|
||||
(FSETPLOOKS NEWPARALOOKS FMTUSERINFO (DREVERSE NAMEDTABS))
|
||||
(FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR)))
|
||||
(FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT)
|
||||
(FSETPARA NEWFMTSPEC FMTUSERINFO (DREVERSE NAMEDTABS))
|
||||
(CL:WHEN (EQ COMMAND (CHARCODE CR)) (* ;
|
||||
"Read the \ separator, but leave the terminating CR")
|
||||
(\BACKFILEPTR BSTREAM))
|
||||
(RETURN NEWPARALOOKS))
|
||||
(RETURN NEWFMTSPEC))
|
||||
(\TEDIT.THELP (CHARACTER COMMAND)
|
||||
'" is not a legal Bravo paragraph-format character"])
|
||||
|
||||
@@ -677,8 +660,7 @@
|
||||
(SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN])
|
||||
|
||||
(\TFBRAVO.READ.CHARLOOKS
|
||||
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 2-Jan-2025 23:44 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "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")
|
||||
@@ -688,39 +670,36 @@
|
||||
|
||||
(* ;; "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 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))
|
||||
(bind COMMAND LEN LAST VALUE TABNAMES (NEWCHARLOOKS _ (create CHARLOOKS using OLDCHARLOOKS))
|
||||
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 safer?")
|
||||
(* ;; "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?")
|
||||
|
||||
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(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))
|
||||
(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))
|
||||
(g "Graphic T --unsupported")
|
||||
(G "Graphic NIL")
|
||||
(v (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE NIL))
|
||||
(V (AND NIL (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE T)))
|
||||
(v (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with NIL))
|
||||
(V (AND NIL (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with 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)))
|
||||
(SETQ SIZE (\TFBRAVO.GETFONT VALUE BRSIZE))
|
||||
(SETQ FAMILY (\TFBRAVO.GETFONT VALUE BRFAMILY)))
|
||||
(replace (CHARLOOKS CLSIZE) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRSIZE))
|
||||
(replace (CHARLOOKS CLNAME) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRFAMILY)))
|
||||
(o (SETQ VALUE (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Superscript")
|
||||
(FSETCLOOKS NEWCHARLOOKS CLOFFSET (CL:IF (IGREATERP VALUE 127)
|
||||
(IDIFFERENCE VALUE 256)
|
||||
VALUE)))
|
||||
(replace (CHARLOOKS CLOFFSET) of NEWCHARLOOKS with (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. ")
|
||||
@@ -743,8 +722,8 @@
|
||||
|
||||
(* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length")
|
||||
|
||||
(FSETCLOOKS NEWCHARLOOKS CLUSERINFO (DREVERSE TABNAMES))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS FAMILY SIZE BOLD ITALIC)
|
||||
(replace (CHARLOOKS CLUSERINFO) of NEWCHARLOOKS with (DREVERSE TABNAMES))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS)
|
||||
(RETURN (create RUN
|
||||
RUNSTART _ RUNSTART
|
||||
RUNLENGTH _ LEN
|
||||
@@ -752,29 +731,22 @@
|
||||
RUNLAST _ LAST])
|
||||
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS
|
||||
[LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC) (* ; "Edited 2-Jan-2025 23:43 by rmk")
|
||||
(* ; "Edited 1-Aug-2023 13:21 by rmk")
|
||||
[LAMBDA (CHARLOOKS) (* ; "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.")
|
||||
|
||||
[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]
|
||||
[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]
|
||||
CHARLOOKS])
|
||||
|
||||
(\TFBRAVO.READNUM?
|
||||
@@ -810,9 +782,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.HANDLE.HEADING
|
||||
[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")
|
||||
[LAMBDA (BSTREAM TEXTOBJ HEADINGSTART) (* ; "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")
|
||||
@@ -822,33 +792,31 @@
|
||||
|
||||
(* ;; "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.PARALOOKS))
|
||||
(LET (HEADINGDESC HEADINGPARA HEADINGPARALOOKS) (* ;
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
(LET (HEADINGDESC HEADINGPARA HEADINGFMTSPEC) (* ;
|
||||
"skip over the trailer of the profile para")
|
||||
(SETFILEPTR BSTREAM HEADINGSTART)
|
||||
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.PARALOOKS BSTREAM TEXTOBJ))
|
||||
(SETQ HEADINGPARALOOKS (fetch (PARA PARAFMTSPEC) of HEADINGPARA))
|
||||
(SETPLOOKS HEADINGPARALOOKS FMTPARATYPE 'PAGEHEADING)
|
||||
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.FMTSPEC BSTREAM TEXTOBJ))
|
||||
(SETQ HEADINGFMTSPEC (fetch (PARA PARAFMTSPEC) of HEADINGPARA))
|
||||
(replace (FMTSPEC FMTPARATYPE) of HEADINGFMTSPEC with '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 (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALX)
|
||||
(OR (fetch (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC)
|
||||
0)
|
||||
(OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALY)
|
||||
(OR (fetch (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC)
|
||||
0)))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTPARASUBTYPE (CAR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTSPECIALX (CADR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTSPECIALY (CADDR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTPARASUBTYPE) of HEADINGFMTSPEC with (CAR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC with (CADR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC with (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 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:27 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:02 by rmk")
|
||||
[LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START) (* ; "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")
|
||||
@@ -946,8 +914,8 @@
|
||||
(PROGN (* ;
|
||||
"Not a profile line, presumably a mistaken q.")
|
||||
(SETFILEPTR BSTREAM END)
|
||||
(FSETPLOOKS (fetch (PARA PARAFMTSPEC) of PARAGRAPH)
|
||||
FMTPARATYPE NIL)
|
||||
(replace (FMTSPEC FMTPARATYPE) of (fetch (PARA PARAFMTSPEC) of PARAGRAPH)
|
||||
with NIL)
|
||||
(RETURN NIL] repeatuntil [EQ (CAR LINE)
|
||||
(CONSTANT (CHARACTER (CHARCODE ^Z]
|
||||
finally (CL:WHEN ROMAN
|
||||
@@ -968,20 +936,17 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.INSERT.PARA
|
||||
[LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "Edited 8-Feb-2025 23:06 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 16:13 by rmk")
|
||||
[LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "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 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])
|
||||
(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])
|
||||
|
||||
(\TFBRAVO.INSERT.RUN
|
||||
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 8-Feb-2025 23:08 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
[LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ) (* ; "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")
|
||||
@@ -991,7 +956,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 ?")
|
||||
|
||||
(* ;; "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")
|
||||
(* ;; "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")
|
||||
|
||||
(CL:WHEN (IGREATERP (fetch (RUN RUNLENGTH) of RUN)
|
||||
0) (* ; "No need for an empty piece")
|
||||
@@ -1002,7 +967,7 @@
|
||||
PLEN _ NCHARS
|
||||
PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN)
|
||||
TEXTOBJ)
|
||||
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)
|
||||
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)
|
||||
PPARALAST _ (fetch (RUN RUNLAST) of RUN)))
|
||||
(if (STRINGP RUNSTART)
|
||||
then
|
||||
@@ -1030,12 +995,10 @@
|
||||
PC))])
|
||||
|
||||
(\TFBRAVO.SPLIT.PARA
|
||||
[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")
|
||||
[LAMBDA (PARA) (* ; "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 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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;; "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.")
|
||||
|
||||
@@ -1043,7 +1006,7 @@
|
||||
|
||||
(* ;; "This smashes PARA's runs.")
|
||||
|
||||
(LET ((PARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(LET ((PARAFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
NEWPARAS)
|
||||
|
||||
(* ;;
|
||||
@@ -1051,9 +1014,9 @@
|
||||
|
||||
(SETQ NEWPARAS
|
||||
(if [AND (fetch (PARA FORMATPTRS) of PARA)
|
||||
(FMEMB (GETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
(FMEMB (fetch (FMTSPEC FMTSPECIALX) of PARAFMTSPEC)
|
||||
'(0 NIL))
|
||||
(FMEMB (GETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
(FMEMB (fetch (FMTSPEC FMTSPECIALY) of PARAFMTSPEC)
|
||||
'(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))
|
||||
@@ -1084,7 +1047,7 @@
|
||||
NEWRUNLENGTH)))
|
||||
(replace (RUN RUNLENGTH) of RUN with NEWRUNLENGTH))
|
||||
|
||||
(* ;; "Fill in RUNS here, PARALOOKS below. No more FORMATPTRS")
|
||||
(* ;; "Fill in RUNS here, FMTSPEC below. No more FORMATPTRS")
|
||||
|
||||
(create PARA
|
||||
RUNS _ FIRSTRUN)
|
||||
@@ -1094,18 +1057,19 @@
|
||||
(* ;; "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 PARALOOKS using PARALOOKS LEADAFTER _ 0))
|
||||
(for PTAIL (NEWPARALOOKS _ (create PARALOOKS
|
||||
using PARALOOKS 1STLEFTMAR _
|
||||
(GETPLOOKS PARALOOKS LEFTMAR)
|
||||
LEADBEFORE _ 0 LEADAFTER _ 0))
|
||||
with (create FMTSPEC using PARAFMTSPEC LEADAFTER _ 0))
|
||||
(for PTAIL (NEWFMTSPEC _ (create FMTSPEC
|
||||
using PARAFMTSPEC 1STLEFTMAR _
|
||||
(fetch (FMTSPEC LEFTMAR) of PARAFMTSPEC
|
||||
)
|
||||
LEADBEFORE _ 0 LEADAFTER _ 0))
|
||||
on (CDR $$VAL)
|
||||
do (replace (PARA PARAFMTSPEC) of (CAR PTAIL)
|
||||
with (CL:IF (CDR PTAIL)
|
||||
NEWPARALOOKS
|
||||
(create PARALOOKS using NEWPARALOOKS LEADAFTER _
|
||||
(GETPLOOKS PARALOOKS LEADAFTER)
|
||||
))]
|
||||
NEWFMTSPEC
|
||||
(create FMTSPEC using NEWFMTSPEC LEADAFTER _
|
||||
(fetch (FMTSPEC LEADAFTER)
|
||||
of PARAFMTSPEC)))]
|
||||
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).")
|
||||
@@ -1130,33 +1094,31 @@
|
||||
NEWPARAS])
|
||||
|
||||
(\TFBRAVO.RUN.TABSPEC
|
||||
[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")
|
||||
[LAMBDA (RUN PARAFMTSPEC) (* ; "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 PARALOOKS. This returns a PARALOOKS 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 PARAFMTSPEC. This returns a FMTSPEC for this run that only includes the named tabs that this run calls for.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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?)")
|
||||
(* ;; "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?)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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. ")
|
||||
(* ;; "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. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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.PARALOOKS))
|
||||
(LET ([LASTTAB (CAR (LAST (GETPLOOKS PARALOOKS FMTTABS]
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (OR (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
|
||||
(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)))
|
||||
(RUNTABS (fetch (RUN RUNTABS) of RUN))
|
||||
TAB TABS)
|
||||
(CL:WHEN (AND TABDEFS (NULL RUNTABS))
|
||||
@@ -1187,9 +1149,9 @@
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
TABS)))
|
||||
PARALOOKS])
|
||||
PARAFMTSPEC])
|
||||
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:04 by rmk")
|
||||
@@ -1383,9 +1345,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ADD.NAMEDTAB
|
||||
[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")
|
||||
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "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")
|
||||
@@ -1396,7 +1356,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 PARALOOKS. ")
|
||||
(* ;; "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. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -1404,8 +1364,8 @@
|
||||
|
||||
(NOTUSED)
|
||||
(LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN))
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))
|
||||
(TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB))
|
||||
(TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN))
|
||||
TAB TABNAMES TABS)
|
||||
(SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS))
|
||||
@@ -1428,11 +1388,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 (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)))
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS
|
||||
_ TABS))
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)))
|
||||
PARALOOKS])
|
||||
(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])
|
||||
|
||||
(\TFBRAVO.COPY.NAMEDTAB
|
||||
[LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58")
|
||||
@@ -1505,18 +1465,18 @@
|
||||
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6790 13568 (TEDIT.BRAVOFILE? 6800 . 8530) (TEDITFROMBRAVO 8532 . 13566)) (13679 29406 (
|
||||
\TFBRAVO.GET.USER.CM 13689 . 16499) (\TFBRAVO.USER.CM.LOOKS 16501 . 17836) (\TFBRAVO.READ.USER.CM
|
||||
17838 . 22408) (\TFBRAVO.INIT.PARALOOKS 22410 . 24519) (\TFBRAVO.INIT.PAGEFORMAT 24521 . 25401) (
|
||||
\TFBRAVO.GETPARAMS 25403 . 28257) (\TFBRAVO.FIND.LAST.TRAILER 28259 . 29404)) (29448 50146 (
|
||||
\TFBRAVO.PARSE.PARA 29458 . 33385) (\TFBRAVO.READ.PARALOOKS 33387 . 40277) (\TFBRAVO.CREATE.RUNS 40279
|
||||
. 41667) (\TFBRAVO.READ.CHARLOOKS 41669 . 46698) (\TFBRAVO.FONT.FROM.CHARLOOKS 46700 . 48247) (
|
||||
\TFBRAVO.READNUM? 48249 . 50144)) (50183 61224 (\TFBRAVO.HANDLE.HEADING 50193 . 52920) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 52922 . 61222)) (61267 83303 (\TFBRAVO.INSERT.PARA 61277 . 62118) (
|
||||
\TFBRAVO.INSERT.RUN 62120 . 65422) (\TFBRAVO.SPLIT.PARA 65424 . 72739) (\TFBRAVO.RUN.TABSPEC 72741 .
|
||||
77608) (\TFBRAVO.INSTALL.PAGEFORMAT 77610 . 83301)) (83304 87447 (\TFBRAVO.ASSERT 83314 . 83844) (
|
||||
\TEST.CHARACTER.LOOKS 83846 . 85732) (\TEST.PARAGRAPH.LOOKS 85734 . 87445)) (87932 94587 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 87942 . 91545) (\TFBRAVO.COPY.NAMEDTAB 91547 . 91995) (\TFBRAVO.PUT.NAMEDTAB
|
||||
91997 . 92277) (\TFBRAVO.GET.NAMEDTAB 92279 . 92656) (\NAMEDTABNYET 92658 . 92818) (\NAMEDTABSIZE
|
||||
92820 . 93335) (\NAMEDTABPREPRINT 93337 . 93535) (\TEDIT.NAMEDTAB.INIT 93537 . 94585)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Mar-2025 11:30:23" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;786 236503
|
||||
(FILECREATED "17-Dec-2024 23:43:52" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;739 230830
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION \TEDIT.UPDATE.TITLE)
|
||||
:CHANGES-TO (FNS \TEDIT.SHIFTLINES)
|
||||
|
||||
:PREVIOUS-DATE "18-Mar-2025 21:56:50" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;782)
|
||||
:PREVIOUS-DATE "13-Dec-2024 09:00:10" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;738)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
||||
@@ -18,15 +18,15 @@
|
||||
(MACROS PANEPROPS PANEPREFIX PANESUFFIX PANETOPLINE
|
||||
PANECARET PANESTREAM PANETOBJ PANEBOTTOMLINE
|
||||
\TEDIT.PREFIX.LCHARLIM)
|
||||
(MACROS PANETOP PANEWIDTH PANELEFT PANERIGHT
|
||||
PANEBOTTOM PANEHEIGHT PANEREGION)
|
||||
(MACROS PANETOP PANEWIDTH PANELEFT PANEBOTTOM
|
||||
PANEHEIGHT PANEREGION)
|
||||
(I.S.OPRS inpanes backpanes)
|
||||
(MACROS ALLBUTTONSUP)))
|
||||
(INITRECORDS TEDITCARET PANEPROPS)
|
||||
(FILES ATTACHEDWINDOW)
|
||||
(FNS TEDIT.DEFER.UPDATES)
|
||||
(FNS \TEDIT.WINDOW.CREATE \TEDIT.WINDOW.GETREGION \TEDIT.WINDOW.SETUP
|
||||
\TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE \TEDIT.FILL.PANES)
|
||||
(FNS \TEDIT.CREATEW \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 \TEDIT.FILENAME \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEDIT.LIKELY.FILENAME
|
||||
(FNS \TEXTSTREAM.TITLE \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEXTSTREAM.FILENAME
|
||||
\TEDIT.UPDATE.TITLE))
|
||||
(COMS (* ; "Screen updating utilities")
|
||||
(FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.RESHAPEFN \TEDIT.REPAINTFN)
|
||||
@@ -85,9 +85,7 @@
|
||||
|
||||
Unformatted% Get
|
||||
))
|
||||
Include Find Looks Substitute
|
||||
(Buttons 'Buttons
|
||||
"Display action buttons")
|
||||
Include Find Looks Substitute
|
||||
Quit
|
||||
(Expanded% Menu 'Expanded% Menu
|
||||
NIL
|
||||
@@ -265,9 +263,6 @@
|
||||
(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])
|
||||
|
||||
@@ -356,9 +351,8 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.WINDOW.CREATE
|
||||
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 18-Feb-2025 09:49 by rmk")
|
||||
(* ; "Edited 1-Jul-2024 22:55 by rmk")
|
||||
(\TEDIT.CREATEW
|
||||
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "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")
|
||||
@@ -416,12 +410,18 @@
|
||||
(SETQ REGION (if (REGIONP WINDOW)
|
||||
then (PROG1 (COPY WINDOW)
|
||||
(SETQ WINDOW NIL))
|
||||
elseif (GRAB-TYPED-REGION REGIONTYPE)
|
||||
else (SETQ REGION (\TEDIT.WINDOW.GETREGION TSTREAM REGIONTYPE PHEIGHT))
|
||||
(* ;
|
||||
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)) (* ;
|
||||
"We don't want the default to keep shrinking")
|
||||
(SETQ PREPROMPT (create REGION using REGION))
|
||||
REGION))
|
||||
(SETQ PREPROMPT (create REGION using REGION)))
|
||||
(add (fetch (REGION HEIGHT) of REGION)
|
||||
(IMINUS PHEIGHT))
|
||||
(SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS))
|
||||
@@ -429,11 +429,6 @@
|
||||
(* ;; "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]
|
||||
@@ -456,47 +451,6 @@
|
||||
(WINDOWPROP WINDOW 'TITLE TITLE)
|
||||
WINDOW])
|
||||
|
||||
(\TEDIT.WINDOW.GETREGION
|
||||
[LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "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 [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
|
||||
(for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
largest (GETPLOOKS PARALOOKS RIGHTMAR)
|
||||
finally (RETURN (CL:IF (AND $$EXTREME (IGREATERP $$EXTREME 0))
|
||||
$$EXTREME
|
||||
(TIMES 6 PTSPERINCH))]
|
||||
[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]
|
||||
(* ; "36 for right margin selection")
|
||||
(add WIDTH \TEDIT.LINEREGION.WIDTH 36 (ADD1 (TIMES 2 WBorder)
|
||||
1)
|
||||
(CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
||||
0
|
||||
\TEDIT.OP.WIDTH))
|
||||
(add HEIGHT 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")
|
||||
@@ -1004,51 +958,48 @@
|
||||
LEFT _ 0)))))])
|
||||
|
||||
(\TEDIT.SHRINK.ICONCREATE
|
||||
[LAMBDA (W ICON ICON-POSITION) (* ; "Edited 14-Mar-2025 12:35 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 18:28 by rmk")
|
||||
[LAMBDA (W ICON ICON-POSITION) (* ; "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.")
|
||||
|
||||
[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 (* ;
|
||||
[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) (* ;
|
||||
"This is a text menu, and shrinks without trace.")
|
||||
NIL
|
||||
elseif (OR (IGREATERP (FLENGTH SHRINKFN)
|
||||
3)
|
||||
(AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
|
||||
(IGREATERP (FLENGTH SHRINKFN)
|
||||
2)))
|
||||
then (* ;
|
||||
NIL)
|
||||
((OR (IGREATERP (FLENGTH SHRINKFN)
|
||||
3)
|
||||
(AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
|
||||
(IGREATERP (FLENGTH SHRINKFN)
|
||||
2))) (* ;
|
||||
"There are other functions that expect to handle this. Don't bother.")
|
||||
NIL
|
||||
else (OR (AND ICONTITLE (STRING.EQUAL ICONTITLE (\TEDIT.FILENAME TSTREAM)))
|
||||
(AND (NOT ICONTITLE)
|
||||
ICON))
|
||||
then
|
||||
(* ;;
|
||||
NIL)
|
||||
((OR [AND ICONTITLE (EQUAL ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W]
|
||||
(AND (NOT ICONTITLE)
|
||||
ICON))
|
||||
|
||||
(* ;;
|
||||
"we built this and the title is the same, or he has already put an icon on this. Do nothing")
|
||||
|
||||
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")
|
||||
NIL)
|
||||
(ICON
|
||||
(* ;; "There's an existing icon window; change the title in it")
|
||||
|
||||
(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 '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]
|
||||
(WINDOWPROP W 'ICON])
|
||||
|
||||
(\TEDIT.SHRINKFN
|
||||
@@ -1106,8 +1057,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.BUTTONEVENTFN
|
||||
[LAMBDA (PANE) (* ; "Edited 13-Feb-2025 11:53 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 11:33 by rmk")
|
||||
[LAMBDA (PANE) (* ; "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")
|
||||
@@ -1153,7 +1103,9 @@
|
||||
TEXTOBJ)
|
||||
(\TEDIT.BUTTONEVENTFN.INACTIVE TEXTOBJ
|
||||
PANE)
|
||||
(\TEDIT.PANE.SPLIT TEXTOBJ PANE))
|
||||
(\TEDIT.PANE.SPLIT TEXTOBJ PANE)
|
||||
(NOT (\TEDIT.XYTOSEL.INLINEP X Y PANE
|
||||
TEXTOBJ)))
|
||||
(RETURN))
|
||||
|
||||
(* ;; "")
|
||||
@@ -1180,7 +1132,6 @@
|
||||
(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")
|
||||
@@ -1995,8 +1946,7 @@
|
||||
PROMPTWINDOW])
|
||||
|
||||
(TEDIT.PROMPTPRINT
|
||||
[LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 29-Dec-2024 14:45 by rmk")
|
||||
(* ; "Edited 26-Nov-2023 10:10 by rmk")
|
||||
[LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "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")
|
||||
@@ -2006,31 +1956,29 @@
|
||||
|
||||
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM T))
|
||||
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
PWINDOW MAINWINDOW)
|
||||
(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]) (* ;
|
||||
(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)))
|
||||
else (PROMPTPRINT MSG])
|
||||
(FRESHLINE PROMPTWINDOW)
|
||||
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
|
||||
(printout PROMPTWINDOW MSG])
|
||||
|
||||
(TEDIT.PROMPTCLEAR
|
||||
[LAMBDA (TEXTSTREAM FONT) (* ; "Edited 14-Mar-98 12:52 by rmk:")
|
||||
@@ -2127,19 +2075,18 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.FILENAME
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 11:44 by rmk")
|
||||
(* ; "Edited 18-Oct-2023 00:02 by rmk")
|
||||
(\TEXTSTREAM.TITLE
|
||||
[LAMBDA (STREAM) (* ; "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 TSTREAM))
|
||||
(LET ((TEXTOBJ (TEXTOBJ STREAM))
|
||||
TXTFILE)
|
||||
(SETQ TXTFILE (FGETTOBJ TEXTOBJ TXTFILE))
|
||||
(OR (CL:TYPECASE TXTFILE
|
||||
(STRINGP TXTFILE)
|
||||
(STREAM (FULLNAME TXTFILE))
|
||||
(STREAM (fetch (STREAM FULLNAME) of TXTFILE))
|
||||
(LITATOM TXTFILE)
|
||||
(T TXTFILE))
|
||||
""])
|
||||
@@ -2213,9 +2160,8 @@
|
||||
(WINDOWPROP W 'TITLE TITLE))
|
||||
TITLE)))])
|
||||
|
||||
(\TEDIT.LIKELY.FILENAME
|
||||
[LAMBDA (TSTREAM UNFORMATTED?) (* ; "Edited 14-Mar-2025 11:46 by rmk")
|
||||
(* ; "Edited 18-Jan-2024 09:03 by rmk")
|
||||
(\TEXTSTREAM.FILENAME
|
||||
[LAMBDA (TEXTSTREAM UNFORMATTED?) (* ; "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")
|
||||
@@ -2226,14 +2172,14 @@
|
||||
|
||||
(* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed.")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(DEFAULTEXT (CL:IF UNFORMATTED?
|
||||
'TXT
|
||||
'TEDIT))
|
||||
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
EXT)
|
||||
(CL:WHEN (type? STREAM TXTFILE)
|
||||
(SETQ TXTFILE (fetch (STREAM FULLFILENAME) of TXTFILE))
|
||||
(SETQ TXTFILE (fetch FULLFILENAME of TXTFILE))
|
||||
[SETQ EXT (U-CASE (FILENAMEFIELD TXTFILE 'EXTENSION]
|
||||
(if (OR (NULL EXT)
|
||||
(EQ EXT 'BRAVO))
|
||||
@@ -2244,10 +2190,7 @@
|
||||
(PACKFILENAME 'EXTENSION EXT 'VERSION NIL 'BODY TXTFILE))])
|
||||
|
||||
(\TEDIT.UPDATE.TITLE
|
||||
[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")
|
||||
[LAMBDA (TEXTOBJ FILENAME) (* ; "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")
|
||||
@@ -2257,27 +2200,20 @@
|
||||
|
||||
(* ;; "find and set the title to reflect a new filename, and update the file fields of any attached menu too.")
|
||||
|
||||
(LET ((TITLE (\TEDIT.FILENAME TEXTOBJ))
|
||||
MENUSTREAM SETSTATEFN FIELD FIELDS)
|
||||
(LET ((TITLE (\TEXTSTREAM.TITLE TEXTOBJ))
|
||||
MENUSTREAM PC STATEFN)
|
||||
(\TEDIT.WINDOW.TITLE TEXTOBJ NIL (\TEDIT.DEFAULT.TITLE (OR FILENAME TITLE)))
|
||||
(SETQ MENUSTREAM (TEDIT.MENUSTREAM TEXTOBJ))
|
||||
(SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ))
|
||||
(CL:WHEN (AND MENUSTREAM (LITATOM TITLE)) (* ;
|
||||
"if we have a filename then put it in the GETFILE and PUTFILE fields of the menu")
|
||||
"if we have a filename then put it in the GET and PUT fields of the menu")
|
||||
(SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE))
|
||||
[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))])
|
||||
(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)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -2287,9 +2223,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.DEACTIVATE.WINDOW
|
||||
[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")
|
||||
[LAMBDA (PANE) (* ; "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")
|
||||
@@ -2306,7 +2240,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 (GETTSTR TSTREAM TEXTOBJ]
|
||||
(TEXTOBJ (AND TSTREAM (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM]
|
||||
(CL:UNLESS TEXTOBJ (* ;
|
||||
"Return NIL if not an editing window (rather than error?)")
|
||||
(RETURN))
|
||||
@@ -2321,7 +2255,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)
|
||||
@@ -2345,14 +2279,13 @@
|
||||
(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 MTEXTOBJ in (ATTACHEDWINDOWS PANE) when (AND (SETQ MTEXTOBJ (TEXTOBJ MENUW T))
|
||||
(FGETTOBJ MTEXTOBJ MENUFLG))
|
||||
(for MENUW in (ATTACHEDWINDOWS PANE) when (TEDITMENUP MENUW)
|
||||
do (* ; "Detach all the TEDITMENU windows.")
|
||||
(SETTOBJ MTEXTOBJ EDITFINISHEDFLG T) (* ;
|
||||
(SETTOBJ (TEXTOBJ MENUW)
|
||||
EDITFINISHEDFLG T) (* ;
|
||||
"Mark it finished so it closes itself")
|
||||
(WINDOWPROP MENUW 'TEDITMENU NIL) (* ;
|
||||
"And mark it no longer a menu window")
|
||||
@@ -2557,8 +2490,7 @@
|
||||
(\TEDIT.SCROLLCH.TOP TSTREAM PANE (FGETLD TOPLINE LCHARLAST])
|
||||
|
||||
(\TEDIT.SCROLLUP
|
||||
[LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Feb-2025 10:20 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 11:32 by rmk")
|
||||
[LAMBDA (TSTREAM PANE DY) (* ; "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")
|
||||
@@ -2628,7 +2560,7 @@
|
||||
|
||||
(\TEDIT.SETPANE.TOPLINE PANE NEWTOPLINE NEWPANEYBOT)
|
||||
(\TEDIT.SHIFTLINES (PANEPREFIX PANE)
|
||||
PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE NEWTOPLINE)
|
||||
NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE NEWTOPLINE)
|
||||
T)
|
||||
(\TEDIT.SETCARET (TEXTSEL TEXTOBJ)
|
||||
PANE TEXTOBJ 'ON])
|
||||
@@ -2663,8 +2595,7 @@
|
||||
(RETURN (IPLUS NEWBOT (FGETLD NEWTOPLINE LHEIGHT])
|
||||
|
||||
(\TEDIT.SCROLLDOWN
|
||||
[LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Feb-2025 10:20 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 20:46 by rmk")
|
||||
[LAMBDA (TSTREAM PANE DY) (* ; "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")
|
||||
@@ -2762,7 +2693,7 @@
|
||||
(* ;; "All needed lines have been constructed and linked, although there may still be some unneeded lines at the bottom. ")
|
||||
|
||||
(\TEDIT.SHIFTLINES (PANEPREFIX PANE)
|
||||
PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE OLDTOPLINE)
|
||||
NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE OLDTOPLINE)
|
||||
T)
|
||||
(\TEDIT.SETCARET (TEXTSEL TEXTOBJ)
|
||||
PANE TEXTOBJ 'ON])
|
||||
@@ -2937,8 +2868,7 @@
|
||||
TOPLINE])
|
||||
|
||||
(\TEDIT.SHIFTLINES
|
||||
[LAMBDA (PREVLINE PANE TEXTOBJ BITMAPLINES SCROLLING) (* ; "Edited 1-Feb-2025 10:22 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 11:54 by rmk")
|
||||
[LAMBDA (PREVLINE NEXTLINE PANE TEXTOBJ BITMAPLINES SCROLLING)
|
||||
(* ; "Edited 17-Dec-2024 23:40 by rmk")
|
||||
(* ; "Edited 3-Dec-2024 16:08 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 11:31 by rmk")
|
||||
@@ -2950,14 +2880,15 @@
|
||||
|
||||
(* ;; "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* ((NEXTLINE (FGETLD PREVLINE NEXTLINE))
|
||||
(VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT))
|
||||
then [LET* ((VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT))
|
||||
(PBOTTOM (PANEBOTTOM PANE))
|
||||
(BMTOPL (CAR BITMAPLINES))
|
||||
(BMTOPY (FGETLD BMTOPL YTOP))
|
||||
@@ -3055,7 +2986,7 @@
|
||||
(\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ)
|
||||
(SETQ LASTVISIBLE (\TEDIT.LINES.BELOW PREVLINE PANE TEXTOBJ))
|
||||
(\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE)
|
||||
(\TEDIT.FIXSEL NIL TEXTOBJ NIL PANE))
|
||||
(\TEDIT.FIXSEL SEL 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.")
|
||||
@@ -3523,12 +3454,7 @@
|
||||
(UPDATE/MENU/IMAGE MENU])
|
||||
|
||||
(TEDIT.DEFAULT.MENUFN
|
||||
[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")
|
||||
[LAMBDA (PANE) (* ; "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")
|
||||
@@ -3554,7 +3480,7 @@
|
||||
THISMENU ITEM)
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ EDITOPACTIVE)
|
||||
|
||||
(* ;; "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?")
|
||||
(* ;; "We're busy doing something, tell him to wait")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (CL:IF (EQ T (FGETTOBJ TEXTOBJ EDITOPACTIVE))
|
||||
"Edit"
|
||||
@@ -3562,14 +3488,15 @@
|
||||
" operation in progress; please wait")
|
||||
T)
|
||||
(RETURN NIL))
|
||||
(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)))
|
||||
(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))
|
||||
(ERSETQ (RESETLST
|
||||
[SELECTQ ITEM
|
||||
[SELECTQ (CAR ITEM)
|
||||
((Put |Put Formatted Document|)
|
||||
(TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT)))
|
||||
(Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T))
|
||||
@@ -3588,7 +3515,7 @@
|
||||
(TEDIT.SUBSTITUTE TEXTOBJ)))
|
||||
(Find (* ;
|
||||
"Case sensitive search, with * and # wildcards")
|
||||
(\TEDIT.KEY.FIND TSTREAM))
|
||||
(\TEDIT.KEY.FIND TSTREAM TEXTOBJ))
|
||||
(Looks (* ;
|
||||
"He wants to set the font for the current selection")
|
||||
(\TEDIT.LOOKS TEXTOBJ))
|
||||
@@ -3596,22 +3523,24 @@
|
||||
(TEDIT.HARDCOPY TEXTOBJ))
|
||||
(Expanded% Menu (* ;
|
||||
"Open the expanded operations menu.")
|
||||
(\TEDIT.EXPANDEDMENU.START TEXTOBJ))
|
||||
(\TEDIT.EXPANDED.MENU TEXTOBJ))
|
||||
(Character% Looks (* ;
|
||||
"Open the menu for setting character looks")
|
||||
(\TEDIT.CHARMENU.START TEXTOBJ))
|
||||
(\TEDIT.EXPANDEDCHAR.MENU TEXTOBJ))
|
||||
(Paragraph% Formatting (* ;
|
||||
"Open the paragraph formatting menu")
|
||||
(\TEDIT.PARAMENU.START TEXTOBJ))
|
||||
(\TEDIT.EXPANDEDPARA.MENU TEXTOBJ))
|
||||
(Page% Layout (* ; "Open the page-layout menu")
|
||||
(\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
|
||||
TSTREAM "Page Layout Menu" 150 'PAGE))
|
||||
(Buttons (TEDIT.BUTTONS.BUILD))
|
||||
(CL:WHEN ITEM (* ;
|
||||
(\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T
|
||||
)
|
||||
(\TEDIT.PRIMARYPANE TEXTOBJ)
|
||||
"Page Layout Menu" 150 'PAGE))
|
||||
(CL:WHEN (CAR ITEM) (* ;
|
||||
"Apply a user-supplied function to the text stream")
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ T)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(APPLY* ITEM (TEXTSTREAM PANE)))])])
|
||||
(APPLY* (CAR ITEM)
|
||||
(fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))])])
|
||||
|
||||
(TEDIT.REMOVE.MENUITEM
|
||||
[LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06")
|
||||
@@ -3680,12 +3609,11 @@
|
||||
(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 (Buttons 'Buttons "Display action buttons")
|
||||
Quit
|
||||
(Expanded% Menu 'Expanded% Menu NIL (SUBITEMS Expanded% Menu
|
||||
Character% Looks
|
||||
Paragraph% Formatting
|
||||
Page% Layout])
|
||||
Include Find Looks Substitute Quit (Expanded% Menu 'Expanded% Menu NIL
|
||||
(SUBITEMS Expanded% Menu
|
||||
Character% Looks
|
||||
Paragraph% Formatting
|
||||
Page% Layout])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -3716,38 +3644,37 @@
|
||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
||||
TEDIT.ICON.TITLE.REGION))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (18657 19553 (TEDIT.DEFER.UPDATES 18667 . 19551)) (19554 45257 (\TEDIT.WINDOW.CREATE
|
||||
19564 . 26176) (\TEDIT.WINDOW.GETREGION 26178 . 28940) (\TEDIT.WINDOW.SETUP 28942 . 33055) (
|
||||
\TEDIT.MINIMAL.WINDOW.SETUP 33057 . 41259) (\TEDIT.CLEARPANE 41261 . 41978) (\TEDIT.FILL.PANES 41980
|
||||
. 45255)) (45258 68165 (\TEDIT.CURSORMOVEDFN 45268 . 50141) (\TEDIT.CURSOROUTFN 50143 . 50588) (
|
||||
\TEDIT.ACTIVE.WINDOWP 50590 . 51641) (\TEDIT.EXPANDFN 51643 . 52206) (\TEDIT.MAINW 52208 . 53488) (
|
||||
\TEDIT.MAINSTREAM 53490 . 53757) (\TEDIT.PRIMARYPANE 53759 . 54529) (\TEDIT.PANELIST 54531 . 55027) (
|
||||
\TEDIT.NEWREGIONFN 55029 . 57545) (\TEDIT.SET.WINDOW.EXTENT 57547 . 62801) (\TEDIT.SHRINK.ICONCREATE
|
||||
62803 . 65536) (\TEDIT.SHRINKFN 65538 . 65947) (\TEDIT.PANEREGION 65949 . 68163)) (68197 99661 (
|
||||
\TEDIT.BUTTONEVENTFN 68207 . 80769) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80771 . 87494) (
|
||||
\TEDIT.BUTTONEVENTFN.GETOPERATION 87496 . 89338) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89340 . 92577) (
|
||||
\TEDIT.BUTTONEVENTFN.INACTIVE 92579 . 94921) (\TEDIT.BUTTONEVENTFN.INTITLE 94923 . 96758) (
|
||||
\TEDIT.COPYINSERTFN 96760 . 97892) (\TEDIT.FOREIGN.COPY 97894 . 99659)) (99662 116771 (
|
||||
\TEDIT.PANE.SPLIT 99672 . 104151) (\TEDIT.SPLITW 104153 . 111612) (\TEDIT.UNSPLITW 111614 . 115428) (
|
||||
\TEDIT.LINKPANES 115430 . 116193) (\TEDIT.UNLINKPANE 116195 . 116769)) (118128 119019 (TEDITWINDOWP
|
||||
118138 . 119017)) (119056 122159 (TEDIT.GETINPUT 119066 . 121509) (\TEDIT.MAKEFILENAME 121511 . 122157
|
||||
)) (122208 130509 (TEDIT.PROMPTWINDOW 122218 . 122532) (TEDIT.PROMPTPRINT 122534 . 125161) (
|
||||
TEDIT.PROMPTCLEAR 125163 . 126882) (TEDIT.PROMPTFLASH 126884 . 128816) (\TEDIT.PROMPT.PAGEFULLFN
|
||||
128818 . 130507)) (130747 140388 (\TEDIT.FILENAME 130757 . 131529) (\TEDIT.DEFAULT.TITLE 131531 .
|
||||
133910) (\TEDIT.WINDOW.TITLE 133912 . 136081) (\TEDIT.LIKELY.FILENAME 136083 . 137870) (
|
||||
\TEDIT.UPDATE.TITLE 137872 . 140386)) (140431 148959 (TEDIT.DEACTIVATE.WINDOW 140441 . 146559) (
|
||||
\TEDIT.RESHAPEFN 146561 . 148731) (\TEDIT.REPAINTFN 148733 . 148957)) (148960 191339 (\TEDIT.SCROLLFN
|
||||
148970 . 151215) (\TEDIT.SCROLLCH.TOP 151217 . 153328) (\TEDIT.SCROLLCH.BOTTOM 153330 . 157660) (
|
||||
\TEDIT.SCROLLUP 157662 . 163279) (\TEDIT.TOPLINE.YTOP 163281 . 164950) (\TEDIT.SCROLLDOWN 164952 .
|
||||
171882) (\TEDIT.SCROLL.CARET 171884 . 174722) (\TEDIT.VISIBLECARETP 174724 . 177018) (
|
||||
\TEDIT.VISIBLECHARP 177020 . 178111) (\TEDIT.BITMAPLINES 178113 . 182033) (\TEDIT.SETPANE.TOPLINE
|
||||
182035 . 182826) (\TEDIT.SHIFTLINES 182828 . 191337)) (191340 202209 (\TEDIT.ONSCREEN? 191350 . 195901
|
||||
) (\TEDIT.ONSCREEN.REGION 195903 . 199554) (\TEDIT.AFTERMOVEFN 199556 . 200453) (OFFSCREENP 200455 .
|
||||
202207)) (202251 204868 (\TEDIT.PROCIDLEFN 202261 . 203798) (\TEDIT.PROCENTRYFN 203800 . 204245) (
|
||||
\TEDIT.PROCEXITFN 204247 . 204866)) (204947 218101 (\TEDIT.DOWNCARET 204957 . 205750) (
|
||||
\TEDIT.FLASHCARET 205752 . 207863) (\TEDIT.UPCARET 207865 . 208969) (TEDIT.NORMALIZECARET 208971 .
|
||||
212189) (\TEDIT.SETCARET 212191 . 217471) (\TEDIT.CARET 217473 . 218099)) (218135 230462 (
|
||||
TEDIT.ADD.MENUITEM 218145 . 220436) (TEDIT.DEFAULT.MENUFN 220438 . 227674) (TEDIT.REMOVE.MENUITEM
|
||||
227676 . 228673) (\TEDIT.CREATEMENU 228675 . 229240) (\TEDIT.MENU.WHENHELDFN 229242 . 230147) (
|
||||
\TEDIT.MENU.WHENSELECTEDFN 230149 . 230460)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Mar-2025 00:20:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;208 53292
|
||||
(FILECREATED "14-Dec-2024 11:45:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196 52876
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-2025 12:22:24" {WMEDLEY}<library>TEDIT>tedit-exports.all;207)
|
||||
:PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}<library>TEDIT>tedit-exports.all;195)
|
||||
|
||||
|
||||
(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 "16-Mar-2025 00:16:31"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 21:39:48"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -44,7 +44,8 @@ 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 \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE)) PC)))
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ)) 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)
|
||||
@@ -52,7 +53,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 " 8-Feb-2025 20:56:54"))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:12:27"))
|
||||
(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)).") (* ;;
|
||||
@@ -118,7 +119,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 "15-Mar-2025 22:39:40"))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 6-Dec-2024 12:50:42"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
@@ -148,8 +149,8 @@ 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.") LPARALOOKS
|
||||
(* ; "The paragraph looks for this line's paragraph (eventually)") (NIL FLAG) (* ;
|
||||
) 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) (* ;
|
||||
"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)"
|
||||
@@ -261,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 " 6-Mar-2025 11:42:48"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:31"))
|
||||
(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)."
|
||||
@@ -269,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.") PCHARLOOKS (* ; "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.") PLOOKS (* ; "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) (
|
||||
@@ -279,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))) (
|
||||
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)
|
||||
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)
|
||||
(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"
|
||||
) SUFFIXPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
) LASTPIECE (* ; "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# (* ;
|
||||
@@ -301,11 +302,10 @@ 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") 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 (* ;
|
||||
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 (* ;
|
||||
"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 +315,7 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"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") DEFAULTPARALOOKS (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ;
|
||||
"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 +340,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 PARALOOKS in the document, so they can be kept unique") (
|
||||
TXTPARALOOKSLIST (* ; "List of all the FMTSPECs 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,11 +349,10 @@ 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) (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)))
|
||||
(\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)))
|
||||
(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)
|
||||
@@ -363,10 +362,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)) (* ;
|
||||
"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)) (* ;
|
||||
"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)) (* ;
|
||||
"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
|
||||
@@ -378,8 +377,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 PCHARLOOKS) of PC)))
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (PLOOKS 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)))
|
||||
@@ -445,7 +444,25 @@ 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 "19-Feb-2025 13:39:40"))
|
||||
(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))
|
||||
(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))
|
||||
@@ -454,20 +471,28 @@ THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTY
|
||||
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)))))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 23:21:12"))
|
||||
(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"))
|
||||
(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 "14-Mar-2025 15:29:22"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:09:40"))
|
||||
(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"))
|
||||
(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") CLFONTUNPARSE (* ;;
|
||||
"The font descriptor for these characters") CLNAME (* ;;
|
||||
"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."
|
||||
) 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) (* ;
|
||||
) 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) (* ;
|
||||
"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 (* ;
|
||||
@@ -487,10 +512,8 @@ LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
) (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))) (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.")
|
||||
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
|
||||
(DATATYPE FMTSPEC ((* ;; "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 (* ;
|
||||
@@ -498,8 +521,8 @@ NEWVALUE))))
|
||||
"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.)"
|
||||
@@ -523,33 +546,25 @@ 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 PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
|
||||
LINELEAD _ 0)
|
||||
DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _
|
||||
0)
|
||||
(DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
|
||||
(DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))
|
||||
(DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.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))))
|
||||
(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 "21-Feb-2025 09:49:05"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:31:28"))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46"))
|
||||
(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
|
||||
@@ -591,8 +606,6 @@ 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
|
||||
@@ -605,8 +618,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 "15-Mar-2025 00:33:15"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "14-Mar-2025 15:29:51"))
|
||||
(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"))
|
||||
(RPAQQ PTSPERPICA 12)
|
||||
(RPAQQ PTSPERINCH 72)
|
||||
(RPAQQ PICASPERINCH 6)
|
||||
@@ -617,15 +630,10 @@ $$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 "15-Mar-2025 23:41:25"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 00:35:11"))
|
||||
(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 "16-Mar-2025 00:03:34"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:34:37"))
|
||||
(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"))
|
||||
(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 (* ;
|
||||
@@ -639,7 +647,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 "15-Mar-2025 22:42:11"))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 19:41:55"))
|
||||
(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."
|
||||
@@ -670,9 +678,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 "23-Feb-2025 10:06:16"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "11-Mar-2025 23:30:40"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:18:40"))
|
||||
(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"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jan-2025 11:00:54" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;263 131893
|
||||
(FILECREATED " 1-May-2024 14:53:20" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;260 131326
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
:CHANGES-TO (FNS COMPAREDIRECTORIES)
|
||||
|
||||
:PREVIOUS-DATE "23-Dec-2024 23:54:13" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;262)
|
||||
:PREVIOUS-DATE "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -15,8 +15,6 @@
|
||||
[
|
||||
(* ;; "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)
|
||||
@@ -61,9 +59,6 @@
|
||||
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(DEFINEQ
|
||||
|
||||
(COMPAREDIRECTORIES
|
||||
@@ -1960,8 +1955,6 @@
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "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.")
|
||||
@@ -1975,64 +1968,52 @@
|
||||
(* ; "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 (if (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
else (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 (if (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (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)
|
||||
(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 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)))
|
||||
(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)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
|
||||
@@ -2221,25 +2202,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2622 22985 (COMPAREDIRECTORIES 2632 . 7967) (COMPAREDIRECTORIES.INFOS 7969 . 10927) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10929 . 14314) (CDENTRIES.SELECT 14316 . 19091) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19093 . 20219) (MATCHNAME 20221 . 20901) (CD.INSURECDVALUE 20903 . 22517
|
||||
) (CD.UPDATEWIDTHS 22519 . 22983)) (22986 33608 (CDFILES 22996 . 29010) (CDFILES.MATCH 29012 . 30637)
|
||||
(CDFILES.PATS 30639 . 33606)) (33609 51430 (CDPRINT 33619 . 36136) (CDPRINT.HEADER 36138 . 37035) (
|
||||
CDPRINT.LINE 37037 . 40269) (CDPRINT.MAXWIDTHS 40271 . 44386) (CDPRINT.COLHEADERS 44388 . 45673) (
|
||||
CDPRINT.COLUMNS 45675 . 50795) (CDTEDIT 50797 . 51428)) (51431 60552 (CDMAP 51441 . 52873) (CDENTRY
|
||||
52875 . 53184) (CDSUBSET 53186 . 54625) (CDMERGE 54627 . 58611) (CDMERGE.COMMON 58613 . 59928) (
|
||||
CD.SORT 59930 . 60550)) (60553 68091 (BINCOMP 60563 . 64852) (EOLTYPE 64854 . 67416) (EOLTYPE.SHOW
|
||||
67418 . 68089)) (68619 81146 (FIND-UNCOMPILED-FILES 68629 . 72272) (FIND-UNSOURCED-FILES 72274 . 74658
|
||||
) (FIND-SOURCE-FILES 74660 . 76398) (FIND-COMPILED-FILES 76400 . 78277) (FIND-UNLOADED-FILES 78279 .
|
||||
79132) (FIND-LOADED-FILES 79134 . 79562) (FIND-MULTICOMPILED-FILES 79564 . 81144)) (81147 89578 (
|
||||
CREATED-AS 81157 . 85954) (SOURCE-FOR-COMPILED-P 85956 . 88883) (COMPILE-SOURCE-DATE-DIFF 88885 .
|
||||
89576)) (89579 100342 (FIX-DIRECTORY-DATES 89589 . 93039) (FIX-EQUIV-DATES 93041 . 94566) (
|
||||
COPY-COMPARED-FILES 94568 . 96389) (COPY-MISSING-FILES 96391 . 98548) (COMPILED-ON-SAME-SOURCE 98550
|
||||
. 100340)) (100536 108374 (CDBROWSER 100546 . 104473) (CDBROWSER.STRINGS 104475 . 108372)) (108536
|
||||
110272 (CD.TABLEITEM 108546 . 108766) (CD.TABLEITEM.PRINTFN 108768 . 108967) (CD.TABLEITEM.COPYFN
|
||||
108969 . 110027) (CDTABLEBROWSER.HEADING.REPAINTFN 110029 . 110270)) (110273 131399 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 110283 . 110751) (CD.COMMANDSELECTEDFN 110753 . 115854) (CD-MENUFN
|
||||
115856 . 120638) (CD-COMPARE-FILES 120640 . 123992) (CDBROWSER-COPY 123994 . 127663) (
|
||||
CDBROWSER-DELETE-FILE 127665 . 130878) (CD-SWAPDIRS 130880 . 131397)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-May-2024 13:19:49" {WMEDLEY}<lispusers>DINFO.;14 65819
|
||||
(FILECREATED "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13 65523
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM DINFO.UPDATE.TEXT.DISPLAY)
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
|
||||
|
||||
:PREVIOUS-DATE "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13)
|
||||
:PREVIOUS-DATE "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DINFOCOMS)
|
||||
@@ -988,18 +988,17 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.TEXT.DISPLAY
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 25-May-2024 13:16 by rmk")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 3-Feb-2022 11:50 by rmk")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(LET ((WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(FILENAME (DINFO.GET.FILENAME GRAPH NODE))
|
||||
(FROM (fetch (DINFONODE FROMBYTE) of NODE))
|
||||
(TO (fetch (DINFONODE TOBYTE) of NODE))
|
||||
(PROPS (APPEND (LIST 'READONLY 'QUIET 'NOTITLE T 'TITLEMENUFN (FUNCTION DINFO.TITLEMENUFN))
|
||||
(PROPS (APPEND (LIST 'READONLY T 'NOTITLE T 'TITLEMENUFN 'DINFO.TITLEMENUFN)
|
||||
(fetch (DINFOGRAPH TEXTPROPS) of GRAPH)))
|
||||
(OLD.TEXTSTREAM (WINDOWPROP (fetch (DINFOGRAPH WINDOW) of GRAPH)
|
||||
'TEXTSTREAM))
|
||||
TEXTSTREAM FULLFILENAME) (* ; "Default directory and host.")
|
||||
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
|
||||
(if (OR OFF? (NULL FILENAME))
|
||||
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
|
||||
WINDOW NIL NIL PROPS)
|
||||
@@ -1037,8 +1036,7 @@
|
||||
(PROMPTPRINT "DInfo is busy"])
|
||||
|
||||
(DINFO.OPENTEXTSTREAM
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 25-May-2024 13:17 by rmk")
|
||||
(* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 15:37 by rmk")
|
||||
(* drc%: "25-Jan-86 18:24")
|
||||
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
|
||||
@@ -1055,8 +1053,7 @@
|
||||
(CLEARW T)
|
||||
(CLEARW WINDOW)
|
||||
[RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
|
||||
(PROG1 (TEDIT (OPENTEXTSTREAM FILE NIL FROM TO PROPS)
|
||||
WINDOW)
|
||||
(PROG1 (OPENTEXTSTREAM FILE WINDOW FROM TO PROPS)
|
||||
(replace (DINFOGRAPH LAST.TEXT) of (DINFOGRAPH WINDOW) with THIS.TEXT))])
|
||||
|
||||
(DINFO.SHOWSEL
|
||||
@@ -1113,21 +1110,21 @@
|
||||
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4582 6041 (DINFOGRAPHPROP 4582 . 6041)) (7295 24433 (DINFO 7305 . 8919) (DINFO.UPDATE
|
||||
8921 . 11785) (DINFOGRAPH 11787 . 12205) (DINFO.SPECIAL.UPDATE 12207 . 13905) (DINFO.READ.GRAPH 13907
|
||||
. 15762) (DINFO.WRITE.GRAPH 15764 . 16854) (DINFO.SELECT.GRAPH 16856 . 17763) (DINFO.DEFAULT.MENU
|
||||
17765 . 20289) (DINFO.FIND 20291 . 22877) (DINFO.LOOKUP 22879 . 24431)) (24434 27128 (
|
||||
DINFO.READ.KOTO.GRAPH 24444 . 27126)) (27129 29443 (DINFO.SETUP.WINDOW 27139 . 27820) (DINFO.CLOSEFN
|
||||
27822 . 28255) (DINFO.SHRINKFN 28257 . 28453) (DINFO.EXPANDFN 28455 . 29012) (DINFO.ICONFN 29014 .
|
||||
29441)) (29444 40766 (DINFO.ADD.FMENU 29454 . 30549) (DINFO.CREATE.FMENU 30551 . 34578) (
|
||||
DINFO.FMW.CLOSEFN 34580 . 35425) (DINFO.FMENU.HANDLER 35427 . 36066) (DINFO.UPDATE.FMENU 36068 . 38257
|
||||
) (DINFO.TOGGLE.MENU 38259 . 38849) (DINFO.TOGGLE.GRAPH 38851 . 39350) (DINFO.TOGGLE.HISTORY 39352 .
|
||||
39896) (DINFO.TOGGLE.TEXT 39898 . 40764)) (40767 48562 (DINFO.UPDATE.MENU.DISPLAY 40777 . 44898) (
|
||||
DINFO.UPDATE.FROM.MENU 44900 . 45199) (DINFO.UPDATE.HISTORY 45201 . 47731) (DINFO.HISTORIC.UPDATE
|
||||
47733 . 48560)) (48563 58892 (DINFO.UPDATE.GRAPH.DISPLAY 48573 . 50025) (DINFO.UPDATE.FROM.GRAPH 50027
|
||||
. 50503) (DINFO.GET.GRAPH.WINDOW 50505 . 51090) (DINFO.CREATE.GRAPH.WINDOW 51092 . 52209) (
|
||||
DINFO.SHOWGRAPH 52211 . 53936) (DINFO.INVERT.NODE 53938 . 55326) (DINFO.LAYOUTGRAPH 55328 . 58890)) (
|
||||
58893 65232 (DINFO.UPDATE.TEXT.DISPLAY 58903 . 60963) (DINFO.TITLEMENUFN 60965 . 62090) (
|
||||
DINFO.OPENTEXTSTREAM 62092 . 63592) (DINFO.SHOWSEL 63594 . 64327) (DINFO.GET.FILENAME 64329 . 65230)))
|
||||
(FILEMAP (NIL (4556 6015 (DINFOGRAPHPROP 4556 . 6015)) (7269 24407 (DINFO 7279 . 8893) (DINFO.UPDATE
|
||||
8895 . 11759) (DINFOGRAPH 11761 . 12179) (DINFO.SPECIAL.UPDATE 12181 . 13879) (DINFO.READ.GRAPH 13881
|
||||
. 15736) (DINFO.WRITE.GRAPH 15738 . 16828) (DINFO.SELECT.GRAPH 16830 . 17737) (DINFO.DEFAULT.MENU
|
||||
17739 . 20263) (DINFO.FIND 20265 . 22851) (DINFO.LOOKUP 22853 . 24405)) (24408 27102 (
|
||||
DINFO.READ.KOTO.GRAPH 24418 . 27100)) (27103 29417 (DINFO.SETUP.WINDOW 27113 . 27794) (DINFO.CLOSEFN
|
||||
27796 . 28229) (DINFO.SHRINKFN 28231 . 28427) (DINFO.EXPANDFN 28429 . 28986) (DINFO.ICONFN 28988 .
|
||||
29415)) (29418 40740 (DINFO.ADD.FMENU 29428 . 30523) (DINFO.CREATE.FMENU 30525 . 34552) (
|
||||
DINFO.FMW.CLOSEFN 34554 . 35399) (DINFO.FMENU.HANDLER 35401 . 36040) (DINFO.UPDATE.FMENU 36042 . 38231
|
||||
) (DINFO.TOGGLE.MENU 38233 . 38823) (DINFO.TOGGLE.GRAPH 38825 . 39324) (DINFO.TOGGLE.HISTORY 39326 .
|
||||
39870) (DINFO.TOGGLE.TEXT 39872 . 40738)) (40741 48536 (DINFO.UPDATE.MENU.DISPLAY 40751 . 44872) (
|
||||
DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINFO.HISTORIC.UPDATE
|
||||
47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
|
||||
. 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
|
||||
DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
|
||||
58867 64936 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
|
||||
DINFO.OPENTEXTSTREAM 61954 . 63296) (DINFO.SHOWSEL 63298 . 64031) (DINFO.GET.FILENAME 64033 . 64934)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
105
lispusers/DLIONFNKEYS
Normal file
105
lispusers/DLIONFNKEYS
Normal file
@@ -0,0 +1,105 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "29-Oct-87 18:18:54" {ERINYES}<LISPUSERS>LISPCORE>DLIONFNKEYS.;1 6304
|
||||
|
||||
changes to%: (FNS BUILDFNKEYS)
|
||||
|
||||
previous date%: "19-Nov-85 12:20:57" {ERINYES}<LISP>LYRIC>LISPUSERS>DLIONFNKEYS.;1)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DLIONFNKEYSCOMS)
|
||||
|
||||
(RPAQQ DLIONFNKEYSCOMS [(FILES KEYOBJ)
|
||||
(GLOBALVARS DLION.FN.KEYS DLION.FN.KEYLABELS KEYOBJ.TEMPLATE)
|
||||
[VARS (DLION.FN.KEYS '(CENTER BOLD ITALICS UNDERLINE SUPERSCRIPT SUBSCRIPT
|
||||
SMALLER DEFAULTS))
|
||||
(DLION.FN.KEYLABELS '(CENTER BOLD ITALICS (UNDER- LINE)
|
||||
(SUPER- SCRIPT)
|
||||
(SUB- SCRIPT)
|
||||
SMALLER DEFAULTS]
|
||||
(BITMAPS FNKEYICON)
|
||||
(FNS BUILDFNKEYS FNKEY.MENUFN)
|
||||
(INITVARS (FNKEY.MENU (create MENU ITEMS _ '((Close 'CLOSEW "Closes a window"
|
||||
)
|
||||
(Bury 'BURYW
|
||||
"Puts a window on the bottom."
|
||||
)
|
||||
(Move 'MOVEW
|
||||
"Moves a window by a corner."
|
||||
)
|
||||
(Shrink 'SHRINKW
|
||||
"Replaces this window with its icon"
|
||||
])
|
||||
(FILESLOAD KEYOBJ)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS DLION.FN.KEYS DLION.FN.KEYLABELS KEYOBJ.TEMPLATE)
|
||||
)
|
||||
|
||||
(RPAQQ DLION.FN.KEYS (CENTER BOLD ITALICS UNDERLINE SUPERSCRIPT SUBSCRIPT SMALLER DEFAULTS))
|
||||
|
||||
(RPAQQ DLION.FN.KEYLABELS (CENTER BOLD ITALICS (UNDER- LINE)
|
||||
(SUPER- SCRIPT)
|
||||
(SUB- SCRIPT)
|
||||
SMALLER DEFAULTS))
|
||||
|
||||
(RPAQQ FNKEYICON #*(80 50)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@@@@@@@@@@@@@@OOOH@@@@@@@@@@@@@@@@AOOH@@@@@@@@@@@@@@@@AONL@@@@@@@@@@@@@@@@BGOFCOOOOOOOOOOOOOOLDGNKF@@@@@@@@@@@@@@FHGMEH@@@@@@@@@@@@@@A@CNK@@@@@@@@@@@@@@@@HCMG@@@@@@@@@@@@@@@@LCNJ@@@@@@@@@@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@D@@@@@DCMF@CO@@@@@@DD@@@@@DCNJ@B@@@@@@@D@@@@@@DCMF@B@BABNALODGHKH@DCNJ@CNBACABBDDHDLD@DCMF@B@BABAB@DDHDHD@DCNJ@B@BABAB@DDHDHD@DCMF@B@BCBABBDDHDHD@DCNJ@B@AMBAALCDGHHD@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@@@@@@@DCMF@@@@BA@@@@@@@@@@DCNJ@@@@BB@@@@@@@@@@DCMF@@@@BD@NBBCH@@@@DCNJ@@@@BHAABBDD@@@@DCMF@@@@CDAOADCH@@@@DCNJ@@@@BBA@AD@D@@@@DCMF@@@@BAAA@HDD@@@@DCNJ@@@@B@HN@HCH@@@@DCMF@@@@@@@@@H@@@@@@DCNJ@@@@@@@@C@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNK@@@@@@@@@@@@@@@@LCME@@@@@@@@@@@@@@@@HCNKH@@@@@@@@@@@@@@A@COBN@@@@@@@@@@@@@@GHGNDKOOOOOOOOOOOOOONLGOIAEEEEEEEEEEEEEEEFGOBBJJJJJJJJJJJJJJJKOOLEEEEEEEEEEEEEEEEEOONBJJJJJJJJJJJJJJJOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(BUILDFNKEYS
|
||||
[LAMBDA NIL (* ; "Edited 29-Oct-87 18:14 by jds")
|
||||
|
||||
(PROG ((TXT (OPENTEXTSTREAM NIL NIL NIL NIL))
|
||||
(WIDTH (FIX (TIMES (BITMAPWIDTH KEYOBJ.TEMPLATE)
|
||||
8.3)))
|
||||
W)
|
||||
(TEDIT.INSERT TXT (CHARACTER (CHARCODE EOL))
|
||||
1)
|
||||
(for KEY in DLION.FN.KEYS as LABEL in DLION.FN.KEYLABELS
|
||||
do (TEDIT.INSERT.OBJECT (KEYOBJ.CREATE KEY LABEL T)
|
||||
TXT)) (* ;
|
||||
"this will create abortable key objects (if you slide out of the region, no transitions are sent)")
|
||||
|
||||
(TEDIT.SETSEL TXT 2 0 'LEFT)
|
||||
(TEDIT.PARALOOKS TXT '(QUAD CENTERED)) (* ;
|
||||
"(TEDIT.NORMALIZECARET TXT (TEDIT.SETSEL TXT 0 0 (QUOTE LEFT)))")
|
||||
|
||||
(SETQ W (CREATEW (CREATEREGION (IQUOTIENT (IDIFFERENCE (BITMAPWIDTH (SCREENBITMAP))
|
||||
WIDTH)
|
||||
2)
|
||||
5 WIDTH (IPLUS (FONTPROP MENUFONT 'HEIGHT)
|
||||
(BITMAPHEIGHT KEYOBJ.TEMPLATE)
|
||||
10))
|
||||
"Dandelion function keys" 2))
|
||||
(SCROLLW W 0 -5) (* ;
|
||||
"used to have NOTITLE T in the props")
|
||||
(* ;
|
||||
"TEDIT TXT W NIL (QUOTE (LEAVETTY T PROMPTWINDOW DON'T))")
|
||||
|
||||
(OPENTEXTSTREAM TXT W NIL NIL '(READONLY T))
|
||||
(WINDOWPROP W 'WINDOWENTRYFN 'NIL) (* ;
|
||||
"(WINDOWPROP W (QUOTE TITLE) (QUOTE NIL))")
|
||||
|
||||
(WINDOWPROP W 'ICON FNKEYICON)
|
||||
(WINDOWPROP W 'RIGHTBUTTONFN 'FNKEY.MENUFN)
|
||||
(SETQ DLIONFNKEYS W])
|
||||
|
||||
(FNKEY.MENUFN
|
||||
[LAMBDA (KEYWINDOW) (* gbn "28-Jan-85 01:17")
|
||||
(PROG ((ITEM (MENU FNKEY.MENU)))
|
||||
(COND
|
||||
(ITEM (APPLY* ITEM KEYWINDOW])
|
||||
)
|
||||
|
||||
(RPAQ? FNKEY.MENU [create MENU ITEMS _ '((Close 'CLOSEW "Closes a window")
|
||||
(Bury 'BURYW "Puts a window on the bottom.")
|
||||
(Move 'MOVEW "Moves a window by a corner.")
|
||||
(Shrink 'SHRINKW "Replaces this window with its icon"])
|
||||
(PUTPROPS DLIONFNKEYS COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3544 5868 (BUILDFNKEYS 3554 . 5655) (FNKEY.MENUFN 5657 . 5866)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1,13 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2025 12:28:41" {DSK}<home>matt>Interlisp>medley>lispusers>EDITFONT.;2 28339
|
||||
(FILECREATED "12-Jul-2022 14:18:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EDITFONT.;10 28741
|
||||
|
||||
:EDIT-BY "mth"
|
||||
:CHANGES-TO (FNS READSTRIKEFONTFILE)
|
||||
(VARS EDITFONTCOMS)
|
||||
|
||||
:CHANGES-TO (VARS EDITFONTCOMS)
|
||||
:PREVIOUS-DATE "27-Jun-2022 10:59:12"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>EDITFONT.;5)
|
||||
|
||||
:PREVIOUS-DATE "12-Jul-2022 14:18:56" {DSK}<home>matt>Interlisp>medley>lispusers>EDITFONT.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1986 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT EDITFONTCOMS)
|
||||
|
||||
@@ -21,7 +26,9 @@
|
||||
COPYFONT READSTRIKEFONTFILE)
|
||||
(FNS BLANKFONTCREATE EDITFONT)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (BITSPERWORD 16)
|
||||
(BYTESPERWORD 2))
|
||||
(BYTESPERWORD 2)
|
||||
(MAXCODE 255)
|
||||
(DUMMYINDEX 256))
|
||||
(FILES (LOADCOMP)
|
||||
FONT))
|
||||
(P (EF.INIT))))
|
||||
@@ -520,9 +527,15 @@
|
||||
|
||||
(RPAQQ BYTESPERWORD 2)
|
||||
|
||||
(RPAQQ MAXCODE 255)
|
||||
|
||||
(RPAQQ DUMMYINDEX 256)
|
||||
|
||||
|
||||
(CONSTANTS (BITSPERWORD 16)
|
||||
(BYTESPERWORD 2))
|
||||
(BYTESPERWORD 2)
|
||||
(MAXCODE 255)
|
||||
(DUMMYINDEX 256))
|
||||
)
|
||||
|
||||
|
||||
@@ -531,11 +544,12 @@
|
||||
)
|
||||
|
||||
(EF.INIT)
|
||||
(PUTPROPS EDITFONT COPYRIGHT ("Xerox Corporation" 1985 1986))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1325 25875 (EF.INIT 1335 . 2061) (EF.PROMPT 2063 . 2645) (EF.MESSAGE 2647 . 2859) (
|
||||
EF.CLOSEFN 2861 . 3388) (EF.CHARITEMS 3390 . 5611) (EF.BUTTONEVENTFN 5613 . 6025) (EF.WHENSELECTEDFN
|
||||
6027 . 6431) (EF.EDITBM 6433 . 7831) (EF.MIDDLEBUTTONFN 7833 . 8078) (EF.CHANGESIZE 8080 . 9299) (
|
||||
EF.DELETE 9301 . 10066) (EF.ENTER 10068 . 10899) (EF.REPLACE 10901 . 11764) (EF.SAVE 11766 . 16439) (
|
||||
EF.BLANK 16441 . 22066) (COPYFONT 22068 . 24508) (READSTRIKEFONTFILE 24510 . 25873)) (25876 28090 (
|
||||
BLANKFONTCREATE 25886 . 26143) (EDITFONT 26145 . 28088)))))
|
||||
(FILEMAP (NIL (1567 26117 (EF.INIT 1577 . 2303) (EF.PROMPT 2305 . 2887) (EF.MESSAGE 2889 . 3101) (
|
||||
EF.CLOSEFN 3103 . 3630) (EF.CHARITEMS 3632 . 5853) (EF.BUTTONEVENTFN 5855 . 6267) (EF.WHENSELECTEDFN
|
||||
6269 . 6673) (EF.EDITBM 6675 . 8073) (EF.MIDDLEBUTTONFN 8075 . 8320) (EF.CHANGESIZE 8322 . 9541) (
|
||||
EF.DELETE 9543 . 10308) (EF.ENTER 10310 . 11141) (EF.REPLACE 11143 . 12006) (EF.SAVE 12008 . 16681) (
|
||||
EF.BLANK 16683 . 22308) (COPYFONT 22310 . 24750) (READSTRIKEFONTFILE 24752 . 26115)) (26118 28332 (
|
||||
BLANKFONTCREATE 26128 . 26385) (EDITFONT 26387 . 28330)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,33 +1,29 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jan-2025 22:00:44" {WMEDLEY}<lispusers>EXAMINEDEFS.;54 16352
|
||||
(FILECREATED "13-Oct-2023 11:18:04" {WMEDLEY}<lispusers>EXAMINEDEFS.;48 14244
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS EXVV EXV)
|
||||
(COMMANDS exv)
|
||||
(VARS EXAMINEDEFSCOMS)
|
||||
:CHANGES-TO (FNS EXAMINEDEFS TEDITDEF)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:09:08" {WMEDLEY}<lispusers>EXAMINEDEFS.;53)
|
||||
:PREVIOUS-DATE "19-Jul-2023 13:59:26" {WMEDLEY}<lispusers>EXAMINEDEFS.;44)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF EXVV)
|
||||
(COMMANDS exv)
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF)
|
||||
(INITVARS (EXAMINEDEFS-PROCESS-LIST)
|
||||
(EXAMINEWITH 'COMPARETEXT))
|
||||
(FILES (SYSLOAD)
|
||||
COMPARETEXT VERSIONDEFS)))
|
||||
COMPARETEXT)))
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 6-Dec-2024 20:51 by rmk")
|
||||
(* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
(* ; "Edited 18-May-2023 22:35 by rmk")
|
||||
(* ; "Edited 21-Apr-2023 14:42 by rmk")
|
||||
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given, the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintion, NIL is the existing in-memory definition")
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintions, NIL is the existing in-memory definition")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -235,49 +231,15 @@
|
||||
(PRIN3 ")" TSTREAM)
|
||||
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
|
||||
TSTREAM])
|
||||
|
||||
(EXVV
|
||||
[LAMBDA (NAME TYPE FILE VERSION1 VERSION2) (* ; "Edited 20-Jan-2025 21:56 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 15:09 by rmk")
|
||||
|
||||
(* ;; "Compares the definitions of NAME as TYPE on 2 different versions of FILE. TYPE and FILE can be elided, defaulting to NIL and WHEREIS respectively. Versions default to newest.")
|
||||
|
||||
(* ;; "If only one version specification, compares with the current (like the EXV command)")
|
||||
|
||||
(* ;; "(EXVV 'FOO -1 -2) will compare the newest and second-newest function definitions of FOO.")
|
||||
|
||||
(CL:UNLESS (AND (VERSIONP VERSION1)
|
||||
(VERSIONP VERSION2)) (* ; "Both versions, arguments are good")
|
||||
(if (VERSIONP TYPE)
|
||||
then (SETQ VERSION1 TYPE) (* ; "TYPE and FILE are NIL")
|
||||
(SETQ TYPE NIL)
|
||||
(CL:WHEN (VERSIONP FILE)
|
||||
(SETQ VERSION2 FILE)
|
||||
(SETQ FILE NIL))
|
||||
elseif (VERSIONP FILE)
|
||||
then (CL:WHEN (VERSIONP VERSION1) (* ; "Type is good, FILE is NIL")
|
||||
(SETQ VERSION2 VERSION1))
|
||||
(SETQ VERSION1 FILE)
|
||||
(SETQ FILE NIL)))
|
||||
(CL:UNLESS FILE
|
||||
(SETQ FILE (OR (CAR (WHEREIS NAME (OR TYPE '(FNS FUNCTIONS))
|
||||
T))
|
||||
(ERROR "Can't find " FILE " definition of " NAME))))
|
||||
(if (AND VERSION1 VERSION2)
|
||||
then (EXAMINEDEFS NAME TYPE (FINDFILEVERSION FILE VERSION1)
|
||||
(FINDFILEVERSION FILE VERSION2))
|
||||
else (EXAMINEDEFS NAME TYPE NIL (FINDFILEVERSION FILE (OR VERSION1 VERSION2 -1])
|
||||
)
|
||||
|
||||
(DEFCOMMAND exv (NAME TYPE FILE VERSION) (EXVV NAME TYPE FILE VERSION))
|
||||
|
||||
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
|
||||
|
||||
(RPAQ? EXAMINEWITH 'COMPARETEXT)
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT VERSIONDEFS)
|
||||
COMPARETEXT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (736 16121 (EXAMINEDEFS 746 . 10675) (EXAMINEFILES 10677 . 12159) (TEDITDEF 12161 .
|
||||
14327) (EXVV 14329 . 16119)))))
|
||||
(FILEMAP (NIL (618 14102 (EXAMINEDEFS 628 . 10448) (EXAMINEFILES 10450 . 11932) (TEDITDEF 11934 .
|
||||
14100)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,28 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "29-Apr-87 22:43:49" {ERIS}<LISPUSERS>LYRIC>FONTSAMPLER.;4 7992
|
||||
|
||||
(FILECREATED " 5-Feb-2025 17:03:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;11 9743
|
||||
changes to%: (FNS FontSample)
|
||||
|
||||
:EDIT-BY "mth"
|
||||
previous date%: "29-Apr-87 22:41:24" {ERIS}<LISPUSERS>KOTO>FONTSAMPLER.;6)
|
||||
|
||||
:CHANGES-TO (FNS FontSample FontTable)
|
||||
|
||||
:PREVIOUS-DATE " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10
|
||||
)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTSAMPLERCOMS)
|
||||
|
||||
(RPAQQ FONTSAMPLERCOMS
|
||||
((FNS FontSample FontSampleFaked FontTable)
|
||||
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
FONT))))
|
||||
(RPAQQ FONTSAMPLERCOMS ((FNS FontSample FontSampleFaked FontTable)
|
||||
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
FONT))))
|
||||
(DEFINEQ
|
||||
|
||||
(FontSample
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal)
|
||||
(* ; "Edited 5-Feb-2025 17:02 by mth")
|
||||
(* edited%: "29-Apr-87 22:03")
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
|
||||
(FontList (if (LISTP Fonts)
|
||||
else (CONS Fonts)))
|
||||
@@ -40,7 +37,7 @@
|
||||
(NEQ CharacterSet
|
||||
LastCharacterSet
|
||||
))
|
||||
TitleFont InchesToPrinterUnits Hexadecimal))
|
||||
TitleFont InchesToPrinterUnits))
|
||||
finally (CLOSEF Stream])
|
||||
|
||||
(FontSampleFaked
|
||||
@@ -57,134 +54,95 @@
|
||||
(CLOSEF Stream])
|
||||
|
||||
(FontTable
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal)
|
||||
(* ; "Edited 5-Feb-2025 17:03 by mth")
|
||||
(* ; "Edited 3-Feb-2025 20:07 by mth")
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits)
|
||||
(* edited%: "29-Apr-87 22:36")
|
||||
(LET*
|
||||
((Family (FONTPROP Font 'FAMILY))
|
||||
(Face (FONTPROP Font 'FACE))
|
||||
(Size (FONTPROP Font 'SIZE))
|
||||
(Title (CONCAT " " Size "pt " (L-CASE Family T)
|
||||
" "
|
||||
(L-CASE Face T)
|
||||
" Character set "))
|
||||
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
|
||||
'DISPLAY)
|
||||
(NOT (EQ (IMAGESTREAMTYPE Stream)
|
||||
'DISPLAY]
|
||||
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
|
||||
(FONTPROP Font 'HEIGHT]
|
||||
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
|
||||
(printout T Title .I0.8 CharacterSet "Q" T)
|
||||
(RESETLST
|
||||
(RESETSAVE (RADIX (if Hexadecimal
|
||||
then 16
|
||||
else 8)))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 10 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(DSPFONT TitleFont Stream)
|
||||
(if Hexadecimal
|
||||
then (printout Stream Title .I0.16 CharacterSet)
|
||||
else (printout Stream Title .I0.8 CharacterSet))
|
||||
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
|
||||
(TIMES -0.4 (FONTHEIGHT TitleFont)))
|
||||
Stream)
|
||||
(printout Stream (if Hexadecimal
|
||||
then "16"
|
||||
else "8"))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as Counter
|
||||
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRIN1 Counter Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter
|
||||
from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
else '(FIX 3 8))
|
||||
Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
(TIMES 9.3 InchesToPrinterUnits)
|
||||
(TIMES 8.0 InchesToPrinterUnits)
|
||||
(TIMES 9.3 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 9.7 InchesToPrinterUnits)
|
||||
(TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 1.25 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
|
||||
from 0 to 15 bind (CharacterCode _ 0)
|
||||
do
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter
|
||||
from 0 to 15
|
||||
do [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)))
|
||||
(MOVETO XPosition YPosition Stream)
|
||||
(if UseDisplayFontBitmaps
|
||||
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
|
||||
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS))
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
(SETQ CharacterCode (ADD1 CharacterCode)))
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(DSPFONT TitleFont Stream)
|
||||
(if Hexadecimal
|
||||
then (printout Stream Title .I0.16 CharacterSet)
|
||||
else (printout Stream Title .I0.8 CharacterSet))
|
||||
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
|
||||
(TIMES -0.4 (FONTHEIGHT TitleFont)))
|
||||
Stream)
|
||||
(printout Stream (if Hexadecimal
|
||||
then "16"
|
||||
else "8"))
|
||||
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
|
||||
'HOST)
|
||||
'LPT)
|
||||
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.5 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
|
||||
'DEVICE)
|
||||
(FILENAMEFIELD (FULLNAME Stream)
|
||||
'NAME))
|
||||
T)
|
||||
", "
|
||||
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
|
||||
(if FormFeed
|
||||
then (DSPNEWPAGE Stream))
|
||||
(printout T " done." T])
|
||||
(LET* ((Family (FONTPROP Font 'FAMILY))
|
||||
(Face (FONTPROP Font 'FACE))
|
||||
(Size (FONTPROP Font 'SIZE))
|
||||
(Title (CONCAT " " Size "pt " (L-CASE Family T)
|
||||
" "
|
||||
(L-CASE Face T)
|
||||
" Character set ")))
|
||||
(printout T Title |.I0.8| CharacterSet "Q")
|
||||
(RESETLST (RESETSAVE (RADIX 8))
|
||||
(for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45
|
||||
InchesToPrinterUnits
|
||||
) as Counter
|
||||
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRIN1 Counter Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5
|
||||
InchesToPrinterUnits)
|
||||
as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits
|
||||
))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRIN1 Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
(TIMES 9.25 InchesToPrinterUnits)
|
||||
(TIMES 8.0 InchesToPrinterUnits)
|
||||
(TIMES 9.25 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 9.7 InchesToPrinterUnits)
|
||||
(TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 1.25 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(DSPFONT Font Stream)
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
|
||||
as YCounter from 0 to 15 bind (CharacterCode _ 0)
|
||||
do (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45
|
||||
InchesToPrinterUnits)
|
||||
as XCounter from 0 to 15
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS))
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)
|
||||
Stream))
|
||||
(SETQ CharacterCode (ADD1 CharacterCode)))
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(DSPFONT TitleFont Stream)
|
||||
(printout Stream Title |.I0.8| CharacterSet)
|
||||
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
|
||||
(TIMES -0.4 (FONTHEIGHT TitleFont)))
|
||||
Stream)
|
||||
(printout Stream "8")
|
||||
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
|
||||
'HOST)
|
||||
'LPT)
|
||||
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.5 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
|
||||
'DEVICE)
|
||||
(FILENAMEFIELD (FULLNAME Stream)
|
||||
'NAME))
|
||||
T)
|
||||
", "
|
||||
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
|
||||
(if FormFeed
|
||||
then (DSPNEWPAGE Stream))
|
||||
(printout T " done." T])
|
||||
)
|
||||
|
||||
(RPAQQ *INTERESTING-CHARSETS* (0 33 34 38 39 238 239 240 241))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
FONT)
|
||||
)
|
||||
(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (657 9580 (FontSample 667 . 2302) (FontSampleFaked 2304 . 3113) (FontTable 3115 . 9578))
|
||||
(FILEMAP (NIL (689 7765 (FontSample 699 . 2154) (FontSampleFaked 2156 . 2965) (FontTable 2967 . 7763))
|
||||
)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Mar-2025 19:07:34" {WMEDLEY}<lispusers>GITFNS.;536 133643
|
||||
(FILECREATED "12-Jun-2024 23:02:26" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;6 133403
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS GIT-BRANCH-WHENSELECTEDFN)
|
||||
:CHANGES-TO (FNS PRC-COMMAND GIT-BRANCH-RELATIONS GIT-BRANCHES GIT-BRANCH-MENU
|
||||
GIT-PULL-REQUESTS GIT-PRC-BRANCHES CDGITDIR GIT-COMMAND GITORIGIN
|
||||
GIT-RESULT-TO-LINES STRIPLOCAL GIT-WHICH-BRANCH GIT-GET-DIFFERENT-FILES
|
||||
GIT-REMOTE-UPDATE GIT-CHECKOUT GIT-MAKE-BRANCH GIT-MY-BRANCHP
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES)
|
||||
|
||||
:PREVIOUS-DATE "29-Jan-2025 19:20:27" {WMEDLEY}<lispusers>GITFNS.;535)
|
||||
:PREVIOUS-DATE "10-Jun-2024 18:43:43" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -535,8 +539,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(PRC-COMMAND
|
||||
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 29-Jan-2025 19:19 by rmk")
|
||||
(* ; "Edited 13-May-2024 18:49 by rmk")
|
||||
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 13-May-2024 18:49 by rmk")
|
||||
(* ; "Edited 2-May-2024 11:44 by rmk")
|
||||
(* ; "Edited 1-Apr-2024 20:24 by rmk")
|
||||
(* ; "Edited 28-Jul-2023 09:03 by rmk")
|
||||
@@ -573,11 +576,9 @@
|
||||
(SETQ PRS (for PR FOUND in PRS
|
||||
when (if (STRING-EQUAL "Interlisp" (fetch PRLOGIN of PR))
|
||||
then (OR (NULL REMOTEBRANCH)
|
||||
(STRPOS REMOTEBRANCH (CONCAT "#" (fetch PRNUMBER of PR)
|
||||
" "
|
||||
(fetch PRNAME of PR)
|
||||
" "
|
||||
(fetch PRDESCRIPTION of PR))
|
||||
(STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
|
||||
NIL NIL NIL NIL FILEDIRCASEARRAY)
|
||||
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
|
||||
NIL NIL NIL NIL FILEDIRCASEARRAY))
|
||||
else (CL:UNLESS FOUND
|
||||
(SETQ FOUND T)
|
||||
@@ -608,7 +609,7 @@
|
||||
(RPLACD [OR OLDMENUWINDOW (CAR (push GIT-PRC-MENUS (CONS PROJECT]
|
||||
MENUWINDOW)
|
||||
MENUWINDOW
|
||||
else (GIT-PR-COMPARE (GITORIGIN (fetch PRNAME of (CAR PRS)))
|
||||
else (GIT-PR-COMPARE (fetch PRNAME of (CAR PRS))
|
||||
PROJECT))
|
||||
else (CONCAT "No open " (OR REMOTEBRANCH "")
|
||||
" pull requests"])
|
||||
@@ -1431,8 +1432,7 @@
|
||||
WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
|
||||
|
||||
(GIT-BRANCH-WHENSELECTEDFN
|
||||
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 21-Mar-2025 19:07 by rmk")
|
||||
(* ; "Edited 11-May-2024 11:05 by rmk")
|
||||
[LAMBDA (ITEM) (* ; "Edited 11-May-2024 11:05 by rmk")
|
||||
(* ; "Edited 1-May-2024 18:17 by rmk")
|
||||
(* ; "CAR is git key, 4th is project")
|
||||
|
||||
@@ -1451,13 +1451,10 @@
|
||||
|
||||
(* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")
|
||||
|
||||
(if (EQ BUTTON 'MIDDLE)
|
||||
then (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/"
|
||||
(fetch (PULLREQUEST PRNUMBER) of PR)))
|
||||
else (BKSYSBUF '%()
|
||||
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
|
||||
',(fetch PRPROJECT of PR]
|
||||
(BKSYSBUF '%)))
|
||||
(BKSYSBUF '%()
|
||||
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
|
||||
',(fetch PRPROJECT of PR]
|
||||
(BKSYSBUF '%))
|
||||
else
|
||||
(* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")
|
||||
|
||||
@@ -2429,33 +2426,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4195 20774 (GIT-CLONEP 4205 . 5533) (GIT-INIT 5535 . 6165) (GIT-MAKE-PROJECT 6167 .
|
||||
13832) (GIT-GET-PROJECT 13834 . 15759) (GIT-PUT-PROJECT-FIELD 15761 . 17402) (GIT-PROJECT-PATH 17404
|
||||
. 18448) (FIND-ANCESTOR-DIRECTORY 18450 . 18799) (GIT-FIND-CLONE 18801 . 19882) (GIT-MAINBRANCH 19884
|
||||
. 20279) (GIT-MAINBRANCH? 20281 . 20772)) (26237 31166 (PRC-COMMAND 26247 . 31164)) (31222 34010 (
|
||||
ALLSUBDIRS 31232 . 32518) (MEDLEYSUBDIRS 32520 . 33213) (GITSUBDIRS 33215 . 34008)) (34011 38801 (
|
||||
TOGIT 34021 . 35427) (FROMGIT 35429 . 36410) (GIT-DELETE-FILE 36412 . 37258) (MYMEDLEY-DELETE-FILES
|
||||
37260 . 38799)) (38802 41805 (MYMEDLEYSUBDIR 38812 . 39268) (GITSUBDIR 39270 . 39713) (STRIPDIR 39715
|
||||
. 40086) (STRIPHOST 40088 . 40328) (STRIPNAME 40330 . 41083) (STRIPWHERE 41085 . 41803)) (41806 43708
|
||||
(GFILE4MFILE 41816 . 42179) (MFILE4GFILE 42181 . 42750) (GIT-REPO-FILENAME 42752 . 43706)) (43757
|
||||
54119 (GIT-COMMIT 43767 . 44593) (GIT-PUSH 44595 . 45355) (GIT-PULL 45357 . 46109) (GIT-APPROVAL 46111
|
||||
. 46460) (GIT-GET-FILE 46462 . 48484) (GIT-FILE-EXISTS? 48486 . 48760) (GIT-REMOTE-UPDATE 48762 .
|
||||
49597) (GIT-REMOTE-ADD 49599 . 49906) (GIT-FILE-DATE 49908 . 50955) (GIT-FILE-HISTORY 50957 . 52891) (
|
||||
GIT-PRINT-FILE-HISTORY 52893 . 53943) (GIT-FETCH 53945 . 54117)) (54149 65269 (GIT-BRANCH-DIFF 54159
|
||||
. 60906) (GIT-COMMIT-DIFFS 60908 . 61581) (GIT-BRANCH-RELATIONS 61583 . 65267)) (65314 84700 (
|
||||
GIT-BRANCH-NUM 65324 . 65897) (GIT-CHECKOUT 65899 . 67185) (GIT-WHICH-BRANCH 67187 . 67594) (
|
||||
GIT-MAKE-BRANCH 67596 . 70175) (GIT-BRANCHES 70177 . 72772) (GIT-BRANCH-EXISTS? 72774 . 73645) (
|
||||
GIT-PICK-BRANCH 73647 . 74137) (GIT-BRANCH-MENU 74139 . 75020) (GIT-BRANCH-WHENSELECTEDFN 75022 .
|
||||
77561) (GIT-PULL-REQUESTS 77563 . 81081) (GIT-SHORT-BRANCH-NAME 81083 . 81374) (GIT-LONG-NAME 81376 .
|
||||
81693) (GIT-PRC-BRANCHES 81695 . 84698)) (84730 88178 (GIT-MY-CURRENT-BRANCH 84740 . 85110) (
|
||||
GIT-MY-BRANCHP 85112 . 85730) (GIT-MY-NEXT-BRANCH 85732 . 86226) (GIT-MY-BRANCHES 86228 . 88176)) (
|
||||
88224 92299 (GIT-ADD-WORKTREE 88234 . 89841) (GIT-REMOVE-WORKTREE 89843 . 90773) (GIT-LIST-WORKTREES
|
||||
90775 . 91579) (WORKTREEDIR 91581 . 92297)) (92347 125481 (GIT-GET-DIFFERENT-FILES 92357 . 98781) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98783 . 106014) (GIT-WORKING-COMPARE-DIRECTORIES 106016 . 111464) (
|
||||
GIT-COMPARE-WORKTREE 111466 . 115444) (GITCDOBJBUTTONFN 115446 . 119936) (GIT-CD-LABELFN 119938 .
|
||||
121020) (GIT-CD-MENUFN 121022 . 123462) (GIT-WORKING-COMPARE-FILES 123464 . 124084) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124086 . 125250) (GIT-PR-COMPARE 125252 . 125479)) (125551 133576 (CDGITDIR
|
||||
125561 . 126248) (GIT-COMMAND 126250 . 127808) (GITORIGIN 127810 . 128507) (GIT-INITIALS 128509 .
|
||||
128813) (GIT-COMMAND-TO-FILE 128815 . 132300) (GIT-RESULT-TO-LINES 132302 . 132909) (STRIPLOCAL 132911
|
||||
. 133574)))))
|
||||
(FILEMAP (NIL (4636 21215 (GIT-CLONEP 4646 . 5974) (GIT-INIT 5976 . 6606) (GIT-MAKE-PROJECT 6608 .
|
||||
14273) (GIT-GET-PROJECT 14275 . 16200) (GIT-PUT-PROJECT-FIELD 16202 . 17843) (GIT-PROJECT-PATH 17845
|
||||
. 18889) (FIND-ANCESTOR-DIRECTORY 18891 . 19240) (GIT-FIND-CLONE 19242 . 20323) (GIT-MAINBRANCH 20325
|
||||
. 20720) (GIT-MAINBRANCH? 20722 . 21213)) (26678 31300 (PRC-COMMAND 26688 . 31298)) (31356 34144 (
|
||||
ALLSUBDIRS 31366 . 32652) (MEDLEYSUBDIRS 32654 . 33347) (GITSUBDIRS 33349 . 34142)) (34145 38935 (
|
||||
TOGIT 34155 . 35561) (FROMGIT 35563 . 36544) (GIT-DELETE-FILE 36546 . 37392) (MYMEDLEY-DELETE-FILES
|
||||
37394 . 38933)) (38936 41939 (MYMEDLEYSUBDIR 38946 . 39402) (GITSUBDIR 39404 . 39847) (STRIPDIR 39849
|
||||
. 40220) (STRIPHOST 40222 . 40462) (STRIPNAME 40464 . 41217) (STRIPWHERE 41219 . 41937)) (41940 43842
|
||||
(GFILE4MFILE 41950 . 42313) (MFILE4GFILE 42315 . 42884) (GIT-REPO-FILENAME 42886 . 43840)) (43891
|
||||
54253 (GIT-COMMIT 43901 . 44727) (GIT-PUSH 44729 . 45489) (GIT-PULL 45491 . 46243) (GIT-APPROVAL 46245
|
||||
. 46594) (GIT-GET-FILE 46596 . 48618) (GIT-FILE-EXISTS? 48620 . 48894) (GIT-REMOTE-UPDATE 48896 .
|
||||
49731) (GIT-REMOTE-ADD 49733 . 50040) (GIT-FILE-DATE 50042 . 51089) (GIT-FILE-HISTORY 51091 . 53025) (
|
||||
GIT-PRINT-FILE-HISTORY 53027 . 54077) (GIT-FETCH 54079 . 54251)) (54283 65403 (GIT-BRANCH-DIFF 54293
|
||||
. 61040) (GIT-COMMIT-DIFFS 61042 . 61715) (GIT-BRANCH-RELATIONS 61717 . 65401)) (65448 84460 (
|
||||
GIT-BRANCH-NUM 65458 . 66031) (GIT-CHECKOUT 66033 . 67319) (GIT-WHICH-BRANCH 67321 . 67728) (
|
||||
GIT-MAKE-BRANCH 67730 . 70309) (GIT-BRANCHES 70311 . 72906) (GIT-BRANCH-EXISTS? 72908 . 73779) (
|
||||
GIT-PICK-BRANCH 73781 . 74271) (GIT-BRANCH-MENU 74273 . 75154) (GIT-BRANCH-WHENSELECTEDFN 75156 .
|
||||
77321) (GIT-PULL-REQUESTS 77323 . 80841) (GIT-SHORT-BRANCH-NAME 80843 . 81134) (GIT-LONG-NAME 81136 .
|
||||
81453) (GIT-PRC-BRANCHES 81455 . 84458)) (84490 87938 (GIT-MY-CURRENT-BRANCH 84500 . 84870) (
|
||||
GIT-MY-BRANCHP 84872 . 85490) (GIT-MY-NEXT-BRANCH 85492 . 85986) (GIT-MY-BRANCHES 85988 . 87936)) (
|
||||
87984 92059 (GIT-ADD-WORKTREE 87994 . 89601) (GIT-REMOVE-WORKTREE 89603 . 90533) (GIT-LIST-WORKTREES
|
||||
90535 . 91339) (WORKTREEDIR 91341 . 92057)) (92107 125241 (GIT-GET-DIFFERENT-FILES 92117 . 98541) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98543 . 105774) (GIT-WORKING-COMPARE-DIRECTORIES 105776 . 111224) (
|
||||
GIT-COMPARE-WORKTREE 111226 . 115204) (GITCDOBJBUTTONFN 115206 . 119696) (GIT-CD-LABELFN 119698 .
|
||||
120780) (GIT-CD-MENUFN 120782 . 123222) (GIT-WORKING-COMPARE-FILES 123224 . 123844) (
|
||||
GIT-BRANCHES-COMPARE-FILES 123846 . 125010) (GIT-PR-COMPARE 125012 . 125239)) (125311 133336 (CDGITDIR
|
||||
125321 . 126008) (GIT-COMMAND 126010 . 127568) (GITORIGIN 127570 . 128267) (GIT-INITIALS 128269 .
|
||||
128573) (GIT-COMMAND-TO-FILE 128575 . 132060) (GIT-RESULT-TO-LINES 132062 . 132669) (STRIPLOCAL 132671
|
||||
. 133334)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
lispusers/GITFNS.PDF
Normal file
BIN
lispusers/GITFNS.PDF
Normal file
Binary file not shown.
Binary file not shown.
@@ -1,239 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Jan-2025 19:34:13" {WMEDLEY}<lispusers>MULTI-ALIST.;15 12223
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MAPMULTI)
|
||||
|
||||
:PREVIOUS-DATE "25-Jan-2025 15:04:13" {WMEDLEY}<lispusers>MULTI-ALIST.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MULTI-ALISTCOMS)
|
||||
|
||||
(RPAQQ MULTI-ALISTCOMS
|
||||
((MACROS GETMULTI PUTMULTI PUTMULTI-D PUTMULTI-NEW PUTMULTI-COUNT PUTMULTI-SUM REMOVEMULTI
|
||||
REMOVEMULTIALL)
|
||||
(MACROS FGETMULTI FPUTMULTI FPUTMULTI-D FPUTMULTI-NEW)
|
||||
(FNS MAPMULTI MAPMULTI1 COLLECTMULTI)
|
||||
(FNS GETMULTI.EXPAND PUTMULTI.EXPAND REMOVEMULTI.EXPAND)
|
||||
(MACROS ADDTOMULTI)
|
||||
(FNS ADDTOMULTI1)
|
||||
(LOCALVARS . T)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS GETMULTI MACRO (ARGS (GETMULTI.EXPAND 'SASSOC ARGS)))
|
||||
|
||||
(PUTPROPS PUTMULTI MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS)))
|
||||
|
||||
(PUTPROPS PUTMULTI-D MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS NIL T)))
|
||||
|
||||
(PUTPROPS PUTMULTI-NEW MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS)))
|
||||
|
||||
(PUTPROPS PUTMULTI-COUNT MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC (APPEND ARGS '(1))
|
||||
NIL NIL T)))
|
||||
|
||||
(PUTPROPS PUTMULTI-SUM MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS NIL NIL T)))
|
||||
|
||||
(PUTPROPS REMOVEMULTI MACRO (ARGS (REMOVEMULTI.EXPAND ARGS)))
|
||||
|
||||
(PUTPROPS REMOVEMULTIALL MACRO (ARGS (REMOVEMULTI.EXPAND ARGS T)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS FGETMULTI MACRO (ARGS (GETMULTI.EXPAND 'FASSOC ARGS)))
|
||||
|
||||
(PUTPROPS FPUTMULTI MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
|
||||
|
||||
(PUTPROPS FPUTMULTI-D MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS NIL T)))
|
||||
|
||||
(PUTPROPS FPUTMULTI-NEW MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MAPMULTI
|
||||
[LAMBDA (MULTIALIST MAPFN) (* ; "Edited 29-Jan-2025 19:33 by rmk")
|
||||
(* ; "Edited 25-Jan-2025 14:51 by rmk")
|
||||
(* ; "Edited 16-Jan-2025 10:32 by rmk")
|
||||
(* ; "Edited 6-Jan-2020 10:15 by rmk:")
|
||||
|
||||
(* ;; "MAPMULTI applies a mapping function of N args to each item in an N-way item in the multi-alist at MULTIALIST. If an item C is inserted by (PUTMULTI FOO A B C), then MAPFN should be a 3 argument function and it will be applied to A B C. The caller is responsible for making sure the arities of the index and the mapfn correspond.")
|
||||
|
||||
(DECLARE (SPECVARS MAPFN))
|
||||
(LET ($$LISTFORARGS$$)
|
||||
(DECLARE (SPECVARS $$LISTFORARGS$$))
|
||||
(SETQ $$LISTFORARGS$$ (FOR I FROM 1 TO (NARGS MAPFN) COLLECT NIL))
|
||||
(MAPMULTI1 MULTIALIST $$LISTFORARGS$$ (NARGS MAPFN])
|
||||
|
||||
(MAPMULTI1
|
||||
[LAMBDA (SUBALIST ARGLIST NREMAINING) (* ; "Edited 25-Jan-2025 15:03 by rmk")
|
||||
(* ; "Edited 22-Jan-2025 23:42 by rmk")
|
||||
(* ; "Edited 16-Jan-2025 10:29 by rmk")
|
||||
(* ; "Edited 6-Jan-2020 10:21 by rmk:")
|
||||
(DECLARE (USEDFREE $$LISTFORARGS$$ MAPFN))
|
||||
(if [AND (IGREATERP NREMAINING 1)
|
||||
(LISTP (CAR (LISTP SUBALIST]
|
||||
then
|
||||
(* ;; "Still a list of alists.")
|
||||
|
||||
(for SI in SUBALIST do (RPLACA ARGLIST (CAR SI))
|
||||
(MAPMULTI1 (CDR SI)
|
||||
(CDR ARGLIST)
|
||||
(SUB1 NREMAINING)))
|
||||
else (for ITEM inside SUBALIST do (RPLACA ARGLIST ITEM)
|
||||
(APPLY MAPFN $$LISTFORARGS$$])
|
||||
|
||||
(COLLECTMULTI
|
||||
[LAMBDA (MULTIALIST MAPFN) (* ; "Edited 25-Jan-2025 15:00 by rmk")
|
||||
(* ; "Edited 22-Jan-2025 23:44 by rmk")
|
||||
(* ; "Edited 6-Jan-2020 10:15 by rmk:")
|
||||
(LET ($$COLLECT)
|
||||
(DECLARE (SPECVARS $$COLLECT))
|
||||
(MAPMULTI MULTIALIST MAPFN)
|
||||
$$COLLECT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(GETMULTI.EXPAND
|
||||
[LAMBDA (ASSOCFN ARGS) (* ; "Edited 16-Jan-2025 10:27 by rmk")
|
||||
(* ; "Edited 19-Jul-2020 00:38 by rmk:")
|
||||
(* ; "Edited 22-Mar-2020 13:21 by rmk:")
|
||||
(* ; "Edited 27-Feb-2020 13:44 by rmk:")
|
||||
(* ; "Edited 30-Dec-2019 20:50 by rmk:")
|
||||
|
||||
(* ;; "If SUM, returns the value after the last argument, paired with PUTMULTISUM")
|
||||
|
||||
(IF (CDR ARGS)
|
||||
THEN `(LET ($$CELL$$)
|
||||
(DECLARE (LOCALVARS $$CELL$$))
|
||||
,@[FOR ATAIL (HEAD _ (CAR ARGS)) ON (CDR ARGS)
|
||||
COLLECT (PROG1 `[SETQ $$CELL$$ (CDR (,ASSOCFN ,(CAR ATAIL)
|
||||
,HEAD]
|
||||
(SETQ HEAD '$$CELL$$))]
|
||||
$$CELL$$)
|
||||
ELSE (CAR ARGS])
|
||||
|
||||
(PUTMULTI.EXPAND
|
||||
[LAMBDA (ASSOCFN ARGS ALLOWREPEATS SINGLEVALUE SUM) (* ; "Edited 23-Jan-2025 09:40 by rmk")
|
||||
(* ; "Edited 16-Jan-2025 10:18 by rmk")
|
||||
(* ; "Edited 17-Aug-2020 14:09 by rmk:")
|
||||
|
||||
(* ;; "If ALLOWREPEATS, doesn't test (MEMBER) for preexisting values, just accumulates")
|
||||
|
||||
(* ;; "If SINGLEVALUE, new value smashes out old")
|
||||
|
||||
(* ;; "For SUM, the last argument is the increment to be added to the current value, and the incremented value is returned for PUTMULTISUM and for GETMULT")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "We get the setf method so that any expressions in the form will be evaluated only once.")
|
||||
|
||||
(CL:MULTIPLE-VALUE-BIND
|
||||
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
|
||||
(CL:GET-SETF-METHOD (CAR ARGS))
|
||||
(CL:IF (CDR ARGS)
|
||||
`(LET*
|
||||
,(FOR VF IN VALFORMS AS TV IN TEMPVARS COLLECT (LIST TV VF))
|
||||
(DECLARE (LOCALVARS ,@TEMPVARS))
|
||||
(LET
|
||||
($$ARG1$$ $$ARG2$$)
|
||||
(DECLARE (LOCALVARS $$ARG1$$ $$ARG2$$))
|
||||
,@[FOR ATAIL (HEAD _ ACCESSFORM) ON ARGS WHILE (CDR ATAIL)
|
||||
JOIN
|
||||
(IF (AND SUM (NULL (CDDR ATAIL)))
|
||||
THEN (POP ATAIL)
|
||||
`[(CL:UNLESS ,HEAD (RPLACD $$ARG1$$ 0))
|
||||
(SETQ $$ARG2$$ (ADD ,HEAD ,(CAR ATAIL]
|
||||
ELSE
|
||||
(PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
|
||||
,(IF (CDDR ATAIL)
|
||||
THEN `[SETQ $$ARG1$$ (OR (,ASSOCFN $$ARG2$$ ,HEAD)
|
||||
(CAR (CL:PUSH (CONS $$ARG2$$)
|
||||
,HEAD]
|
||||
ELSEIF ALLOWREPEATS
|
||||
THEN `(push ,HEAD $$ARG2$$)
|
||||
ELSEIF SINGLEVALUE
|
||||
THEN `(RPLACD $$ARG2$$)
|
||||
ELSE `(OR (MEMBER $$ARG2$$ ,HEAD)
|
||||
(push ,HEAD $$ARG2$$]
|
||||
(SETQ HEAD '(CDR $$ARG1$$)))]
|
||||
$$ARG2$$))
|
||||
(CAR ARGS))])
|
||||
|
||||
(REMOVEMULTI.EXPAND
|
||||
[LAMBDA (ARGS ALLFLAG) (* ; "Edited 16-Jan-2025 10:34 by rmk")
|
||||
(* ; "Edited 17-Aug-2020 15:12 by rmk:")
|
||||
(* ; "Edited 17-May-2020 17:25 by rmk:")
|
||||
(* ; "Edited 14-Feb-2020 11:24 by rmk:")
|
||||
(* ; "Edited 25-Dec-2019 09:57 by rmk:")
|
||||
|
||||
(* ;; "If ALLFLAG, then all data after the last of ARGS, if any, is removed. That is, if there are 3 keys to the index, and REMOVEMULTIALL is invoked with 2 keys, then it's as if no entries were made for any of the third keys after those first two. In the case of REMOVEMULTIALL, it returns the previous tail.")
|
||||
|
||||
(* ;; "No point in distinguishing FASSOC from SASSOC here.")
|
||||
|
||||
(CL:MULTIPLE-VALUE-BIND
|
||||
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
|
||||
(CL:GET-SETF-METHOD (CAR ARGS))
|
||||
(CL:IF (CDR ARGS)
|
||||
`(LET*
|
||||
,(FOR VF IN VALFORMS AS TV IN TEMPVARS COLLECT (LIST TV VF))
|
||||
(DECLARE (LOCALVARS ,@TEMPVARS))
|
||||
(LET
|
||||
($$ARG1$$ $$ARG2$$)
|
||||
(DECLARE (LOCALVARS $$ARG1$$ $$ARG2$$))
|
||||
,@[FOR ATAIL (HEAD _ ACCESSFORM) ON ARGS WHILE (CDR ATAIL)
|
||||
JOIN (PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
|
||||
,(IF (CDDR ATAIL)
|
||||
THEN `(SETQ $$ARG1$$ (SASSOC $$ARG2$$ ,HEAD))
|
||||
ELSEIF ALLFLAG
|
||||
THEN `(CL:WHEN (SETQ $$ARG1$$ (SASSOC $$ARG2$$ ,HEAD))
|
||||
(SETQ $$ARG2$$ (CDR $$ARG1$$))
|
||||
(RPLACD $$ARG1$$))
|
||||
ELSE `(AND (SETQ $$ARG2$$ (MEMBER $$ARG2$$ ,HEAD))
|
||||
(RPLACD $$ARG1$$ (DREMOVE (SETQ $$ARG2$$ (CAR $$ARG2$$))
|
||||
,HEAD]
|
||||
(SETQ HEAD '(CDR $$ARG1$$)))]
|
||||
$$ARG2$$))
|
||||
(CAR ARGS))])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS ADDTOMULTI MACRO [ARGS (CL:MULTIPLE-VALUE-BIND
|
||||
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
|
||||
(CL:GET-SETF-METHOD (CAR ARGS))
|
||||
`(LET* [,@(FOR VF IN VALFORMS AS TV IN TEMPVARS
|
||||
COLLECT (LIST TV VF))
|
||||
($$KEYS ,(CADR ARGS]
|
||||
(DECLARE (LOCALVARS $$KEYS ,@TEMPVARS))
|
||||
(COND
|
||||
[(LISTP $$KEYS)
|
||||
(CL:UNLESS (SASSOC (CAR $$KEYS)
|
||||
,ACCESSFORM)
|
||||
(CL:PUSH (CONS (CAR $$KEYS))
|
||||
,ACCESSFORM))
|
||||
(ADDTOMULTI1 ,ACCESSFORM $$KEYS ,(CADDR ARGS]
|
||||
(T (CL:SETF ,ACCESSFORM ,(CADDR ARGS])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(ADDTOMULTI1
|
||||
[LAMBDA (PLACE KEYS VAL) (* ; "Edited 22-Jan-2025 23:47 by rmk")
|
||||
(* ; "Edited 17-Aug-2020 15:05 by rmk:")
|
||||
|
||||
(* ;; "This allows the keys to be provided in a single list rather than as separate arguments.")
|
||||
|
||||
(FOR I (P _ PLACE) IN KEYS DO [SETQ P (OR (SASSOC I P)
|
||||
(CAR (PUSH (CDR P)
|
||||
(CONS I] FINALLY (PUSH (CDR P)
|
||||
VAL))
|
||||
VAL])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1837 4449 (MAPMULTI 1847 . 2915) (MAPMULTI1 2917 . 3974) (COLLECTMULTI 3976 . 4447)) (
|
||||
4450 10311 (GETMULTI.EXPAND 4460 . 5581) (PUTMULTI.EXPAND 5583 . 7995) (REMOVEMULTI.EXPAND 7997 .
|
||||
10309)) (11461 12146 (ADDTOMULTI1 11471 . 12144)))))
|
||||
STOP
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Dec-2024 11:45:23" {WMEDLEY}<library>PSEUDOHOSTS.;177 29713
|
||||
(FILECREATED " 2-Nov-2023 10:53:30" {WMEDLEY}<lispusers>PSEUDOHOSTS.;160 26843
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TRUEDEVICE)
|
||||
:CHANGES-TO (FNS PSEUDOHOST)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2024 07:38:10" {WMEDLEY}<library>PSEUDOHOSTS.;176)
|
||||
:PREVIOUS-DATE " 1-Oct-2023 20:16:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;159)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
|
||||
@@ -15,17 +15,16 @@
|
||||
(
|
||||
(* ;; "Public entries")
|
||||
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME)
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST 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)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (PSEUDOHOST 'LI LOGINHOST/DIR)))
|
||||
(P (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
(P (PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
(MOVD 'GETHOSTINFO.PH 'GETHOSTINFO))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
|
||||
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
|
||||
@@ -137,14 +136,9 @@
|
||||
HOST])
|
||||
|
||||
(PSEUDOHOSTP
|
||||
[LAMBDA (HOST) (* ; "Edited 16-Dec-2024 21:15 by rmk")
|
||||
(* ; "Edited 24-Feb-2022 23:51 by rmk")
|
||||
[LAMBDA (HOST) (* ; "Edited 24-Feb-2022 23:51 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 11:29 by rmk")
|
||||
(LET [(DEV (if (type? FDEV HOST)
|
||||
then HOST
|
||||
elseif (type? STREAM HOST)
|
||||
then (fetch (STREAM DEVICE) of HOST)
|
||||
else (\GETDEVICEFROMNAME HOST T T]
|
||||
(LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
|
||||
(CL:WHEN (AND DEV (type? FDEV (fetch (PHDEVICE TARGETDEV) OF DEV)))
|
||||
(LIST (FETCH (FDEV DEVICENAME) OF DEV)
|
||||
(FETCH (PHDEVICE PREFIX)
|
||||
@@ -157,30 +151,9 @@
|
||||
(FETCH (PHDEVICE PREFIX) OF DEV])
|
||||
|
||||
(TARGETHOST
|
||||
[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])
|
||||
[LAMBDA (HOST) (* ; "Edited 22-Jan-2022 09:00 by rmk")
|
||||
(CL:WHEN (PSEUDOHOSTP HOST)
|
||||
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
|
||||
|
||||
(TRUEFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 1-Oct-2023 20:16 by rmk")
|
||||
@@ -328,24 +301,6 @@
|
||||
)
|
||||
(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)
|
||||
|
||||
@@ -498,10 +453,8 @@
|
||||
(SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE)))
|
||||
RESULT])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
)
|
||||
|
||||
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
|
||||
@@ -562,13 +515,12 @@
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1318 12059 (PSEUDOHOST 1328 . 7036) (PSEUDOHOSTP 7038 . 7867) (PSEUDOHOSTS 7869 . 8230)
|
||||
(TARGETHOST 8232 . 9101) (TRUEDEVICE 9103 . 10059) (TRUEFILENAME 10061 . 11186) (PSEUDOFILENAME 11188
|
||||
. 12057)) (12087 18102 (EXPAND.PH 12097 . 13350) (CONTRACT.PH 13352 . 16063) (UNSLASHIT 16065 . 17811
|
||||
) (GETHOSTINFO.PH 17813 . 18100)) (18103 19004 (CDPSEUDO 18113 . 19002)) (19005 27025 (OPENFILE.PH
|
||||
19015 . 20088) (GETFILENAME.PH 20090 . 20379) (DIRECTORYNAMEP.PH 20381 . 21005) (CLOSEFILE.PH 21007 .
|
||||
21474) (REOPENFILE.PH 21476 . 22041) (DELETEFILE.PH 22043 . 22327) (OPENP.PH 22329 . 22624) (
|
||||
UNREGISTERFILE.PH 22626 . 23168) (REGISTERFILE.PH 23170 . 23704) (GENERATEFILES.PH 23706 . 24750) (
|
||||
GETFILEINFO.PH 24752 . 25054) (SETFILEINFO.PH 25056 . 25255) (NEXTFILEFN.PH 25257 . 25803) (
|
||||
FILEINFOFN.PH 25805 . 26080) (RENAMEFILE.PH 26082 . 27023)))))
|
||||
(FILEMAP (NIL (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)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Nov-2024 17:59:00" {WMEDLEY}<lispusers>REGIONMANAGER.;135 42008
|
||||
(FILECREATED "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134 41230
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \RELCREATEREGION.REF)
|
||||
:CHANGES-TO (FNS CLOSE-TYPED-W)
|
||||
|
||||
:PREVIOUS-DATE "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134)
|
||||
:PREVIOUS-DATE " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT REGIONMANAGERCOMS)
|
||||
@@ -446,8 +446,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\RELCREATEREGION.REF
|
||||
[LAMBDA (REF WHICH) (* ; "Edited 25-Nov-2024 17:47 by rmk")
|
||||
(* ; "Edited 27-Feb-2022 08:43 by rmk")
|
||||
[LAMBDA (REF WHICH) (* ; "Edited 27-Feb-2022 08:43 by rmk")
|
||||
(* ; "Edited 23-Jan-2022 20:20 by rmk")
|
||||
(* ; "Edited 2-Jan-2022 11:01 by rmk")
|
||||
|
||||
@@ -475,10 +474,6 @@
|
||||
'REGION))
|
||||
(FETCH (REGION BOTTOM) OF (WINDOWPROP (WFROMDS T)
|
||||
'REGION)))
|
||||
ELSEIF (REGIONP REF)
|
||||
THEN (CL:IF (EQ WHICH 'X)
|
||||
(FETCH (REGION LEFT) OF REF)
|
||||
(FETCH (REGION BOTTOM) OF REF))
|
||||
ELSEIF [AND (LISTP REF)
|
||||
(SETQ ANCHOR (OR (REGIONP (CAR REF))
|
||||
(AND (WINDOWP (CAR REF))
|
||||
@@ -515,15 +510,6 @@
|
||||
(CL:WHEN (CADR SPEC)
|
||||
(ADD VAL (CADR SPEC)))
|
||||
VAL
|
||||
ELSEIF (WINDOWP REF)
|
||||
THEN (SETQ REF (WINDOWPROP REF 'REGION))
|
||||
(CL:IF (EQ WHICH 'X)
|
||||
(FETCH (REGION LEFT) OF REF)
|
||||
(FETCH (REGION BOTTOM) OF REF))
|
||||
ELSEIF (POSITIONP REF)
|
||||
THEN (CL:IF (EQ WHICH 'X)
|
||||
(FETCH (POSITION XCOORD) OF REF)
|
||||
(FETCH (POSITION YCOORD) OF REF))
|
||||
ELSE (\ILLEGAL.ARG REF])
|
||||
|
||||
(\RELCREATEREGION.SIZE
|
||||
@@ -746,11 +732,11 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1622 6740 (SET-TYPED-REGIONS 1632 . 3807) (GRAB-TYPED-REGION 3809 . 4835) (
|
||||
REGISTER-TYPED-REGION 4837 . 6134) (REGION-TYPE 6136 . 6738)) (6741 14810 (RM-CREATEW 6751 . 8874) (
|
||||
RM-CLOSEW 8876 . 11894) (RM-GETREGION 11896 . 14045) (CLOSE-TYPED-W 14047 . 14808)) (15453 22932 (
|
||||
RELCREATEREGION 15463 . 20086) (RELGETREGION 20088 . 22695) (RELCREATEPOSITION 22697 . 22930)) (22933
|
||||
30508 (\RELCREATEREGION.REF 22943 . 27465) (\RELCREATEREGION.SIZE 27467 . 30506)) (30561 39903 (
|
||||
RM-ATTACHWINDOW 30571 . 39901)) (39904 41638 (CLOSEWITH 39914 . 40441) (CLOSEWITH.DOIT 40443 . 40723)
|
||||
(MOVEWITH 40725 . 41248) (MOVEWITH.DOIT 41250 . 41636)))))
|
||||
(FILEMAP (NIL (1615 6733 (SET-TYPED-REGIONS 1625 . 3800) (GRAB-TYPED-REGION 3802 . 4828) (
|
||||
REGISTER-TYPED-REGION 4830 . 6127) (REGION-TYPE 6129 . 6731)) (6734 14803 (RM-CREATEW 6744 . 8867) (
|
||||
RM-CLOSEW 8869 . 11887) (RM-GETREGION 11889 . 14038) (CLOSE-TYPED-W 14040 . 14801)) (15446 22925 (
|
||||
RELCREATEREGION 15456 . 20079) (RELGETREGION 20081 . 22688) (RELCREATEPOSITION 22690 . 22923)) (22926
|
||||
29730 (\RELCREATEREGION.REF 22936 . 26687) (\RELCREATEREGION.SIZE 26689 . 29728)) (29783 39125 (
|
||||
RM-ATTACHWINDOW 29793 . 39123)) (39126 40860 (CLOSEWITH 39136 . 39663) (CLOSEWITH.DOIT 39665 . 39945)
|
||||
(MOVEWITH 39947 . 40470) (MOVEWITH.DOIT 40472 . 40858)))))
|
||||
STOP
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user