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
|
||||
|
||||
@@ -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 "19-Feb-2025 12:21:45" {WMEDLEY}<internal>TEDIT-DEBUG.;135 130829
|
||||
(FILECREATED "16-Dec-2024 20:38:14" {WMEDLEY}<internal>TEDIT-DEBUG.;123 130350
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SPPRINT)
|
||||
:CHANGES-TO (FNS SP)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2025 22:41:55" {WMEDLEY}<internal>TEDIT-DEBUG.;134)
|
||||
:PREVIOUS-DATE "14-Dec-2024 14:32:20" {WMEDLEY}<internal>TEDIT-DEBUG.;122)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
||||
@@ -30,7 +30,7 @@
|
||||
(COMS (* ; "Inspect")
|
||||
(FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES))
|
||||
(COMS (* ; "Show")
|
||||
(FNS SP SL SSP STL SPF SLF SHOWLINE SLL STBYTES SSEL))
|
||||
(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*)
|
||||
@@ -109,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)))
|
||||
@@ -395,16 +393,25 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SP
|
||||
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "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.")
|
||||
@@ -415,15 +422,12 @@
|
||||
PC
|
||||
(GTO TOBJ)))
|
||||
WTYPE)
|
||||
(if OFILE
|
||||
then (CL:WHEN (MEMB OFILE '(T TEDIT))
|
||||
(SETQ WTYPE 'SP)
|
||||
(SETQ OFILE NIL))
|
||||
elseif (AND NP (LITATOM NP))
|
||||
then (SETQ WTYPE (CL:IF (EQ NP T)
|
||||
'SP
|
||||
NP))
|
||||
(SETQ NP NIL))
|
||||
(CL:WHEN (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))
|
||||
@@ -475,9 +479,7 @@
|
||||
(RETURN PC])
|
||||
|
||||
(SL
|
||||
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "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")
|
||||
@@ -490,13 +492,10 @@
|
||||
(* ;; "Shows a selection of the lines backing the display in PANE")
|
||||
|
||||
(LET (LINES WTYPE PNO)
|
||||
(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))
|
||||
(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))
|
||||
@@ -519,15 +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 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")
|
||||
@@ -537,13 +532,7 @@
|
||||
|
||||
(* ;; "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)
|
||||
(for PC inselpieces SELPIECES as I from 1 to (OR NP 50)
|
||||
do (PRINTOUT OFILE .I3 I "/")
|
||||
@@ -975,15 +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
|
||||
|
||||
@@ -1221,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")
|
||||
@@ -1286,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 "")
|
||||
"")
|
||||
@@ -1367,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")
|
||||
@@ -1387,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)
|
||||
" ")))
|
||||
@@ -1906,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")
|
||||
@@ -1926,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
|
||||
@@ -2346,9 +2333,7 @@
|
||||
`(PROGN (CL:UNLESS RESETSTATE
|
||||
[TEDIT OFILE WTYPE NIL
|
||||
`(READONLY QUIET LEAVETTY T TITLE
|
||||
,WTYPE]
|
||||
(WINDOWPROP (WFROMDS OFILE)
|
||||
'TEDIT-DEBUG T))]
|
||||
,WTYPE])]
|
||||
elseif OFILE
|
||||
then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
@@ -2441,30 +2426,30 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4850 7409 (GTO 4860 . 5110) (GTS 5112 . 6883) (GTW 6885 . 7041) (GSEL 7043 . 7407)) (
|
||||
7466 20597 (IPC 7476 . 8980) (ILINES 8982 . 11523) (ISEL 11525 . 12136) (ITS 12138 . 13862) (IPANES
|
||||
13864 . 14099) (ITL 14101 . 14520) (IHIST 14522 . 17184) (IPCTB 17186 . 17494) (IMB 17496 . 18111) (
|
||||
ICL 18113 . 18678) (IPL 18680 . 19084) (ICARET 19086 . 19463) (INSPECTPIECES 19465 . 20595)) (20619
|
||||
56081 (SP 20629 . 25146) (SL 25148 . 28292) (SSP 28294 . 29725) (STL 29727 . 38239) (SPF 38241 . 40540
|
||||
) (SLF 40542 . 49675) (SHOWLINE 49677 . 53239) (SLL 53241 . 53988) (STBYTES 53990 . 55716) (SSEL 55718
|
||||
. 56079)) (56082 61455 (NTHPIECE 56092 . 57224) (NPIECES 57226 . 58091) (NTHPIECECHAR 58093 . 59401)
|
||||
(SELPIECE 59403 . 59845) (PIECENUM 59847 . 60566) (PCBYTES 60568 . 61453)) (61456 63930 (FILEBYTES
|
||||
61466 . 62890) (TFILEBYTES 62892 . 63928)) (63931 65253 (TRELMOVE 63941 . 64184) (TSCROLL 64186 .
|
||||
64352) (TSCROLL* 64354 . 65251)) (65254 68303 (TRY 65264 . 66533) (TEDITCLOSEW 66535 . 66878) (
|
||||
PARALASTWITHOUTEOL 66880 . 67765) (FIXPARALAST 67767 . 68301)) (68304 82803 (SPPRINT 68314 . 74899) (
|
||||
SPPRINT.CHAR 74901 . 75885) (SPPRINT.OBJ 75887 . 78945) (SHOWPIECEBYTES 78947 . 80503) (CHECKPLENGTHS
|
||||
80505 . 80962) (SBT 80964 . 81953) (COPYPCHAIN 81955 . 82801)) (82804 84865 (POSLINE 82814 . 84863)) (
|
||||
84866 85749 (PRESPLIT 84876 . 85747)) (85750 87463 (ALLTL 85760 . 87013) (NTHCHARSLOT 87015 . 87461))
|
||||
(87489 97702 (PLCHAIN 87499 . 88027) (PRINTLINE 88029 . 91019) (SL.GETLINES 91021 . 94314) (CHECKLINES
|
||||
94316 . 95296) (COLLECTLINES 95298 . 95550) (NTHLINE 95552 . 96557) (HEIGHT 96559 . 96847) (LINEBOTS
|
||||
96849 . 97700)) (97703 100151 (IPC.DECODEARGS 97713 . 100149)) (100152 100745 (SPF1 100162 . 100743))
|
||||
(100774 103152 (SLF.FATPLEN 100784 . 101643) (FILEPIECE 101645 . 103150)) (103185 103953 (SELTEDIT
|
||||
103195 . 103951)) (104023 109635 (PPARA 104033 . 104455) (PRUN 104457 . 105933) (ADDLINEPOSITIONS
|
||||
105935 . 107362) (SBR 107364 . 108018) (SBC 108020 . 109633)) (109692 114367 (DFOV 109702 . 112172) (
|
||||
OLDWI 112174 . 112549) (DFOV.OLDEST 112551 . 112976) (COMP 112978 . 113173) (DFR 113175 . 114365)) (
|
||||
114368 115401 (DFGV 114378 . 114904) (GDIRECTORIES 114906 . 115399)) (115402 121967 (TTEST 115412 .
|
||||
119944) (LTEST 119946 . 121311) (THC 121313 . 121965)) (122281 122973 (SHOWSAFE 122291 . 122971)) (
|
||||
123026 123473 (MYH 123036 . 123471)) (123718 124813 (DFVENUE 123728 . 124607) (VSEE 124609 . 124811))
|
||||
(124814 125268 (PTT 124824 . 125266)) (126515 128831 (TEDIT-DEBUG 126525 . 128829)) (128832 130568 (
|
||||
TRENAME 128842 . 130566)))))
|
||||
(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.
@@ -1,20 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Feb-2025 15:07:03" {WMEDLEY}<library>TEDIT>TEDIT.;765 155339
|
||||
(FILECREATED "20-Dec-2024 07:51:49" {WMEDLEY}<library>TEDIT>TEDIT.;731 154713
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.MAP.OBJECTS TEDIT.INSERT.OBJECT)
|
||||
:CHANGES-TO (FNS \TEDIT.WORD.FIRST)
|
||||
|
||||
:PREVIOUS-DATE "20-Feb-2025 08:50:50" {WMEDLEY}<library>TEDIT>TEDIT.;763)
|
||||
:PREVIOUS-DATE " 8-Dec-2024 21:39:48" {WMEDLEY}<library>TEDIT>TEDIT.;730)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDITCOMS)
|
||||
|
||||
(RPAQQ TEDITCOMS
|
||||
[(FILES (SYSLOAD)
|
||||
POSTSCRIPTSTREAM PDFSTREAM)
|
||||
(COMS (* ; "Loadup stuff")
|
||||
[(COMS (* ; "Loadup stuff")
|
||||
(VARS TEDITFILES)
|
||||
(FNS MAKE-TEDIT-EXPORTS.ALL UPDATE-TEDIT EDIT-TEDIT)
|
||||
(DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE
|
||||
@@ -34,8 +32,7 @@
|
||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||
(INITVARS (CHECK-TEDIT-ASSERTIONS T)))
|
||||
(MACROS OBJECT.ALLOWS)))
|
||||
(FILES TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS
|
||||
TEDIT-STYLES)
|
||||
(FILES TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS)
|
||||
[VARS (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP]
|
||||
(INITVARS (TEDIT.TENTATIVE NIL)
|
||||
(TEDIT.DEFAULT.PROPS NIL))
|
||||
@@ -53,7 +50,8 @@
|
||||
(FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD
|
||||
TEDIT.OBJECT.CHANGED TEDIT.MAP.OBJECTS \TEDIT.FIRST.OBJPIECE \TEDIT.NEXT.OBJPIECE)
|
||||
(FILES IMAGEOBJ))
|
||||
(FNS \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS \TEDIT.CONCAT.INSTALL.HEADINGS)
|
||||
(FNS \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS \TEDIT.CONCAT.INSTALL.HEADINGS
|
||||
\TEDIT.DO.BLUEPENDINGDELETE)
|
||||
(FNS \TEDIT.MOVE.MSG \TEDIT.READONLY)
|
||||
(FNS TEDIT.NCHARS TEDIT.RPLCHARCODE TEDIT.NTHCHARCODE TEDIT.NTHCHAR \TEDIT.PIECE.NTHCHARCODE)
|
||||
|
||||
@@ -80,18 +78,15 @@
|
||||
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
|
||||
(EXTENSION (TEDIT])
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
POSTSCRIPTSTREAM PDFSTREAM)
|
||||
|
||||
|
||||
|
||||
(* ; "Loadup stuff")
|
||||
|
||||
|
||||
(RPAQQ TEDITFILES (TEDIT TEDIT-PCTREE TEDIT-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND
|
||||
TEDIT-FILE TEDIT-OLDFILE TEDIT-LOOKS TEDIT-STYLES TEDIT-WINDOW TEDIT-BUTTONS
|
||||
TEDIT-MENU TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-PAGE
|
||||
TEDIT-ABBREV TEDIT-TFBRAVO))
|
||||
TEDIT-FILE TEDIT-OLDFILE TEDIT-LOOKS TEDIT-WINDOW TEDIT-BUTTONS TEDIT-MENU
|
||||
TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-PAGE TEDIT-ABBREV
|
||||
TEDIT-TFBRAVO))
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-TEDIT-EXPORTS.ALL
|
||||
@@ -105,19 +100,15 @@
|
||||
VAL])
|
||||
|
||||
(UPDATE-TEDIT
|
||||
[LAMBDA (FILES LDFLG) (* ; "Edited 16-Feb-2025 11:25 by rmk")
|
||||
(* ; "Edited 26-Oct-2022 21:10 by rmk")
|
||||
(CL:UNLESS LDFLG (SETQ LDFLG T))
|
||||
(for F in LOADEDFILELST eachtime (SETQ F (TRUEFILENAME F))
|
||||
when [AND (STRPOS ">library>tedit>TEDIT-" F 1 NIL NIL NIL UPPERCASEARRAY)
|
||||
(STRING.EQUAL 'LCOM (FILENAMEFIELD F 'EXTENSION] collect (FILENAMEFIELD F
|
||||
'NAME)
|
||||
finally
|
||||
[LAMBDA (FILES) (* ; "Edited 26-Oct-2022 21:10 by rmk")
|
||||
|
||||
(* ;; "Loading TEDIT will probably do the DOFILESLOAD for all the other files, this may be overkill. But we want to make sure the load's happen even if it looks like the files are already there (e.g. not LOAD?).")
|
||||
(* ;; "updates sysout with new versions of loaded files. Keeps the extension")
|
||||
|
||||
(RETURN (for LF in (CONS 'TEDIT (REMOVE 'TEDIT $$VAL))
|
||||
collect (PSEUDOFILENAME (LOAD LF LDFLG])
|
||||
(FOR FILE DIRFILE LOADEDFILE INSIDE (OR FILES TEDITFILES)
|
||||
WHEN [AND (SETQ LOADEDFILE (FOR F IN LOADEDFILELST WHEN (EQ FILE (FILENAMEFIELD F 'NAME))
|
||||
DO (RETURN F)))
|
||||
(SETQ DIRFILE (INFILEP (PACKFILENAME 'VERSION NIL 'BODY LOADEDFILE]
|
||||
UNLESS (EQ LOADEDFILE DIRFILE) COLLECT (LOAD DIRFILE T])
|
||||
|
||||
(EDIT-TEDIT
|
||||
[LAMBDA NIL (* ; "Edited 3-Jul-2023 13:44 by rmk")
|
||||
@@ -177,8 +168,7 @@
|
||||
|
||||
)
|
||||
|
||||
(FILESLOAD TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS TEDIT-STYLES
|
||||
)
|
||||
(FILESLOAD TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS)
|
||||
|
||||
(RPAQ TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP))
|
||||
|
||||
@@ -366,8 +356,7 @@
|
||||
NIL])
|
||||
|
||||
(TEDIT.CONCAT
|
||||
[LAMBDA (TSTREAMS SEPARATOR) (* ; "Edited 8-Feb-2025 20:58 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
[LAMBDA (TSTREAMS SEPARATOR) (* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
(* ; "Edited 18-Jan-2024 00:03 by rmk")
|
||||
|
||||
(* ;; "Produces a textstream that contains the concatenation of all of the TSTREAMS, separated by SEPARATOR. Any stream that is not already a text stream is first converted to a plaintext stream. SEPARATOR if provided as a string or character is inserted between the files.")
|
||||
@@ -387,7 +376,7 @@
|
||||
(* ;; "Take overall parameters from the first stream. ")
|
||||
|
||||
(FSETTOBJ CTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FIRSTTOBJ DEFAULTCHARLOOKS))
|
||||
(FSETTOBJ CTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ FIRSTTOBJ DEFAULTPARALOOKS))
|
||||
(FSETTOBJ CTEXTOBJ FMTSPEC (FGETTOBJ FIRSTTOBJ FMTSPEC))
|
||||
(FSETTOBJ CTEXTOBJ TXTRTBL (FGETTOBJ FIRSTTOBJ TXTRTBL))
|
||||
(FSETTOBJ CTEXTOBJ TXTWTBL (FGETTOBJ FIRSTTOBJ TXTWTBL))
|
||||
(FSETTOBJ CTEXTOBJ TXTSTYLESHEET (FGETTOBJ FIRSTTOBJ TXTSTYLESHEET))
|
||||
@@ -421,8 +410,6 @@
|
||||
(TEDITSTRING
|
||||
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
|
||||
|
||||
(* ;;; "Edited 20-Feb-2025 08:50 by rmk")
|
||||
|
||||
(* ;;; "Edited 31-Mar-2024 10:13 by rmk: If TEXT is NIL, don't coerce it to %"NIL%"")
|
||||
|
||||
(* ;;; "Edited 31-Mar-2024 10:12 by rmk")
|
||||
@@ -435,7 +422,7 @@
|
||||
|
||||
(CL:WHEN TEXT
|
||||
(SETQ TEXT (MKSTRING TEXT)))
|
||||
(TEDIT (LET ((TSTR (OPENTEXTSTREAM NIL NIL PROPS)))
|
||||
(TEDIT (LET ((TSTR (OPENTEXTSTREAM)))
|
||||
(TEDIT.INSERT TSTR TEXT 1 NIL T)
|
||||
(TEDIT.SETSEL TSTR 1 0 'LEFT)
|
||||
TSTR)
|
||||
@@ -584,10 +571,7 @@
|
||||
(TEDIT.DEACTIVATE.WINDOW TEDW))])
|
||||
|
||||
(TEDIT.QUIT
|
||||
[LAMBDA (TSTREAM VALUE) (* ; "Edited 12-Feb-2025 16:26 by rmk")
|
||||
(* ; "Edited 9-Feb-2025 21:22 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 23:45 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 09:12 by rmk")
|
||||
[LAMBDA (TSTREAM VALUE) (* ; "Edited 29-Jun-2024 09:12 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 20-Sep-2023 17:55 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 10:19 by rmk")
|
||||
@@ -595,14 +579,23 @@
|
||||
|
||||
(* ;; "Force the edit session supported by TSTREAM to terminate, and to return VALUE")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)))
|
||||
(LET (PRIMPANE (TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(FSETTOBJ TEXTOBJ EDITFINISHEDFLG (OR VALUE T)) (* ;
|
||||
"tell the command loop to stop next time through")
|
||||
(CL:WHEN [AND (SETQ PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE))
|
||||
(NEQ PRIMPANE (PROCESSPROP (TTY.PROCESS)
|
||||
'WINDOW]
|
||||
|
||||
(* ;; "Make sure the process has the TTY, then tell the command loop to finish.")
|
||||
(* ;; "there is a primary pane of the stream, and it is not the window of the tty process, so give it the tty")
|
||||
|
||||
(CL:WHEN (AND PRIMPANE (WINDOWPROP PRIMPANE 'PROCESS))
|
||||
(TTY.PROCESS (WINDOWPROP PRIMPANE 'PROCESS)))
|
||||
(FSETTOBJ TEXTOBJ EDITFINISHEDFLG (OR VALUE T])
|
||||
(TTY.PROCESS (WINDOWPROP PRIMPANE 'PROCESS))
|
||||
(AND (NEQ (TTY.PROCESS)
|
||||
(THIS.PROCESS))
|
||||
(until [OR (NOT (WINDOWPROP PRIMPANE 'PROCESS))
|
||||
(PROCESS.FINISHEDP (WINDOWPROP PRIMPANE 'PROCESS] do
|
||||
(* ;
|
||||
"Wait until the Edit process has had a chance to go away before continuing here.")
|
||||
(DISMISS))))])
|
||||
|
||||
(TEDIT.MOVE
|
||||
[LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk")
|
||||
@@ -749,10 +742,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.INSERT.OBJECT
|
||||
[LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 25-Feb-2025 11:18 by rmk")
|
||||
(* ; "Edited 2-Feb-2025 11:37 by rmk")
|
||||
(* ; "Edited 26-Dec-2024 10:13 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
[LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 08:46 by rmk")
|
||||
(* ; "Edited 30-Jul-2024 22:19 by rmk")
|
||||
(* ; "Edited 23-Jul-2024 22:20 by rmk")
|
||||
@@ -815,8 +805,8 @@
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(CL:WHEN (type? SELECTION CH#)
|
||||
(SETQ CH# (GETSEL CH# CH#)))
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE)
|
||||
(\TEDIT.DELETE TEXTOBJ SEL))
|
||||
(\TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) (* ;
|
||||
"Do the pending delete, if there is one.")
|
||||
(CL:WHEN CH#
|
||||
(\TEDIT.UPDATE.SEL SEL (IMIN CH# (ADD1 (TEXTLEN TEXTOBJ)))
|
||||
0
|
||||
@@ -824,7 +814,7 @@
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ))
|
||||
(\TEDIT.INSERT.SELPIECES OBJSELPIECES TEXTOBJ SEL)
|
||||
(CL:WHEN LOOKS (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS SEL))
|
||||
(\TEDIT.SCROLL.CARET TSTREAM)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(TEDIT.EDIT.OBJECT
|
||||
@@ -949,8 +939,7 @@
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "Changed object not found in document" T])
|
||||
|
||||
(TEDIT.MAP.OBJECTS
|
||||
[LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 25-Feb-2025 15:06 by rmk")
|
||||
(* ; "Edited 23-Apr-2024 09:15 by rmk")
|
||||
[LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 23-Apr-2024 09:15 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 16:12 by rmk")
|
||||
(* ; "Edited 6-Nov-2022 12:15 by rmk")
|
||||
@@ -965,13 +954,7 @@
|
||||
when (AND (EQ OBJECT.PTYPE (PTYPE PC))
|
||||
(type? IMAGEOBJ (SETQ OBJ (PCONTENTS PC)))
|
||||
(SETQ FNVAL (APPLY* FN CH# OBJ FNARG)))
|
||||
do (SELECTQ COLLECT?
|
||||
(NIL)
|
||||
(OBJECT (PUSH $$VAL OBJ))
|
||||
(CH# (PUSH $$VAL CH#))
|
||||
(VALUE (PUSH $$VAL CH#)
|
||||
FNVAL)
|
||||
(FIRST (RETURN (LIST CH# OBJ FNVAL)))
|
||||
do (CL:WHEN COLLECT?
|
||||
(PUSH $$VAL (LIST CH# OBJ FNVAL)))
|
||||
(CL:WHEN (EQ FNVAL 'STOP)
|
||||
(GO $$OUT)) finally (RETURN (DREVERSE $$VAL])
|
||||
@@ -989,13 +972,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.CONCAT.PAGEFRAMES
|
||||
[LAMBDA (CTEXTOBJ TSTEXTOBJECTS INITIALFILEPIECES) (* ; "Edited 19-Feb-2025 13:30 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:27 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 13:20 by rmk")
|
||||
[LAMBDA (CTEXTOBJ TSTEXTOBJECTS INITIALFILEPIECES) (* ; "Edited 17-Mar-2024 13:20 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 18-Jan-2024 22:16 by rmk")
|
||||
|
||||
(* ;; "The individual files may have their own heading paragraphs specified in their pieces and in their pageframes. Since the heading types are global for the file, we have to make sure the any conflicting heading-type names are made distinct within the combined toplevel pageframe, and that any new names are propagated into the PARALOOKS of the pieces within each file.")
|
||||
(* ;; "The individual files may have their own heading paragraphs specified in their pieces and in their pageframes. Since the heading types are global for the file, we have to make sure the any conflicting heading-type names are made distinct within the combined toplevel pageframe, and that any new names are propagated into the FMTSPEC's of the pieces within each file.")
|
||||
|
||||
(* ;;
|
||||
"Scan all the first/left/right heading frames, grouping all of the heading types by their regions.")
|
||||
@@ -1033,12 +1014,15 @@
|
||||
|
||||
[for PC PPARALOOKS (ALLNEW _ (APPEND FIRSTNEW LEFTNEW RIGHTNEW)) inpieces (\TEDIT.FIRSTPIECE
|
||||
CTEXTOBJ)
|
||||
eachtime (SETQ PPARALOOKS (PPARALOOKS PC)) when (EQ 'PAGEHEADING (GETPLOOKS PPARALOOKS
|
||||
FMTPARATYPE))
|
||||
do (FSETPC PC PPARALOOKS (create PARALOOKS using PPARALOOKS FMTPARASUBTYPE _
|
||||
(CADR (ASSOC (FGETPLOOKS PPARALOOKS
|
||||
FMTPARASUBTYPE)
|
||||
ALLNEW]
|
||||
eachtime (SETQ PPARALOOKS (PPARALOOKS PC)) when (EQ 'PAGEHEADING (fetch (FMTSPEC
|
||||
FMTPARATYPE
|
||||
)
|
||||
of PPARALOOKS))
|
||||
do (FSETPC PC PPARALOOKS (create FMTSPEC using PPARALOOKS FMTPARASUBTYPE _
|
||||
(CADR (ASSOC (fetch (FMTSPEC
|
||||
FMTPARASUBTYPE)
|
||||
of PPARALOOKS)
|
||||
ALLNEW]
|
||||
|
||||
(* ;; "Finally, build the pageframes for the new types and their regions. We take the page frame of the first TSOBJ as the base pattern")
|
||||
|
||||
@@ -1090,6 +1074,22 @@
|
||||
REGIONFILLMETHOD _ 'HEADING
|
||||
REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR R))
|
||||
REGIONSPEC _ (CADR R])])
|
||||
|
||||
(\TEDIT.DO.BLUEPENDINGDELETE
|
||||
[LAMBDA (SEL TEXTOBJ) (* ; "Edited 27-Nov-2024 12:05 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:33 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 00:01 by rmk")
|
||||
(* ; "Edited 8-Jul-2023 22:48 by rmk")
|
||||
(* ; "Edited 4-May-2023 00:05 by rmk")
|
||||
(* ; "Edited 22-Apr-2023 18:31 by rmk")
|
||||
(* ; "Edited 29-May-91 18:21 by jds")
|
||||
|
||||
(* ;; "Check for blue-pending-delete, and do it if it's there.")
|
||||
|
||||
(* ;; "Return T if the deletion was made. For people who need to know")
|
||||
|
||||
(CL:WHEN (GETTOBJ TEXTOBJ BLUEPENDINGDELETE)
|
||||
(\TEDIT.DELETE TEXTOBJ SEL T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1157,9 +1157,7 @@
|
||||
TEXTLEN))])
|
||||
|
||||
(TEDIT.RPLCHARCODE
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 9-Feb-2025 12:21 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 23-Sep-2024 00:36 by rmk")
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 23-Sep-2024 00:36 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 14:49 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 12:08 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
@@ -1182,8 +1180,8 @@
|
||||
(* ;; "NOTE: this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(PROG ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
|
||||
PC OFFSET START-OF-PIECE OLDCHAR PARALAST)
|
||||
(PROG ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||
PC OFFSET START-OF-PIECE PARALAST OLDCHAR)
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(CL:WHEN (ILESSP N 0)
|
||||
(add N (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
|
||||
@@ -1201,14 +1199,13 @@
|
||||
(replace (STREAM BINABLE) of TSTREAM with NIL)
|
||||
(SETQ PC (\TEDIT.CHTOPC N TEXTOBJ T))
|
||||
(SETQ OFFSET (ADD1 (IDIFFERENCE N START-OF-PIECE)))(* ; "Change is at OFFSET 1")
|
||||
(SETQ PARALAST (MEMB NEWCHARCODE (FGETTOBJ TEXTOBJ PARABREAKCHARS)))
|
||||
[if (AND (SMALLP NEWCHARCODE)
|
||||
(if [AND (SMALLP NEWCHARCODE)
|
||||
(MEMB (PTYPE PC)
|
||||
STRING.PTYPES)
|
||||
(OR (NULL NEWCHARLOOKS)
|
||||
(EQ NEWCHARLOOKS (PLOOKS PC)))
|
||||
(NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(NOT PARALAST))
|
||||
(NEQ PC (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(NOT (SETQ PARALAST (MEMB NEWCHARCODE (CHARCODE (EOL CR LF FORM]
|
||||
then
|
||||
(* ;;
|
||||
"Fast case: Smash a new character code into an existing string piece with same looks. ")
|
||||
@@ -1274,12 +1271,12 @@
|
||||
(\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
|
||||
NEWCHARLOOKS)
|
||||
TEXTOBJ)
|
||||
NEWCHARLOOKS)))]
|
||||
(CL:WHEN PARALAST (FSETPC PC PPARALAST T))
|
||||
NEWCHARLOOKS)))
|
||||
(CL:WHEN PARALAST (FSETPC PC PPARALAST T)))
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL OLDCHAR
|
||||
))
|
||||
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED N 1))
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION N 1))
|
||||
(RETURN TSTREAM])
|
||||
|
||||
(TEDIT.NTHCHARCODE
|
||||
@@ -1423,8 +1420,7 @@
|
||||
(T TSTREAM)))])
|
||||
|
||||
(\TEDIT.INSERT
|
||||
[LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 5-Jan-2025 23:01 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 09:53 by rmk")
|
||||
[LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 28-Nov-2024 09:53 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 22:05 by rmk")
|
||||
(* ; "Edited 18-Nov-2024 15:53 by rmk")
|
||||
(* ; "Edited 15-Nov-2024 18:05 by rmk")
|
||||
@@ -1476,7 +1472,7 @@
|
||||
(* ;; "It's maybe worth a scan here to see if we can insert the string. This avoids the heavier per-character complexity of \INSERTCH.")
|
||||
|
||||
(for CH instring INSERT as NCH# from CARETCHNO
|
||||
do (\TEDIT.INSERTCH CH NCH# TEXTOBJ (MEMB CH PARACHARS)))
|
||||
do (\TEDIT.INSERTCH CH NCH# TEXTOBJ PARACHARS))
|
||||
(SETQ NCHARSADDED (NCHARS INSERT))
|
||||
else (\TEDIT.INSERTCH INSERT CARETCHNO TEXTOBJ)
|
||||
(SETQ NCHARSADDED (NCHARS INSERT)))
|
||||
@@ -1508,8 +1504,7 @@
|
||||
(CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])])
|
||||
|
||||
(\TEDIT.MOVE
|
||||
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 6-Feb-2025 16:17 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 21:37 by rmk")
|
||||
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 8-Dec-2024 21:37 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 22:34 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 15:42 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:43 by rmk")
|
||||
@@ -1542,7 +1537,7 @@
|
||||
(TOCH# (FGETSEL TOSEL CH#))
|
||||
(TODCH (FGETSEL TOSEL DCH))
|
||||
(TOPOINT (FGETSEL TOSEL POINT))
|
||||
TODELEVENT FROMPIECES BPD)
|
||||
TODELEVENT FROMPIECES)
|
||||
(CL:WHEN (\TEDIT.MOVE.MSG FROMOBJ TOOBJ NIL)
|
||||
(RETURN NIL))
|
||||
|
||||
@@ -1552,78 +1547,68 @@
|
||||
|
||||
(* ;; "If FROM is in a different document, the Venue sysout leaves that documents SEL as it was before (i.e. not at the position of the deletion). Maybe it should be moved (and scrolled) to a point selection at the deletion site?")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "We'd like to check all the image objects for allowance before we make any changes, but we don't know whether the imageobject WHENxxx functions have side effects even if they decline. So we check only once, when we do the BPD operation or grab the from pieces. Since we are testing for MOVE, presumably the insert and delete are both OK.")
|
||||
|
||||
(* ;; " ")
|
||||
|
||||
(* ;; " Get rid of the BPD")
|
||||
|
||||
(CL:WHEN (AND (FGETTOBJ TOOBJ BLUEPENDINGDELETE)
|
||||
(IGREATERP TODCH 0))
|
||||
(FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL)
|
||||
(CL:UNLESS (\TEDIT.DELETE TOOBJ TOSEL)
|
||||
(RETURN NIL))
|
||||
(SETQ BPD T)
|
||||
(CL:WHEN (EQ TOOBJ FROMOBJ) (* ; "Same text, pre-adjust the source")
|
||||
(\TEDIT.SEL.DELETEDCHARS FROMSEL TOCH# TODCH)))
|
||||
(* ;; "Install FROM pieces at TO, first clearing out the blue pending delete. The move-event may be a composite of both. If we are doing a move in the same textobject, the TO selection (= SEL for a CTRL-SHIFT SELOPERATION) must be updated to reflect a preceding FROM-deletion.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "BPD is gone, TOSEL and FROMSEL have been adjusted")
|
||||
|
||||
(* ;; "Grab (a copy of) the source pieces, if image objects allow copying. FROMPIECES is essentially a clipboard for extract/insert--the FROMOBJ has not yet been changed.")
|
||||
|
||||
(SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROMSEL NIL FROMOBJ)
|
||||
'MOVE TOOBJ FROMOBJ))
|
||||
(CL:UNLESS FROMPIECES
|
||||
|
||||
(* ;; "If bailing, should we undo the BPDEVENT (if history is ON)?")
|
||||
|
||||
(RETURN))
|
||||
(\TEDIT.SHOWSEL FROMSEL NIL FROMOBJ)
|
||||
'COPY TOOBJ FROMOBJ))
|
||||
(CL:UNLESS FROMPIECES (RETURN))
|
||||
(\TEDIT.SHOWSEL FROMSEL NIL FROMOBJ) (* ; "Turn off any current highlighting")
|
||||
(\TEDIT.SHOWSEL TOSEL NIL TOOBJ)
|
||||
|
||||
(* ;; "No need to recheck allowance")
|
||||
|
||||
(if (EQ TOOBJ FROMOBJ)
|
||||
then
|
||||
(* ;;
|
||||
"Can't call \TEDIT.DELETE because we don't want to implicitly update the TOSEL for the insert.")
|
||||
|
||||
(\TEDIT.DELETE.SELPIECES FROMOBJ FROMSEL NIL T)
|
||||
(\TEDIT.SEL.DELETEDCHARS TOSEL FROMSEL)
|
||||
(\TEDIT.UPDATE.LINES FROMOBJ 'DELETION FROMSEL)
|
||||
|
||||
(* ;; "Pop to accumulate into a single event (BPD, DELETE, INSERT).")
|
||||
|
||||
else (\TEDIT.DELETE FROMOBJ FROMSEL NIL NIL T))
|
||||
|
||||
(* ;; "Deletion accomplished possibly in separate FROMOBJ with its own history.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
||||
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
|
||||
FROMSEL T)
|
||||
(CL:WHEN BPD (* ; "If no BPD, TO history is good")
|
||||
(\TEDIT.HISTORYADD.COMPOSITE TOOBJ TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ)
|
||||
(\TEDIT.POPEVENT TOOBJ))))
|
||||
(RETURN))
|
||||
(\TEDIT.INSERT.SELPIECES FROMPIECES TOOBJ TOSEL)
|
||||
(* ;; "Delete the FROM unless an object doesn't allow deletion.")
|
||||
|
||||
(if (EQ TOOBJ FROMOBJ)
|
||||
then
|
||||
(* ;; "In this case, TOSEL is SEL and FROMSEL is somewhere else in TOOBJ.")
|
||||
|
||||
(CL:UNLESS (\TEDIT.DELETE.SELPIECES FROMOBJ FROMSEL)
|
||||
(RETURN))
|
||||
(SETQ TODELEVENT (\TEDIT.POPEVENT TOOBJ))
|
||||
(* ;
|
||||
"Pop so the insert below doesn't bump the history count")
|
||||
(\TEDIT.UPDATE.LINES FROMOBJ 'DELETION FROMSEL)
|
||||
(\TEDIT.SEL.DELETEDCHARS TOSEL FROMSEL)
|
||||
|
||||
(* ;; "TOSEL has been adjusted to after-deletion chnos, but lines have not yet been updated/displayed and TOSEL has not been fixed.")
|
||||
|
||||
elseif (\TEDIT.DELETE FROMOBJ FROMSEL)
|
||||
then
|
||||
(* ;; "The FROM deletion has been accomplished, and FROM's history is good. If the destination is foreign, that's not our problem.")
|
||||
|
||||
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
||||
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
|
||||
FROMSEL T)
|
||||
(RETURN))
|
||||
else (RETURN))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(if (FGETTOBJ TOOBJ BLUEPENDINGDELETE)
|
||||
then (FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL)
|
||||
(\TEDIT.REPLACE.SELPIECES FROMPIECES TOOBJ TOSEL)
|
||||
else (\TEDIT.INSERT.SELPIECES FROMPIECES TOOBJ TOSEL))
|
||||
|
||||
(* ;;
|
||||
"TO's history has either a single replace or insert, depending on its BLUEPENDINGDELETE")
|
||||
|
||||
(\TEDIT.SET.SEL.LOOKS TOSEL 'NORMAL)
|
||||
(\TEDIT.FIXSEL TOSEL TOOBJ)
|
||||
(\TEDIT.SHOWSEL TOSEL T TOOBJ)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "TO history in order has INS, DEL if TO=FROM, and possibly BPD. (DEL) (BPD), put them all in a composite event. ")
|
||||
(* ;; "TO's last history event is either a single replace or insert, depending on its BLUEPENDINGDELETE. If there is also a preceding TODELEVENT, we combine both events into a single Move. There is no history connection between the deletion and insertion events if they happen in separate documents, they have to be undone separately. Otherwise, we would have to make sure that both documents at both reverted to just after this move before we could undo either of them. ")
|
||||
|
||||
(\TEDIT.HISTORYADD.COMPOSITE TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ)
|
||||
(CL:IF (EQ TOOBJ FROMOBJ)
|
||||
(\TEDIT.POPEVENT TOOBJ))
|
||||
(CL:IF BPD (\TEDIT.POPEVENT TOOBJ])])
|
||||
(CL:WHEN TODELEVENT (* ; "We popped it above")
|
||||
(\TEDIT.HISTORYADD TOOBJ (\TEDIT.HISTORY.EVENT TOOBJ :Move TOCH# TODCH TOPOINT NIL
|
||||
(LIST (\TEDIT.POPEVENT TOOBJ)
|
||||
TODELEVENT))))])])
|
||||
|
||||
(\TEDIT.COPY
|
||||
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 23-Nov-2024 22:45 by rmk")
|
||||
@@ -1992,8 +1977,7 @@
|
||||
OBJ])
|
||||
|
||||
(\TEDIT.DELETE
|
||||
[LAMBDA (TEXTOBJ TARGETSEL/CHAR LEN POINT DONTCHECK) (* ; "Edited 6-Feb-2025 00:14 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 21:39 by rmk")
|
||||
[LAMBDA (TEXTOBJ TARGETSEL/CHAR LEN POINT) (* ; "Edited 8-Dec-2024 21:39 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 10:13 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 09:18 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 22:30 by rmk")
|
||||
@@ -2039,7 +2023,7 @@
|
||||
[SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ (CL:IF (EQ POINT 'LEFT)
|
||||
(SUB1 FIRSTCHAR)
|
||||
(IPLUS FIRSTCHAR LEN))]
|
||||
(CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ FIRSTCHAR LEN DONTCHECK)
|
||||
(CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ FIRSTCHAR LEN)
|
||||
(* ;
|
||||
"Delete the selected characters (if objects allow)")
|
||||
|
||||
@@ -2249,9 +2233,7 @@
|
||||
SPLASTCHAR _ (CAR LAST])
|
||||
|
||||
(\TEDIT.PARA.FIRST
|
||||
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 30-Jan-2025 12:02 by rmk")
|
||||
(* ; "Edited 11-Jan-2025 00:08 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 10:10 by rmk")
|
||||
(* ; "Edited 26-Dec-2023 09:14 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 22:14 by rmk")
|
||||
@@ -2264,8 +2246,8 @@
|
||||
else (LET (CHPIECE START-OF-PIECE START)
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(if (type? SELPIECES CHNO)
|
||||
then (SETQ CHPIECE (GETSPC CHNO SPFIRST))
|
||||
(SETQ START (GETSPC CHNO SPFIRSTCHAR))
|
||||
then (SETQ CHPIECE (fetch (SELPIECES SPFIRST) of CHNO))
|
||||
(SETQ START (fetch (SELPIECES SPFIRSTCHAR) of CHNO))
|
||||
elseif (type? PIECE CHNO)
|
||||
then (SETQ START (\TEDIT.PCTOCH CHNO TEXTOBJ))
|
||||
(SETQ CHPIECE CHNO)
|
||||
@@ -2280,27 +2262,25 @@
|
||||
|
||||
(for PC (PLENTOT _ 0) backpieces (AND CHPIECE (PREVPIECE CHPIECE))
|
||||
when (VISIBLEPIECEP PC) until (PPARALAST PC)
|
||||
until (AND PROTECTEDNOTOK (GETCLOOKS (PLOOKS PC)
|
||||
CLPROTECTED)) do (add PLENTOT (PLEN PC))
|
||||
finally
|
||||
until (AND PROTECTEDNOTOK (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)))
|
||||
do (add PLENTOT (PLEN PC)) finally
|
||||
|
||||
(* ;; "If the iteration reached the beginning, there is no PREVPIECE. Otherwise, PC is the previous PARALAST, and we have to take its next")
|
||||
(* ;;
|
||||
"We overshot on PC, its NEXT is the winner. If no PC, we hit the text beginning")
|
||||
|
||||
(RETURN (CONS (IDIFFERENCE START PLENTOT)
|
||||
(CL:IF PC
|
||||
(NEXTPIECE PC)
|
||||
(\TEDIT.FIRSTPIECE TEXTOBJ))])
|
||||
(RETURN (CONS (IDIFFERENCE START PLENTOT)
|
||||
(CL:IF PC
|
||||
(NEXTPIECE PC)
|
||||
(\TEDIT.FIRSTPIECE TEXTOBJ))])
|
||||
|
||||
(\TEDIT.PARA.LAST
|
||||
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 7-Feb-2025 08:32 by rmk")
|
||||
(* ; "Edited 31-Jan-2025 09:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 10:37 by rmk")
|
||||
(* ; "Edited 26-Dec-2023 09:14 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 22:16 by rmk")
|
||||
(* ; "Edited 11-Dec-2023 23:02 by rmk")
|
||||
|
||||
(* ;; "Returns (LASTCHARNO . LASTPIECE) of the paragraph containing CHNO. If CHNO is SELPIECES or SELECTION, CHNO is taken as its last character. LASTCHARNO is the number of the last character of the paragraph (presumably on EOL). It is also the character of LASTPIECE, because pargraphs end on piece boundaries. When PROTECTEDNOTOK, the scan will terminated on a protected piece, even if that isn't the beginning of the paragraph.")
|
||||
(* ;; "Returns (LASTCHARNO .LASTPIECE) of the paragraph containing CHNO. If CHNO is SELPIECES or SELECTION, CHNO is taken as its last character. LASTCHARNO is the number of the last character of the paragraph (presumably on EOL). It is also the character of LASTPIECE, because pargraphs end on piece boundaries. When PROTECTEDNOTOK, the scan will terminated on a protected piece, even if that isn't the beginning of the paragraph.")
|
||||
|
||||
(if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (* ; "Empty document")
|
||||
@@ -2308,16 +2288,15 @@
|
||||
else (LET (CHPIECE START-OF-PIECE END FORMATTED)
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(if (type? SELPIECES CHNO)
|
||||
then (SETQ CHPIECE (GETSPC CHNO SPLAST))
|
||||
[SETQ END (SUB1 (IDIFFERENCE (GETSPC CHNO SPLASTCHAR)
|
||||
then (SETQ CHPIECE (fetch (SELPIECES SPLAST) of CHNO))
|
||||
[SETQ END (SUB1 (IDIFFERENCE (fetch (SELPIECES SPLASTCHAR) of CHNO)
|
||||
(PLEN CHPIECE]
|
||||
elseif (type? PIECE CHNO)
|
||||
then (SETQ CHPIECE CHNO)
|
||||
(SETQ END (\TEDIT.PCTOCH CHNO TEXTOBJ))
|
||||
else (SETQ CHPIECE (\TEDIT.CHTOPC (IMIN (CL:IF (type? SELECTION CHNO)
|
||||
(FGETSEL CHNO CHLAST)
|
||||
CHNO)
|
||||
(TEXTLEN TEXTOBJ))
|
||||
else (SETQ CHPIECE (\TEDIT.CHTOPC (CL:IF (type? SELECTION CHNO)
|
||||
(SUB1 (FGETSEL CHNO CHLIM))
|
||||
CHNO)
|
||||
TEXTOBJ T))
|
||||
(SETQ END START-OF-PIECE)) (* ; "Find the paragraph's last char")
|
||||
|
||||
@@ -2325,8 +2304,7 @@
|
||||
|
||||
(for PC (PLENTOT _ 0) inpieces CHPIECE when (VISIBLEPIECEP PC)
|
||||
do (add PLENTOT (PLEN PC)) repeatuntil (PPARALAST PC)
|
||||
repeatuntil (AND PROTECTEDNOTOK (FGETCLOOKS (PLOOKS PC)
|
||||
CLPROTECTED))
|
||||
repeatuntil (AND PROTECTEDNOTOK (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)))
|
||||
finally (RETURN (CONS (IMIN (IPLUS END PLENTOT -1)
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
PC])
|
||||
@@ -2500,7 +2478,7 @@
|
||||
(* ; "TEDIT Support information")
|
||||
|
||||
|
||||
(RPAQQ TEDITSYSTEMDATE "25-Feb-2025 15:07:03")
|
||||
(RPAQQ TEDITSYSTEMDATE "20-Dec-2024 07:51:50")
|
||||
|
||||
|
||||
|
||||
@@ -2510,27 +2488,28 @@
|
||||
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
|
||||
(EXTENSION (TEDIT))))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4651 6994 (MAKE-TEDIT-EXPORTS.ALL 4661 . 5207) (UPDATE-TEDIT 5209 . 6223) (EDIT-TEDIT
|
||||
6225 . 6992)) (8688 36922 (TEDIT 8698 . 11276) (TEXTSTREAM 11278 . 13198) (TEXTSTREAMP 13200 . 13584)
|
||||
(TEDITMENUP 13586 . 14352) (COERCETEXTSTREAM 14354 . 18565) (TEDIT.CONCAT 18567 . 21873) (TEDITSTRING
|
||||
21875 . 22789) (TEDIT-SEE 22791 . 23350) (TEDIT.COPY 23352 . 25497) (TEDIT.DELETE 25499 . 26751) (
|
||||
TEDIT.INSERT 26753 . 29711) (TEDIT.TERPRI 29713 . 30827) (TEDIT.KILL 30829 . 31745) (TEDIT.QUIT 31747
|
||||
. 33113) (TEDIT.MOVE 33115 . 34003) (TEDIT.STRINGWIDTH 34005 . 34676) (TEDIT.CHARWIDTH 34678 . 36920)
|
||||
) (36923 38864 (TEXTOBJ 36933 . 37398) (COERCETEXTOBJ 37400 . 38862)) (40264 41320 (TDRIBBLE 40274 .
|
||||
41318)) (41361 56908 (TEDIT.INSERT.OBJECT 41371 . 46212) (TEDIT.EDIT.OBJECT 46214 . 48555) (
|
||||
TEDIT.FIND.OBJECT 48557 . 50065) (TEDIT.FIND.OBJECT.BACKWARD 50067 . 51994) (TEDIT.OBJECT.CHANGED
|
||||
51996 . 54863) (TEDIT.MAP.OBJECTS 54865 . 56436) (\TEDIT.FIRST.OBJPIECE 56438 . 56671) (
|
||||
\TEDIT.NEXT.OBJPIECE 56673 . 56906)) (56931 64374 (\TEDIT.CONCAT.PAGEFRAMES 56941 . 62008) (
|
||||
\TEDIT.GET.PAGE.HEADINGS 62010 . 63039) (\TEDIT.CONCAT.INSTALL.HEADINGS 63041 . 64372)) (64375 67804 (
|
||||
\TEDIT.MOVE.MSG 64385 . 66466) (\TEDIT.READONLY 66468 . 67802)) (67805 82641 (TEDIT.NCHARS 67815 .
|
||||
68188) (TEDIT.RPLCHARCODE 68190 . 76205) (TEDIT.NTHCHARCODE 76207 . 78564) (TEDIT.NTHCHAR 78566 .
|
||||
78824) (\TEDIT.PIECE.NTHCHARCODE 78826 . 82639)) (82687 137139 (\TEDIT1 82697 . 84774) (\TEDIT.INSERT
|
||||
84776 . 90753) (\TEDIT.MOVE 90755 . 98105) (\TEDIT.COPY 98107 . 102085) (\TEDIT.REPLACE.SELPIECES
|
||||
102087 . 106067) (\TEDIT.INSERT.SELPIECES 106069 . 108954) (\TEDIT.RESTARTFN 108956 . 111461) (
|
||||
\TEDIT.CHARDELETE 111463 . 114290) (\TEDIT.COPYPIECE 114292 . 119140) (\TEDIT.APPLY.OBJFN 119142 .
|
||||
122339) (\TEDIT.DELETE 122341 . 127269) (\TEDIT.DIFFUSE.PARALOOKS 127271 . 129542) (\TEDIT.WORDDELETE
|
||||
129544 . 131100) (\TEDIT.WORDDELETE.FORWARD 131102 . 132774) (\TEDIT.FINISHEDIT? 132776 . 137137)) (
|
||||
137140 137799 (\TEDIT.THELP 137150 . 137797)) (137833 145723 (\TEDIT.PARAPIECES 137843 . 139817) (
|
||||
\TEDIT.PARA.FIRST 139819 . 142686) (\TEDIT.PARA.LAST 142688 . 145721)) (145724 154689 (
|
||||
\TEDIT.WORD.FIRST 145734 . 150390) (\TEDIT.WORD.LAST 150392 . 154687)))))
|
||||
(FILEMAP (NIL (4507 6449 (MAKE-TEDIT-EXPORTS.ALL 4517 . 5063) (UPDATE-TEDIT 5065 . 5678) (EDIT-TEDIT
|
||||
5680 . 6447)) (8122 36577 (TEDIT 8132 . 10710) (TEXTSTREAM 10712 . 12632) (TEXTSTREAMP 12634 . 13018)
|
||||
(TEDITMENUP 13020 . 13786) (COERCETEXTSTREAM 13788 . 17999) (TEDIT.CONCAT 18001 . 21180) (TEDITSTRING
|
||||
21182 . 22035) (TEDIT-SEE 22037 . 22596) (TEDIT.COPY 22598 . 24743) (TEDIT.DELETE 24745 . 25997) (
|
||||
TEDIT.INSERT 25999 . 28957) (TEDIT.TERPRI 28959 . 30073) (TEDIT.KILL 30075 . 30991) (TEDIT.QUIT 30993
|
||||
. 32768) (TEDIT.MOVE 32770 . 33658) (TEDIT.STRINGWIDTH 33660 . 34331) (TEDIT.CHARWIDTH 34333 . 36575)
|
||||
) (36578 38519 (TEXTOBJ 36588 . 37053) (COERCETEXTOBJ 37055 . 38517)) (39919 40975 (TDRIBBLE 39929 .
|
||||
40973)) (41016 55977 (TEDIT.INSERT.OBJECT 41026 . 45617) (TEDIT.EDIT.OBJECT 45619 . 47960) (
|
||||
TEDIT.FIND.OBJECT 47962 . 49470) (TEDIT.FIND.OBJECT.BACKWARD 49472 . 51399) (TEDIT.OBJECT.CHANGED
|
||||
51401 . 54268) (TEDIT.MAP.OBJECTS 54270 . 55505) (\TEDIT.FIRST.OBJPIECE 55507 . 55740) (
|
||||
\TEDIT.NEXT.OBJPIECE 55742 . 55975)) (56000 64557 (\TEDIT.CONCAT.PAGEFRAMES 56010 . 61144) (
|
||||
\TEDIT.GET.PAGE.HEADINGS 61146 . 62175) (\TEDIT.CONCAT.INSTALL.HEADINGS 62177 . 63508) (
|
||||
\TEDIT.DO.BLUEPENDINGDELETE 63510 . 64555)) (64558 67987 (\TEDIT.MOVE.MSG 64568 . 66649) (
|
||||
\TEDIT.READONLY 66651 . 67985)) (67988 82609 (TEDIT.NCHARS 67998 . 68371) (TEDIT.RPLCHARCODE 68373 .
|
||||
76173) (TEDIT.NTHCHARCODE 76175 . 78532) (TEDIT.NTHCHAR 78534 . 78792) (\TEDIT.PIECE.NTHCHARCODE 78794
|
||||
. 82607)) (82655 136918 (\TEDIT1 82665 . 84742) (\TEDIT.INSERT 84744 . 90602) (\TEDIT.MOVE 90604 .
|
||||
98003) (\TEDIT.COPY 98005 . 101983) (\TEDIT.REPLACE.SELPIECES 101985 . 105965) (
|
||||
\TEDIT.INSERT.SELPIECES 105967 . 108852) (\TEDIT.RESTARTFN 108854 . 111359) (\TEDIT.CHARDELETE 111361
|
||||
. 114188) (\TEDIT.COPYPIECE 114190 . 119038) (\TEDIT.APPLY.OBJFN 119040 . 122237) (\TEDIT.DELETE
|
||||
122239 . 127048) (\TEDIT.DIFFUSE.PARALOOKS 127050 . 129321) (\TEDIT.WORDDELETE 129323 . 130879) (
|
||||
\TEDIT.WORDDELETE.FORWARD 130881 . 132553) (\TEDIT.FINISHEDIT? 132555 . 136916)) (136919 137578 (
|
||||
\TEDIT.THELP 136929 . 137576)) (137612 145097 (\TEDIT.PARAPIECES 137622 . 139596) (\TEDIT.PARA.FIRST
|
||||
139598 . 142364) (\TEDIT.PARA.LAST 142366 . 145095)) (145098 154063 (\TEDIT.WORD.FIRST 145108 . 149764
|
||||
) (\TEDIT.WORD.LAST 149766 . 154061)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Feb-2025 15:02:06" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;218 125051
|
||||
(FILECREATED "22-Dec-2024 22:47:22" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;200 119344
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MB.FIELD.CREATE MB.SPEC.REMAINDER MB.NWAY.SIZEFN MB.NWAY.CREATE)
|
||||
(VARS TEDIT-BUTTONSCOMS)
|
||||
:CHANGES-TO (FNS MB.3STATE.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "16-Feb-2025 11:10:40" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;214)
|
||||
:PREVIOUS-DATE "20-Dec-2024 22:19:48" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;198)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||
@@ -24,7 +23,8 @@
|
||||
[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")
|
||||
|
||||
@@ -32,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")
|
||||
|
||||
@@ -41,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])
|
||||
|
||||
|
||||
@@ -68,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")
|
||||
@@ -89,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")
|
||||
@@ -172,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")
|
||||
@@ -256,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")
|
||||
@@ -320,8 +315,6 @@
|
||||
|
||||
(MB.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON)
|
||||
(* ; "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")
|
||||
@@ -330,10 +323,8 @@
|
||||
|
||||
(* ;; "Called when a mouse-button is down inside the object, RELX and RELY are in the objects coordinate system. Decline unless it is a normal left-button selection within the object.")
|
||||
|
||||
(TEDIT.PROMPTCLEAR MENUSTREAM)
|
||||
(if [OR (EQ BUTTON 'RIGHT)
|
||||
(SHIFTDOWNP 'CTRL)
|
||||
(SHIFTDOWNP 'SHIFT)
|
||||
(LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
|
||||
(OR (ILESSP RELX 0)
|
||||
(ILESSP RELY 0)
|
||||
@@ -524,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")
|
||||
@@ -545,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)
|
||||
@@ -591,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)
|
||||
@@ -634,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
|
||||
|
||||
@@ -727,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")
|
||||
@@ -736,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)
|
||||
@@ -811,6 +778,10 @@
|
||||
(TEDIT.BACKTOMAIN MENUTSTREAM)))
|
||||
'DON'T])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.3STATE.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.3STATE.INIT)
|
||||
@@ -828,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")
|
||||
@@ -856,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)
|
||||
@@ -1022,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")
|
||||
@@ -1040,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)
|
||||
@@ -1151,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")
|
||||
@@ -1160,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)
|
||||
@@ -1203,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")
|
||||
@@ -1218,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]
|
||||
@@ -1279,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)
|
||||
@@ -1331,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")
|
||||
@@ -1340,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)
|
||||
@@ -1465,6 +1418,10 @@
|
||||
((DESELECTED HIGHLIGHTED UNHIGHLIGHTED))
|
||||
NIL])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MB.TOGGLE.IMAGEFNS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MB.TOGGLE.INIT)
|
||||
@@ -1477,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")
|
||||
@@ -1509,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)))
|
||||
@@ -1535,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])
|
||||
|
||||
@@ -1597,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")
|
||||
@@ -1629,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))
|
||||
@@ -1646,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])
|
||||
|
||||
@@ -1678,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")
|
||||
@@ -1689,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)
|
||||
@@ -1965,31 +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 (3338 19860 (MB.ADD 3348 . 9777) (MB.DELETE 9779 . 10153) (MB.GET 10155 . 16925) (
|
||||
MB.GET.MBARG 16927 . 18596) (TEDITMENU.STREAM 18598 . 19265) (TEDIT.BACKTOMAIN 19267 . 19858)) (19904
|
||||
39766 (MB.BUTTONEVENTINFN 19914 . 21408) (MB.DISPLAYFN 21410 . 23469) (MB.SETIMAGE 23471 . 24639) (
|
||||
MB.SIZEFN 24641 . 26189) (MB.WHENOPERATEDONFN 26191 . 28140) (MB.COPYFN 28142 . 28600) (MB.GETFN 28602
|
||||
. 29563) (MB.PUTFN 29565 . 30665) (MB.SHOWSELFN 30667 . 32176) (MB.CREATE 32178 . 36201) (
|
||||
MB.CHANGENAME 36203 . 36685) (MB.INIT 36687 . 38148) (MB.TRACK.UNTIL 38150 . 38845) (MB.DON'T 38847 .
|
||||
39143) (MB.SPEC.REMAINDER 39145 . 39764)) (39928 49918 (MB.3STATE.CREATE 39938 . 40802) (
|
||||
MB.3STATE.DISPLAYFN 40804 . 41790) (MB.3STATE.SHOWSELFN 41792 . 44103) (MB.3STATE.INIT 44105 . 45516)
|
||||
(MB.3STATE.SETSTATEFN 45518 . 46176) (MB.3STATE.BUTTONEVENTINFN 46178 . 49916)) (50073 80741 (
|
||||
MB.NWAY.CREATE 50083 . 56125) (MB.NWAY.DISPLAYFN 56127 . 56990) (MB.NWAY.WHENOPERATEDONFN 56992 .
|
||||
59182) (MB.NWAY.SIZEFN 59184 . 63120) (MB.NWAY.SELECT 63122 . 66692) (MB.NWAY.BUTTONEVENTINFN 66694 .
|
||||
69906) (MB.NWAY.NEWMENUBUTTON 69908 . 70620) (MB.NWAY.COPYFN 70622 . 71589) (MB.NWAY.INIT 71591 .
|
||||
73082) (MB.NWAY.ARRANGEBUTTONS 73084 . 75055) (MB.NWAY.ADDITEM 75057 . 78919) (MB.NWAY.FINDSUBOBJ
|
||||
78921 . 79435) (MB.NWAY.SETSTATEFN 79437 . 80739)) (80820 92707 (MB.TOGGLE.CREATE 80830 . 81825) (
|
||||
MB.TOGGLE.DISPLAYFN 81827 . 83310) (MB.TOGGLE.INIT 83312 . 85111) (MB.SET.TOGGLE 85113 . 86314) (
|
||||
MB.TOGGLE.SETSTATEFN 86316 . 87156) (MB.TOGGLE.BUTTONEVENTINFN 87158 . 91362) (
|
||||
MB.TOGGLE.WHENOPERATEDONFN 91364 . 92705)) (92788 124972 (MB.FIELD.CREATE 92798 . 98249) (
|
||||
MB.FIELD.DISPLAYFN 98251 . 99042) (MB.FIELD.IMAGEBOXFN 99044 . 100526) (MB.FIELD.PREFIXCREATE 100528
|
||||
. 104464) (MB.FIELD.SUFFIXCREATE 104466 . 106126) (MB.FIELD.INIT 106128 . 107895) (
|
||||
MB.FIELD.WHENOPERATEDONFN 107897 . 109168) (MB.FIELD.GETSTATEFN 109170 . 113104) (MB.FIELD.SETSTATEFN
|
||||
113106 . 117801) (MB.FIELD.BUTTONEVENTINFN 117803 . 120108) (MB.FIELD.SIZEFN 120110 . 120350) (
|
||||
MB.FIELD.INSURETYPE 120352 . 124970)))))
|
||||
(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 "17-Feb-2025 12:25:49" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;135 49397
|
||||
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133 49278
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
|
||||
|
||||
:PREVIOUS-DATE "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133)
|
||||
:PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
|
||||
@@ -255,8 +255,7 @@
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.COMMAND.LOOP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Feb-2025 12:05 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 10:01 by rmk")
|
||||
[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")
|
||||
@@ -320,8 +319,8 @@
|
||||
(* ;;
|
||||
"And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
|
||||
|
||||
(CL:UNLESS (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(OR (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CH))
|
||||
(CHARDELETE.TTC
|
||||
@@ -912,12 +911,12 @@
|
||||
|
||||
(\TEDIT.CLIPBOARD)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8312 26689 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
|
||||
\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 20097) (\TEDIT.COMMAND.RESET.SETUP
|
||||
20099 . 26687)) (26973 42170 (\TEDIT.READTABLE 26983 . 28640) (\TEDIT.WORDBOUND.READTABLE 28642 .
|
||||
31235) (TEDIT.GETSYNTAX 31237 . 33676) (TEDIT.SETSYNTAX 33678 . 36156) (TEDIT.GETFUNCTION 36158 .
|
||||
37518) (TEDIT.SETFUNCTION 37520 . 39959) (TEDIT.WORDGET 39961 . 40222) (TEDIT.WORDSET 40224 . 40921) (
|
||||
TEDIT.ATOMBOUND.READTABLE 40923 . 42168)) (42498 43407 (\TEDIT.WHEELSCROLL 42508 . 43405)) (43560
|
||||
49140 (\TEDIT.CLIPBOARD 43570 . 45325) (\TEDIT.COPYTOCLIPBOARD 45327 . 46107) (
|
||||
\TEDIT.EXTRACTTOCLIPBOARD 46109 . 46304) (\TEDIT.WRITE.SEL 46306 . 49138)))))
|
||||
(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,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "22-Feb-2025 16:00:43" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;604 161000
|
||||
(FILECREATED "23-Dec-2024 23:02:54" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;592 159471
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.PUT)
|
||||
:CHANGES-TO (FNS TEDIT.PUT TEDIT.PUT.STREAM)
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-2025 12:11:42" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;603)
|
||||
:PREVIOUS-DATE "16-Dec-2024 11:25:16" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;591)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -249,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")
|
||||
@@ -365,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]
|
||||
|
||||
@@ -390,8 +389,7 @@
|
||||
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
|
||||
|
||||
(TEDIT.PUT
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "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")
|
||||
@@ -481,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)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -511,9 +508,8 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:UNLESS QUIET
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -576,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")
|
||||
@@ -612,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")
|
||||
@@ -640,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})))
|
||||
@@ -682,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")
|
||||
@@ -717,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")
|
||||
@@ -738,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
|
||||
@@ -899,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")
|
||||
@@ -924,8 +914,7 @@
|
||||
DEFAULTCHARLOOKS
|
||||
))
|
||||
(SETQ OLDPARALOOKS (FGETTOBJ TEXTOBJ
|
||||
DEFAULTPARALOOKS
|
||||
))
|
||||
FMTSPEC))
|
||||
(SETQ FIRSTPC (CREATE PIECE))
|
||||
(* ; "Throw away at the end")
|
||||
(SETQ PREVPC FIRSTPC)
|
||||
@@ -1410,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")
|
||||
@@ -1431,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)) (* ;
|
||||
@@ -1440,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]
|
||||
@@ -1454,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])
|
||||
|
||||
@@ -1541,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")
|
||||
@@ -1558,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 _
|
||||
@@ -1596,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
|
||||
|
||||
@@ -1937,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")
|
||||
@@ -1955,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))
|
||||
@@ -1975,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))
|
||||
@@ -1992,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))
|
||||
@@ -2178,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")
|
||||
@@ -2227,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)
|
||||
@@ -2354,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")
|
||||
@@ -2370,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)
|
||||
@@ -2413,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.)")
|
||||
|
||||
@@ -2463,8 +2457,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDITFROMLISPSOURCE
|
||||
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "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")
|
||||
@@ -2481,17 +2474,16 @@
|
||||
(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 110 (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
|
||||
@@ -2519,28 +2511,28 @@
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4999 34243 (TEDIT.GET 5009 . 11018) (TEDIT.FORMATTEDFILEP 11020 . 12336) (
|
||||
TEDIT.FILEDATE 12338 . 13509) (TEDIT.INCLUDE 13511 . 21540) (TEDIT.RAW.INCLUDE 21542 . 22350) (
|
||||
TEDIT.PUT 22352 . 30408) (TEDIT.PUT.STREAM 30410 . 34241)) (34244 54014 (\TEDIT.GET.FOREIGN.FILE 34254
|
||||
. 37679) (\TEDIT.GET.UNFORMATTED.FILE 37681 . 41673) (\TEDIT.GET.FORMATTED.FILE 41675 . 44593) (
|
||||
\TEDIT.FORMATTEDSTREAMP 44595 . 47613) (\ARBIN 47615 . 48335) (\ATMIN 48337 . 48874) (\DWIN 48876 .
|
||||
49255) (\STRINGIN 49257 . 49965) (\TEDIT.GET.TRAILER 49967 . 52483) (\TEDIT.CACHEFILE 52485 . 54012))
|
||||
(54180 67934 (\TEDIT.GET.PIECES3 54190 . 64696) (\TEDIT.GET.IDATE3 64698 . 66093) (
|
||||
\TEDIT.MAKE.STRINGPIECE 66095 . 67932)) (67935 80310 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 67945 . 74061)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 74063 . 80308)) (80332 86354 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80342 .
|
||||
86352)) (86377 95002 (\TEDIT.GET.CHARLOOKS.LIST 86387 . 87118) (\TEDIT.GET.SINGLE.CHARLOOKS 87120 .
|
||||
91814) (\TEDIT.GET.CHARLOOKS 91816 . 93146) (\TEDIT.GET.PARALOOKS.INDEX 93148 . 93692) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 93694 . 95000)) (95003 102660 (\TEDIT.GET.PARALOOKS.LIST 95013 . 95635) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 95637 . 102658)) (102661 106251 (\TEDIT.GET.OBJECT 102671 . 106249)) (
|
||||
106313 138190 (\TEDIT.PUT.PCTB 106323 . 115973) (\TEDIT.PUT.PCTB.PIECEDATA 115975 . 119173) (
|
||||
\TEDIT.PUT.TRAILER 119175 . 119942) (\TEDIT.PUT.PCTB.MERGEABLE 119944 . 123378) (
|
||||
\TEDIT.PUT.UTF8.SPLITPIECES 123380 . 128082) (\TEDIT.PUT.PCTB.NEXTNEW 128084 . 132351) (
|
||||
\TEDIT.INSERT.NEWPIECES 132353 . 135788) (\TEDIT.PUTRESET 135790 . 136032) (\ARBOUT 136034 . 136758) (
|
||||
\ATMOUT 136760 . 137365) (\DWOUT 137367 . 137646) (\STRINGOUT 137648 . 138188)) (138191 150266 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 138201 . 139873) (\TEDIT.PUT.SINGLE.CHARLOOKS 139875 . 145610) (
|
||||
\TEDIT.PUT.CHARLOOKS 145612 . 146837) (\TEDIT.PUT.CHARLOOKS1 146839 . 147890) (\TEDIT.PUT.OBJECT
|
||||
147892 . 150264)) (150267 157906 (\TEDIT.PUT.PARALOOKS.LIST 150277 . 151179) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 151181 . 156765) (\TEDIT.PUT.PARALOOKS 156767 . 157904)) (158001 160770 (
|
||||
TEDITFROMLISPSOURCE 158011 . 160019) (SHELLSCRIPTP 160021 . 160250) (TEDITFROMSHELLSCRIPT 160252 .
|
||||
160768)))))
|
||||
(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 " 6-Mar-2025 20:18:04" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;138 38227
|
||||
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134 36434
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
|
||||
|
||||
:PREVIOUS-DATE "17-Feb-2025 12:25:36" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;136)
|
||||
:PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FINDCOMS)
|
||||
@@ -94,8 +94,7 @@
|
||||
(CAR (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END))))])])
|
||||
|
||||
(TEDIT.SUBSTITUTE
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "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")
|
||||
@@ -124,10 +123,11 @@
|
||||
|
||||
(* ;; "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
|
||||
@@ -137,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"))
|
||||
@@ -164,7 +163,7 @@
|
||||
(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")
|
||||
@@ -175,39 +174,31 @@
|
||||
[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 (LASTSEL _ (\TEDIT.COPYSEL SEL))
|
||||
while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR#
|
||||
T))
|
||||
[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 RANGE)
|
||||
NIL
|
||||
'RIGHT
|
||||
'PENDINGDEL
|
||||
(ADD1 (CADR RANGE)))
|
||||
(\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")
|
||||
(\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
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
@@ -216,13 +207,13 @@
|
||||
(* ;;
|
||||
"Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
|
||||
finally (\TEDIT.COPYSEL LASTSEL SEL))
|
||||
else
|
||||
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
|
||||
|
||||
(bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
|
||||
(SAVESEL _ (\TEDIT.COPYSEL SEL))
|
||||
EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
do (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
|
||||
@@ -247,21 +238,12 @@
|
||||
(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. Might be better if UPDATELINES took a lastchangechar.")
|
||||
(* ;;
|
||||
"At least one replacement, update the lines that have changed.")
|
||||
|
||||
(if (IGREATERP TOTALDIFF 0)
|
||||
then (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM)
|
||||
TOTALDIFF)
|
||||
FIRSTHIT))
|
||||
elseif (ILESSP TOTALDIFF 0)
|
||||
then (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION FIRSTHIT
|
||||
(IDIFFERENCE (IDIFFERENCE (FGETSEL SEL CHLIM)
|
||||
TOTALDIFF)
|
||||
FIRSTHIT))
|
||||
else (\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED FIRSTHIT
|
||||
(IDIFFERENCE (FGETSEL SEL CHLIM)
|
||||
FIRSTHIT)))
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(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?")
|
||||
|
||||
@@ -269,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:")
|
||||
@@ -288,8 +269,7 @@
|
||||
(RETURN NREPLACEMENTS))))])
|
||||
|
||||
(TEDIT.NEXT
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -330,9 +310,8 @@
|
||||
'RIGHT
|
||||
'PENDINGDEL)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally")
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(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)
|
||||
@@ -343,7 +322,6 @@
|
||||
'LEFT
|
||||
'PENDINGDEL) (* ; "And get it into the window")
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ))
|
||||
(NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
|
||||
(SETQ SEL NIL))
|
||||
@@ -413,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")
|
||||
@@ -444,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")
|
||||
@@ -582,8 +557,8 @@
|
||||
(DREVERSE $$VAL))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (784 23475 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE
|
||||
5119 . 18822) (TEDIT.NEXT 18824 . 23473)) (23508 38204 (\TEDIT.WCFIND 23518 . 27037) (\TEDIT.BASICFIND
|
||||
27039 . 29398) (\TEDIT.WCFIND.BACKWARD 29400 . 32864) (\TEDIT.BASICFIND.BACKWARD 32866 . 35123) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 35125 . 38202)))))
|
||||
(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.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Feb-2025 09:12:22" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;121 48129
|
||||
(FILECREATED "26-Nov-2024 23:53:32" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;101 38718
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ONECHAR.FORWARD \TEDIT.ONECHAR.BACKWARD)
|
||||
:CHANGES-TO (FNS \TEDIT.KEY.FIND)
|
||||
|
||||
:PREVIOUS-DATE "16-Feb-2025 20:44:51" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;120)
|
||||
:PREVIOUS-DATE "23-Nov-2024 16:29:11" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;100)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
|
||||
@@ -23,9 +23,8 @@
|
||||
\TEDIT.SHOWCARETLOOKS \TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL
|
||||
\TEDIT.UCASE.SEL \TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON
|
||||
\TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL
|
||||
\TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED))
|
||||
(FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD \TEDIT.ONELINE.UP \TEDIT.ONELINE.DOWN
|
||||
\TEDIT.ONELINE.MOVE)
|
||||
\TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED \TEDIT.ONECHAR.BACKWARD
|
||||
\TEDIT.ONECHAR.FORWARD))
|
||||
(COMS
|
||||
(* ;; "Auxiliary functions used in the above main functions:")
|
||||
|
||||
@@ -95,9 +94,7 @@
|
||||
("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,." FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,^" FN \TEDIT.ONELINE.UP)
|
||||
("Meta,LF" FN \TEDIT.ONELINE.DOWN]
|
||||
("Meta,." FN \TEDIT.ONECHAR.FORWARD]
|
||||
(P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
|
||||
(SELECTQ (CADR ENTRY)
|
||||
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
|
||||
@@ -445,9 +442,7 @@
|
||||
(TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T])
|
||||
|
||||
(\TEDIT.MANPAGE
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 21:48 by rmk")
|
||||
(* ; "Edited 29-Dec-2024 08:40 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 26-May-2024 21:53 by rmk")
|
||||
(* ; "Edited 25-May-2024 14:50 by rmk")
|
||||
|
||||
@@ -455,174 +450,40 @@
|
||||
|
||||
(CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
'DINFOGRAPH)
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
[LET ((KEY (TEDIT.SEL.AS.STRING TSTREAM SEL)))
|
||||
(if (OR (NULL KEY)
|
||||
(EQ 0 (NCHARS KEY)))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Please select a man-page key" T T)
|
||||
else (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL])])
|
||||
(GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL)))])
|
||||
|
||||
(\TEDIT.CALL.ED
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 23:38 by rmk")
|
||||
(* ; "Edited 29-Dec-2024 08:46 by rmk")
|
||||
(* ; "Edited 25-May-2024 15:03 by rmk")
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(LET [(SYMBOL (MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
|
||||
(if (OR (NULL SYMBOL)
|
||||
(EQ 0 (NCHARS SYMBOL)))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Please select a symbol to edit" T T)
|
||||
elseif (TYPESOF SYMBOL)
|
||||
then (ED SYMBOL `(:DONTWAIT :DISPLAY))
|
||||
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT SYMBOL " has no definitions to edit")
|
||||
T T])
|
||||
)
|
||||
(DEFINEQ
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-May-2024 15:03 by rmk")
|
||||
(ED [MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
|
||||
'(:DONTWAIT])
|
||||
|
||||
(\TEDIT.ONECHAR.BACKWARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 17-Feb-2025 09:12 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:25 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! SEL)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL))
|
||||
OBJ)
|
||||
(CL:UNLESS [OR (ILEQ PT 1)
|
||||
(AND (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(SETQ OBJ (POBJ (\TEDIT.CHTOPC (SUB1 PT)
|
||||
TEXTOBJ)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDPREFIX]
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX NIL)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
(CL:UNLESS (ILEQ PT 1)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL (SUB1 PT)
|
||||
0
|
||||
'LEFT)
|
||||
0)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
|
||||
|
||||
(\TEDIT.ONECHAR.FORWARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 17-Feb-2025 09:11 by rmk")
|
||||
(* ; "Edited 15-Feb-2025 08:50 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
|
||||
(* ;; "Moves caret to a point one character forward.")
|
||||
|
||||
(SELECTION! SEL)
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL))
|
||||
OBJ)
|
||||
(CL:UNLESS [OR (IGREATERP PT (TEXTLEN TEXTOBJ))
|
||||
(AND (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(SETQ OBJ (POBJ (\TEDIT.CHTOPC PT TEXTOBJ)))
|
||||
(IMAGEOBJPROP OBJ 'FIELDSUFFIX]
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX NIL)
|
||||
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
(CL:UNLESS (IGEQ PT (TEXTLEN TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL PT 0 'RIGHT)
|
||||
(\TEDIT.UPDATE.SEL SEL (ADD1 PT)
|
||||
0)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
|
||||
|
||||
(\TEDIT.ONELINE.UP
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Feb-2025 22:04 by rmk")
|
||||
(* ; "Edited 12-Feb-2025 19:46 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
|
||||
(* ;; "Moves caret to the same x position one line up. It gets the current X (X0 or XLIM) of the caret in the current selection, which is common to all panes in which the caret is visible. It then finds the line in the first pane where the caret is visible, formats the previous line, and then figures out the character in previousline that would come closest to X.")
|
||||
|
||||
(* ;; "We look for a pane that not only has a line with the caret, but also has the previous line. Otherwise, we have to search backwards to find the start of that line.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! SEL)
|
||||
(LET (LINE LINEPANE (CHNO (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
(for PANE FIRSTONE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN
|
||||
in (FGETSEL SEL LN) when [SETQ LINE (OR (AND L1 (WITHINLINEP CHNO L1))
|
||||
(AND LN (WITHINLINEP CHNO LN]
|
||||
do (CL:UNLESS (FGETLD (FGETLD LINE PREVLINE)
|
||||
LDUMMY)
|
||||
(RETURN))
|
||||
(CL:UNLESS FIRSTONE (SETQ FIRSTONE LINE)) finally
|
||||
|
||||
(* ;; "The caret is blinking nowhere, or in the top line of every pane, we have to create a prevline above.")
|
||||
|
||||
(SETQ LINE FIRSTONE)
|
||||
(SETQ LINEPANE PANE))
|
||||
|
||||
(* ;; "Caret is blinking in LINE, move selection to the charno at the same X in the previous line, in all panes. ")
|
||||
|
||||
(CL:WHEN [AND LINE (ILEQ 1 (SUB1 (FGETLD LINE LCHAR1]
|
||||
(\TEDIT.ONELINE.MOVE SEL (FGETLD (if (FGETLD (FGETLD LINE PREVLINE)
|
||||
LDUMMY)
|
||||
then
|
||||
(* ;;
|
||||
"Top of window, create the preceding line")
|
||||
|
||||
(\TEDIT.LASTVALIDLINE LINE CHNO LINEPANE
|
||||
TSTREAM)
|
||||
else (FGETLD LINE PREVLINE))
|
||||
LCHAR1)
|
||||
TSTREAM))])
|
||||
|
||||
(\TEDIT.ONELINE.DOWN
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 12-Feb-2025 19:46 by rmk")
|
||||
(* ; "Edited 24-Jan-2025 15:27 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 20:31 by rmk")
|
||||
(* ; "Edited 1-Sep-2024 10:39 by rmk")
|
||||
|
||||
(* ;; "Moves caret to the same x position one line down. It gets the current X (X0 or XLIM) of the caret in the current selection, which is common to all panes in which the caret is visible. It then finds the line in the first pane where the caret is visible, formats the nextline, and then figures out the character in nextline that would come closest to X.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! SEL)
|
||||
(LET (LINE NEXTLINE NEXTCHNO)
|
||||
(for L1 (CHNO _ (TEDIT.GETPOINT TSTREAM SEL)) in (FGETSEL SEL L1) as LN
|
||||
in (FGETSEL SEL LN) when [SETQ LINE (OR (AND L1 (WITHINLINEP CHNO L1))
|
||||
(AND LN (WITHINLINEP CHNO LN] do (RETURN))
|
||||
|
||||
(* ;; "Caret is blinking in LINE, move selection to the charno at the same X in the next line, in all panes. ")
|
||||
|
||||
(CL:WHEN (AND LINE (ILESSP (ADD1 (FGETLD LINE LCHARLAST))
|
||||
(TEXTLEN TEXTOBJ)))
|
||||
(\TEDIT.ONELINE.MOVE SEL (ADD1 (FGETLD LINE LCHARLAST))
|
||||
TSTREAM))])
|
||||
|
||||
(\TEDIT.ONELINE.MOVE
|
||||
[LAMBDA (SEL CHNO TSTREAM) (* ; "Edited 16-Feb-2025 16:20 by rmk")
|
||||
(* ; "Edited 14-Feb-2025 09:49 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Move caret from its previous X position to the same position in the line beginning at CHNO.")
|
||||
|
||||
(* ;; "The scan part is basically a specialized variant of \TEDIT.SCAN.LINE. ")
|
||||
|
||||
(LET ((TARGETLINE (\TEDIT.FORMATLINE TSTREAM CHNO))
|
||||
(TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ)))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(for CHARSLOT (THISLINE _ (FGETTOBJ TEXTOBJ THISLINE))
|
||||
(TARGX _ (FGETLD TARGETLINE LX1))
|
||||
[X _ (OR (FGETTOBJ TEXTOBJ LASTARROWX)
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX (SELECTQ (FGETSEL SEL POINT)
|
||||
(LEFT (FGETSEL SEL X0))
|
||||
(RIGHT (FGETSEL SEL XLIM))
|
||||
NIL] incharslots (FGETTOBJ TEXTOBJ
|
||||
THISLINE)
|
||||
when CHAR do (add TARGX CHARW)
|
||||
(CL:WHEN (IGEQ TARGX X)
|
||||
(CL:WHEN (IGEQ X (IDIFFERENCE TARGX (FOLDLO CHARW 2)))
|
||||
(* ;
|
||||
"To RIGHT of target char if more than half way")
|
||||
(add CHNO 1))
|
||||
(RETURN))
|
||||
(add CHNO 1) finally (* ;
|
||||
"TARGETLINE must have been shorter than X")
|
||||
(SETQ CHNO (FGETLD TARGETLINE LCHARLAST)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL CHNO 0 'LEFT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM))])
|
||||
)
|
||||
|
||||
|
||||
@@ -840,9 +701,7 @@
|
||||
("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
|
||||
("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,." FN \TEDIT.ONECHAR.FORWARD)
|
||||
("Meta,^" FN \TEDIT.ONELINE.UP)
|
||||
("Meta,LF" FN \TEDIT.ONELINE.DOWN)))
|
||||
("Meta,." FN \TEDIT.ONECHAR.FORWARD)))
|
||||
|
||||
[MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
|
||||
(SELECTQ (CADR ENTRY)
|
||||
@@ -851,24 +710,23 @@
|
||||
(TEDIT.SETSYNTAX (CAR ENTRY)
|
||||
(CADR ENTRY]
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6442 28702 (\TEDIT.BOLD.SEL.OFF 6452 . 6790) (\TEDIT.BOLD.SEL.ON 6792 . 7120) (
|
||||
\TEDIT.CENTER.SEL 7122 . 8638) (\TEDIT.CENTER.SEL.REV 8640 . 8936) (\TEDIT.DEFAULTS.CARET 8938 . 9431)
|
||||
(\TEDIT.DEFAULTSSEL 9433 . 9880) (\TEDIT.SETDEFAULT.FROM.SEL 9882 . 10559) (\TEDIT.KEY.FIND 10561 .
|
||||
15628) (\TEDIT.KEY.FIND.SEARCHSTRING 15630 . 16770) (\TEDIT.GET.TARGET.STRING 16772 . 18486) (
|
||||
\TEDIT.KEY.FIND.BACKWARD 18488 . 18793) (\TEDIT.FINDAGAIN.BACKWARD 18795 . 19206) (\TEDIT.FINDAGAIN
|
||||
19208 . 19499) (\TEDIT.ITALIC.SEL.OFF 19501 . 19753) (\TEDIT.ITALIC.SEL.ON 19755 . 19948) (
|
||||
\TEDIT.LARGERSEL 19950 . 20238) (\TEDIT.LCASE.SEL 20240 . 21635) (\TEDIT.SHOWCARETLOOKS 21637 . 23237)
|
||||
(\TEDIT.SMALLERSEL 23239 . 23530) (\TEDIT.SUBSCRIPTSEL 23532 . 23735) (\TEDIT.SUPERSCRIPTSEL 23737 .
|
||||
23941) (\TEDIT.UCASE.SEL 23943 . 25282) (\TEDIT.UNDERLINE.SEL.OFF 25284 . 25482) (
|
||||
\TEDIT.UNDERLINE.SEL.ON 25484 . 25680) (\TEDIT.STRIKEOUT.SEL.ON 25682 . 25878) (
|
||||
\TEDIT.STRIKEOUT.SEL.OFF 25880 . 26078) (\TEDIT.SELECT.ALL 26080 . 26396) (\TEDIT.KEY.SUBSTITUTE 26398
|
||||
. 26619) (\TEDIT.MANPAGE 26621 . 27868) (\TEDIT.CALL.ED 27870 . 28700)) (28703 37902 (
|
||||
\TEDIT.ONECHAR.BACKWARD 28713 . 29842) (\TEDIT.ONECHAR.FORWARD 29844 . 31062) (\TEDIT.ONELINE.UP 31064
|
||||
. 34025) (\TEDIT.ONELINE.DOWN 34027 . 35684) (\TEDIT.ONELINE.MOVE 35686 . 37900)) (37974 44485 (
|
||||
\TEDIT.BOLD.CARET.OFF 37984 . 38519) (\TEDIT.BOLD.CARET.ON 38521 . 39053) (\TEDIT.ITALIC.CARET.OFF
|
||||
39055 . 39592) (\TEDIT.ITALIC.CARET.ON 39594 . 40137) (\TEDIT.LARGER.CARET 40139 . 40674) (
|
||||
\TEDIT.SMALLER.CARET 40676 . 41213) (\TEDIT.SUBSCRIPT.CARET 41215 . 41756) (\TEDIT.SUPERSCRIPT.CARET
|
||||
41758 . 42300) (\TEDIT.UNDERLINE.CARET.OFF 42302 . 42842) (\TEDIT.UNDERLINE.CARET.ON 42844 . 43382) (
|
||||
\TEDIT.STRIKEOUT.CARET.OFF 43384 . 43924) (\TEDIT.STRIKEOUT.CARET.ON 43926 . 44483)) (44554 45256 (
|
||||
\TK.DESCRIBEFONT 44564 . 45254)))))
|
||||
(FILEMAP (NIL (6220 28574 (\TEDIT.BOLD.SEL.OFF 6230 . 6568) (\TEDIT.BOLD.SEL.ON 6570 . 6898) (
|
||||
\TEDIT.CENTER.SEL 6900 . 8416) (\TEDIT.CENTER.SEL.REV 8418 . 8714) (\TEDIT.DEFAULTS.CARET 8716 . 9209)
|
||||
(\TEDIT.DEFAULTSSEL 9211 . 9658) (\TEDIT.SETDEFAULT.FROM.SEL 9660 . 10337) (\TEDIT.KEY.FIND 10339 .
|
||||
15406) (\TEDIT.KEY.FIND.SEARCHSTRING 15408 . 16548) (\TEDIT.GET.TARGET.STRING 16550 . 18264) (
|
||||
\TEDIT.KEY.FIND.BACKWARD 18266 . 18571) (\TEDIT.FINDAGAIN.BACKWARD 18573 . 18984) (\TEDIT.FINDAGAIN
|
||||
18986 . 19277) (\TEDIT.ITALIC.SEL.OFF 19279 . 19531) (\TEDIT.ITALIC.SEL.ON 19533 . 19726) (
|
||||
\TEDIT.LARGERSEL 19728 . 20016) (\TEDIT.LCASE.SEL 20018 . 21413) (\TEDIT.SHOWCARETLOOKS 21415 . 23015)
|
||||
(\TEDIT.SMALLERSEL 23017 . 23308) (\TEDIT.SUBSCRIPTSEL 23310 . 23513) (\TEDIT.SUPERSCRIPTSEL 23515 .
|
||||
23719) (\TEDIT.UCASE.SEL 23721 . 25060) (\TEDIT.UNDERLINE.SEL.OFF 25062 . 25260) (
|
||||
\TEDIT.UNDERLINE.SEL.ON 25262 . 25458) (\TEDIT.STRIKEOUT.SEL.ON 25460 . 25656) (
|
||||
\TEDIT.STRIKEOUT.SEL.OFF 25658 . 25856) (\TEDIT.SELECT.ALL 25858 . 26174) (\TEDIT.KEY.SUBSTITUTE 26176
|
||||
. 26397) (\TEDIT.MANPAGE 26399 . 27155) (\TEDIT.CALL.ED 27157 . 27369) (\TEDIT.ONECHAR.BACKWARD 27371
|
||||
. 27941) (\TEDIT.ONECHAR.FORWARD 27943 . 28572)) (28646 35157 (\TEDIT.BOLD.CARET.OFF 28656 . 29191) (
|
||||
\TEDIT.BOLD.CARET.ON 29193 . 29725) (\TEDIT.ITALIC.CARET.OFF 29727 . 30264) (\TEDIT.ITALIC.CARET.ON
|
||||
30266 . 30809) (\TEDIT.LARGER.CARET 30811 . 31346) (\TEDIT.SMALLER.CARET 31348 . 31885) (
|
||||
\TEDIT.SUBSCRIPT.CARET 31887 . 32428) (\TEDIT.SUPERSCRIPT.CARET 32430 . 32972) (
|
||||
\TEDIT.UNDERLINE.CARET.OFF 32974 . 33514) (\TEDIT.UNDERLINE.CARET.ON 33516 . 34054) (
|
||||
\TEDIT.STRIKEOUT.CARET.OFF 34056 . 34596) (\TEDIT.STRIKEOUT.CARET.ON 34598 . 35155)) (35226 35928 (
|
||||
\TK.DESCRIBEFONT 35236 . 35926)))))
|
||||
STOP
|
||||
|
||||
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 " 6-Feb-2025 15:42:44" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;221 53072
|
||||
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219 53094
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HISTORYADD.COMPOSITE)
|
||||
: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 " 2-Feb-2025 11:32:56" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;220)
|
||||
: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
|
||||
@@ -454,8 +456,7 @@
|
||||
T])
|
||||
|
||||
(TEDIT.REDO
|
||||
[LAMBDA (TSTREAM) (* ; "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")
|
||||
@@ -502,10 +503,10 @@
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\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")
|
||||
@@ -839,14 +840,14 @@
|
||||
(\TEDIT.THELP 'Redo-composite])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4913 5934 (\TEDIT.HISTORYEVENT.DEFPRINT 4923 . 5932)) (7024 17609 (\TEDIT.HISTORYADD
|
||||
7034 . 11895) (\TEDIT.HISTORYADD.COMPOSITE 11897 . 12803) (\TEDIT.CUMULATE.EVENTS 12805 . 14399) (
|
||||
\TEDIT.COMPOSITE.EVENT 14401 . 15137) (\TEDIT.HISTORY.PROP 15139 . 16502) (\TEDIT.HISTORY.EVENT 16504
|
||||
. 17433) (\TEDIT.POPEVENT 17435 . 17607)) (17662 35601 (TEDIT.UNDO 17672 . 22066) (\TEDIT.UNDO1 22068
|
||||
. 26280) (TEDIT.REDO 26282 . 32755) (\TEDIT.UNDO.UNDO 32757 . 35599)) (35602 50688 (
|
||||
\TEDIT.UNDO.INSERT 35612 . 36525) (\TEDIT.UNDO.DELETE 36527 . 37321) (\TEDIT.UNDO.MOVE 37323 . 38912)
|
||||
(\TEDIT.UNDO.REPLACE 38914 . 40010) (\TEDIT.UNDO.CHARLOOKS 40012 . 44586) (\TEDIT.UNDO.PARALOOKS 44588
|
||||
. 48820) (\TEDIT.UNDO.PAGELOOKS 48822 . 49231) (\TEDIT.UNDO.COMPOSITE 49233 . 50460) (
|
||||
\TEDIT.UNDO.REPLACECODE 50462 . 50686)) (50689 53049 (\TEDIT.REDO.INSERT 50699 . 51432) (
|
||||
\TEDIT.REDO.REPLACE 51434 . 52765) (\TEDIT.REDO.COMPOSITE 52767 . 53047)))))
|
||||
(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.
@@ -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,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Mar-2025 11:59:08" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;661 153051
|
||||
(FILECREATED "17-Dec-2024 14:29:31" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;638 151180
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.CHTOLINEX)
|
||||
:CHANGES-TO (FNS \TEDIT.XYTOSEL)
|
||||
|
||||
:PREVIOUS-DATE "28-Feb-2025 17:45:33" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;660)
|
||||
:PREVIOUS-DATE " 6-Dec-2024 12:50:42" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;637)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||
@@ -569,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")
|
||||
@@ -586,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))
|
||||
@@ -613,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
|
||||
@@ -704,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.")
|
||||
@@ -834,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")
|
||||
@@ -871,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)))
|
||||
@@ -1132,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")
|
||||
@@ -1167,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
|
||||
@@ -1218,8 +1206,7 @@
|
||||
(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")
|
||||
@@ -1260,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
|
||||
|
||||
@@ -1469,81 +1455,37 @@
|
||||
(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
|
||||
|
||||
@@ -1765,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")
|
||||
@@ -1794,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)
|
||||
@@ -1989,8 +1931,7 @@
|
||||
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")
|
||||
@@ -2005,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)
|
||||
@@ -2149,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")
|
||||
@@ -2172,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))
|
||||
@@ -2182,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))
|
||||
@@ -2206,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")
|
||||
@@ -2308,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")
|
||||
|
||||
@@ -2329,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")
|
||||
@@ -2393,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")
|
||||
@@ -2407,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")
|
||||
@@ -2447,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")
|
||||
@@ -2464,25 +2416,25 @@
|
||||
(ADDTOVAR LAMA TEDIT.SELPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (15578 17399 (\TEDIT.SELECTION.DEFPRINT 15588 . 17397)) (17436 18941 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17446 . 18939)) (18942 24811 (\TEDIT.SELECTED.PIECES 18952 . 20472) (
|
||||
\TEDIT.FIND.PROTECTED.END 20474 . 22143) (\TEDIT.FIND.PROTECTED.START 22145 . 24003) (
|
||||
\TEDIT.WORD.BOUND 24005 . 24809)) (24945 59144 (\TEDIT.EXTEND.SEL 24955 . 32043) (\TEDIT.SCAN.LINE
|
||||
32045 . 43823) (\TEDIT.SCAN.LINE.WORD 43825 . 49186) (\TEDIT.XYTOSEL 49188 . 56297) (\TEDIT.REGIONTYPE
|
||||
56299 . 57318) (\TEDIT.XYTOSEL.INLINEP 57320 . 57775) (\TEDIT.XYTOSEL.LINE 57777 . 59142)) (59145
|
||||
72769 (\TEDIT.FIXSEL 59155 . 68768) (\TEDIT.CHTOLINEX 68770 . 72767)) (72770 76417 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 72780 . 73753) (\TEDIT.SET.SEL.LOOKS 73755 . 76415)) (76418 94464 (
|
||||
\TEDIT.SHOWSEL 76428 . 80888) (\TEDIT.SHOWSEL.HILIGHT 80890 . 85511) (\TEDIT.UPDATE.SEL 85513 . 89012)
|
||||
(\TEDIT.CARETLINE 89014 . 89728) (\TEDIT.SEL.L1 89730 . 90236) (\TEDIT.SEL.LN 90238 . 90744) (
|
||||
\TEDIT.SEL.DELETEDCHARS 90746 . 94462)) (94465 99171 (\TEDIT.COPYSEL 94475 . 96941) (
|
||||
\TEDIT.SEL.CHANGED? 96943 . 99169)) (99202 111931 (\TEDIT.SELECT.OBJECT 99212 . 103718) (
|
||||
\TEDIT.SHOWSEL.OBJECT 103720 . 105882) (\TEDIT.CLIP.OBJECT 105884 . 107888) (\TEDIT.OPERATE.OBJECT
|
||||
107890 . 111929)) (111959 130306 (\TEDIT.SELPIECES 111969 . 115917) (\TEDIT.SELPIECES.COPY 115919 .
|
||||
117957) (\TEDIT.SELPIECES.CONCAT 117959 . 119838) (\TEDIT.SELPIECES.CHARTRANSFORM 119840 . 122798) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 122800 . 127941) (\TEDIT.SELPIECES.TO.STRING 127943 . 130304)) (130359
|
||||
152882 (TEDIT.XYTOCH 130369 . 132753) (TEDIT.SELPROP 132755 . 136785) (TEDIT.GETPOINT 136787 . 138707)
|
||||
(TEDIT.GETSEL 138709 . 139443) (TEDIT.GETSEL.PARA 139445 . 140394) (TEDIT.SCANSEL 140396 . 141344) (
|
||||
TEDIT.SET.SEL.LOOKS 141346 . 142725) (TEDIT.SETSEL 142727 . 147491) (TEDIT.SHOWSEL 147493 . 148773) (
|
||||
TEDIT.SEL.AS.STRING 148775 . 151260) (TEDIT.SEL.AS.SEXPR 151262 . 152548) (TEDIT.SELECTALL 152550 .
|
||||
152880)))))
|
||||
(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 "19-Feb-2025 13:39:40" {WMEDLEY}<library>tedit>TEDIT-STREAM.;862 175251
|
||||
(FILECREATED "22-Dec-2024 00:24:17" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;835 172312
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTRIGHTMARGIN)
|
||||
:CHANGES-TO (FNS \TEDIT.TEXTPROP)
|
||||
|
||||
:PREVIOUS-DATE "17-Feb-2025 12:25:59" {WMEDLEY}<library>tedit>TEDIT-STREAM.;861)
|
||||
: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,9 +1601,7 @@
|
||||
WINDOW])
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
|
||||
[LAMBDA (TEXTOBJ) (* ; "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")
|
||||
@@ -1643,7 +1620,7 @@
|
||||
(* ;; "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)))
|
||||
DEFAULTFONT))
|
||||
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'LOOKS))
|
||||
(SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
|
||||
(AND (type? CHARLOOKS FONT)
|
||||
@@ -1652,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")
|
||||
@@ -1690,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")
|
||||
@@ -1704,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])
|
||||
|
||||
@@ -1979,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")
|
||||
@@ -1994,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")
|
||||
|
||||
@@ -2003,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))
|
||||
@@ -2113,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")
|
||||
|
||||
@@ -2136,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))
|
||||
@@ -2222,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")
|
||||
@@ -2243,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)
|
||||
|
||||
@@ -2713,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")
|
||||
@@ -2757,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)
|
||||
@@ -2785,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)
|
||||
@@ -2878,31 +2839,31 @@
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (37136 67737 (\TEDIT.TEXTBIN 37146 . 47896) (\TEDIT.TEXTPEEKBIN 47898 . 53448) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53450 . 59123) (\TEDIT.TEXTBOUT 59125 . 63527) (\TEDIT.INSTALL.FILEBUFFER 63529
|
||||
. 67735)) (68635 72683 (\TEDIT.TEXTOUTCHARFN 68645 . 70201) (\TEDIT.TEXTINCCODEFN 70203 . 70942) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70944 . 71536) (\TEDIT.TEXTFORMATBYTESTREAM 71538 . 72241) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72243 . 72681)) (72730 84251 (OPENTEXTSTREAM 72740 . 79692) (
|
||||
COPYTEXTSTREAM 79694 . 83474) (TEDIT.STREAMCHANGEDP 83476 . 83778) (TXTFILE 83780 . 84249)) (84252
|
||||
113999 (\TEDIT.REOPENTEXTSTREAM 84262 . 85614) (\TEDIT.OPENTEXTSTREAM.PIECES 85616 . 90046) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 90048 . 91150) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91152 . 96238) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 96240 . 98921) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98923 . 101780) (
|
||||
\TEDIT.OPENTEXTFILE 101782 . 103495) (\TEDIT.CREATE.TEXTSTREAM 103497 . 104542) (\TEDIT.REOPEN.STREAM
|
||||
104544 . 106880) (\TEDIT.TEXTINIT 106882 . 113997)) (114037 115225 (\TEDIT.TTYBOUT 114047 . 115223)) (
|
||||
115343 134135 (\TEDIT.TEXTCLOSEF 115353 . 116677) (\TEDIT.TEXTDSPFONT 116679 . 117649) (
|
||||
\TEDIT.TEXTEOFP 117651 . 119406) (\TEDIT.TEXTGETEOFPTR 119408 . 119731) (\TEDIT.TEXTSETEOFPTR 119733
|
||||
. 120823) (\TEDIT.TEXTGETFILEPTR 120825 . 123660) (\TEDIT.TEXTSETFILEINFO 123662 . 124170) (
|
||||
\TEDIT.TEXTOPENF 124172 . 125103) (\TEDIT.TEXTSETEOF 125105 . 125721) (\TEDIT.TEXTSETFILEPTR 125723 .
|
||||
127764) (\TEDIT.TEXTDSPXPOSITION 127766 . 128783) (\TEDIT.TEXTDSPYPOSITION 128785 . 129526) (
|
||||
\TEDIT.TEXTLEFTMARGIN 129528 . 130119) (\TEDIT.TEXTRIGHTMARGIN 130121 . 133284) (
|
||||
\TEDIT.TEXTDSPCHARWIDTH 133286 . 133590) (\TEDIT.TEXTDSPSTRINGWIDTH 133592 . 133898) (
|
||||
\TEDIT.TEXTDSPLINEFEED 133900 . 134133)) (135182 155919 (\TEDIT.DELETE.SELPIECES 135192 . 138705) (
|
||||
\TEDIT.INSERTCH 138707 . 146501) (\TEDIT.INSERTCH.HISTORY 146503 . 149967) (\TEDIT.INSERTEOL 149969 .
|
||||
151794) (\TEDIT.INSERTCH.INSERTION 151796 . 154633) (\TEDIT.INSERTCH.EXTEND 154635 . 155917)) (155920
|
||||
157424 (\TEDIT.NEXTCHANGEABLE.CHNO 155930 . 156645) (\TEDIT.LASTCHANGEABLE.CHNO 156647 . 157422)) (
|
||||
157425 159129 (\SETUPGETCH 157435 . 159127)) (159187 163645 (\TEDIT.INSTALL.PIECE 159197 . 163643)) (
|
||||
163683 172432 (TEXTPROP 163693 . 164040) (GETTEXTPROP 164042 . 164286) (PUTTEXTPROP 164288 . 164545) (
|
||||
GETTEXTPROPS 164547 . 164991) (PUTTEXTPROPS 164993 . 165897) (\TEDIT.TEXTPROP 165899 . 172430)) (
|
||||
172433 174503 (\TEDIT.TEXTOBJ.PROPNAMES 172443 . 173395) (\TEDIT.TEXTOBJ.PROPFETCHFN 173397 . 173913)
|
||||
(\TEDIT.TEXTOBJ.PROPSTOREFN 173915 . 174501)))))
|
||||
(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 "16-Feb-2025 23:34:57" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;759 232910
|
||||
(FILECREATED "17-Dec-2024 23:43:52" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;739 230830
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
|
||||
:CHANGES-TO (FNS \TEDIT.SHIFTLINES)
|
||||
|
||||
:PREVIOUS-DATE "13-Feb-2025 20:49:31" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;754)
|
||||
:PREVIOUS-DATE "13-Dec-2024 09:00:10" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;738)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
||||
@@ -18,14 +18,14 @@
|
||||
(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.SETUP \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE
|
||||
(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
|
||||
@@ -263,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])
|
||||
|
||||
@@ -354,9 +351,8 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.WINDOW.CREATE
|
||||
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 16-Feb-2025 23:34 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")
|
||||
@@ -380,7 +376,7 @@
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(PHEIGHT 0)
|
||||
TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ WIDTH)
|
||||
TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ)
|
||||
(CL:WHEN (WINDOWP WINDOW)
|
||||
(CL:WHEN (SETQ WTEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW))
|
||||
|
||||
@@ -422,17 +418,8 @@
|
||||
(CL:WHEN FILE
|
||||
(printout PROMPTWINDOW " for " T " " (FULLNAME FILE)))
|
||||
(TERPRI PROMPTWINDOW)
|
||||
[SETQ WIDTH (for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
largest (GETPARA PARALOOKS RIGHTMAR)
|
||||
finally (RETURN (IPLUS \TEDIT.LINEREGION.WIDTH (OR $$EXTREME 32)
|
||||
12
|
||||
(CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
||||
0
|
||||
\TEDIT.OP.WIDTH)]
|
||||
(GETMOUSESTATE)
|
||||
[SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32)
|
||||
(CREATEREGION LASTMOUSEX LASTMOUSEY WIDTH (PLUS PHEIGHT 200]
|
||||
(* ;
|
||||
(SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32)
|
||||
REGIONTYPE)) (* ;
|
||||
"We don't want the default to keep shrinking")
|
||||
(SETQ PREPROMPT (create REGION using REGION)))
|
||||
(add (fetch (REGION HEIGHT) of REGION)
|
||||
@@ -1070,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")
|
||||
@@ -1117,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))
|
||||
|
||||
(* ;; "")
|
||||
@@ -1144,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")
|
||||
@@ -1959,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")
|
||||
@@ -1970,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:")
|
||||
@@ -2506,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")
|
||||
@@ -2577,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])
|
||||
@@ -2612,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")
|
||||
@@ -2711,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])
|
||||
@@ -2886,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")
|
||||
@@ -2899,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))
|
||||
@@ -3004,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.")
|
||||
@@ -3472,10 +3454,7 @@
|
||||
(UPDATE/MENU/IMAGE MENU])
|
||||
|
||||
(TEDIT.DEFAULT.MENUFN
|
||||
[LAMBDA (PANE) (* ; "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")
|
||||
@@ -3501,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"
|
||||
@@ -3509,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))
|
||||
@@ -3543,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)
|
||||
(\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T
|
||||
)
|
||||
(\TEDIT.PRIMARYPANE TEXTOBJ)
|
||||
"Page Layout Menu" 150 'PAGE))
|
||||
(CL:WHEN ITEM (* ;
|
||||
(CL:WHEN (CAR ITEM) (* ;
|
||||
"Apply a user-supplied function to the text stream")
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ T)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(APPLY* ITEM (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))])])
|
||||
(APPLY* (CAR ITEM)
|
||||
(fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))])])
|
||||
|
||||
(TEDIT.REMOVE.MENUITEM
|
||||
[LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06")
|
||||
@@ -3662,37 +3644,37 @@
|
||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
||||
TEDIT.ICON.TITLE.REGION))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (18423 19319 (TEDIT.DEFER.UPDATES 18433 . 19317)) (19320 43173 (\TEDIT.WINDOW.CREATE
|
||||
19330 . 26856) (\TEDIT.WINDOW.SETUP 26858 . 30971) (\TEDIT.MINIMAL.WINDOW.SETUP 30973 . 39175) (
|
||||
\TEDIT.CLEARPANE 39177 . 39894) (\TEDIT.FILL.PANES 39896 . 43171)) (43174 65888 (\TEDIT.CURSORMOVEDFN
|
||||
43184 . 48057) (\TEDIT.CURSOROUTFN 48059 . 48504) (\TEDIT.ACTIVE.WINDOWP 48506 . 49557) (
|
||||
\TEDIT.EXPANDFN 49559 . 50122) (\TEDIT.MAINW 50124 . 51404) (\TEDIT.MAINSTREAM 51406 . 51673) (
|
||||
\TEDIT.PRIMARYPANE 51675 . 52445) (\TEDIT.PANELIST 52447 . 52943) (\TEDIT.NEWREGIONFN 52945 . 55461) (
|
||||
\TEDIT.SET.WINDOW.EXTENT 55463 . 60717) (\TEDIT.SHRINK.ICONCREATE 60719 . 63259) (\TEDIT.SHRINKFN
|
||||
63261 . 63670) (\TEDIT.PANEREGION 63672 . 65886)) (65920 97384 (\TEDIT.BUTTONEVENTFN 65930 . 78492) (
|
||||
\TEDIT.BUTTONEVENTFN.DOOPERATION 78494 . 85217) (\TEDIT.BUTTONEVENTFN.GETOPERATION 85219 . 87061) (
|
||||
\TEDIT.BUTTONEVENTFN.CURSEL.INIT 87063 . 90300) (\TEDIT.BUTTONEVENTFN.INACTIVE 90302 . 92644) (
|
||||
\TEDIT.BUTTONEVENTFN.INTITLE 92646 . 94481) (\TEDIT.COPYINSERTFN 94483 . 95615) (\TEDIT.FOREIGN.COPY
|
||||
95617 . 97382)) (97385 114494 (\TEDIT.PANE.SPLIT 97395 . 101874) (\TEDIT.SPLITW 101876 . 109335) (
|
||||
\TEDIT.UNSPLITW 109337 . 113151) (\TEDIT.LINKPANES 113153 . 113916) (\TEDIT.UNLINKPANE 113918 . 114492
|
||||
)) (115851 116742 (TEDITWINDOWP 115861 . 116740)) (116779 119882 (TEDIT.GETINPUT 116789 . 119232) (
|
||||
\TEDIT.MAKEFILENAME 119234 . 119880)) (119931 128232 (TEDIT.PROMPTWINDOW 119941 . 120255) (
|
||||
TEDIT.PROMPTPRINT 120257 . 122884) (TEDIT.PROMPTCLEAR 122886 . 124605) (TEDIT.PROMPTFLASH 124607 .
|
||||
126539) (\TEDIT.PROMPT.PAGEFULLFN 126541 . 128230)) (128470 137296 (\TEXTSTREAM.TITLE 128480 . 129170)
|
||||
(\TEDIT.DEFAULT.TITLE 129172 . 131551) (\TEDIT.WINDOW.TITLE 131553 . 133722) (\TEXTSTREAM.FILENAME
|
||||
133724 . 135394) (\TEDIT.UPDATE.TITLE 135396 . 137294)) (137339 145542 (TEDIT.DEACTIVATE.WINDOW 137349
|
||||
. 143142) (\TEDIT.RESHAPEFN 143144 . 145314) (\TEDIT.REPAINTFN 145316 . 145540)) (145543 187922 (
|
||||
\TEDIT.SCROLLFN 145553 . 147798) (\TEDIT.SCROLLCH.TOP 147800 . 149911) (\TEDIT.SCROLLCH.BOTTOM 149913
|
||||
. 154243) (\TEDIT.SCROLLUP 154245 . 159862) (\TEDIT.TOPLINE.YTOP 159864 . 161533) (\TEDIT.SCROLLDOWN
|
||||
161535 . 168465) (\TEDIT.SCROLL.CARET 168467 . 171305) (\TEDIT.VISIBLECARETP 171307 . 173601) (
|
||||
\TEDIT.VISIBLECHARP 173603 . 174694) (\TEDIT.BITMAPLINES 174696 . 178616) (\TEDIT.SETPANE.TOPLINE
|
||||
178618 . 179409) (\TEDIT.SHIFTLINES 179411 . 187920)) (187923 198792 (\TEDIT.ONSCREEN? 187933 . 192484
|
||||
) (\TEDIT.ONSCREEN.REGION 192486 . 196137) (\TEDIT.AFTERMOVEFN 196139 . 197036) (OFFSCREENP 197038 .
|
||||
198790)) (198834 201451 (\TEDIT.PROCIDLEFN 198844 . 200381) (\TEDIT.PROCENTRYFN 200383 . 200828) (
|
||||
\TEDIT.PROCEXITFN 200830 . 201449)) (201530 214684 (\TEDIT.DOWNCARET 201540 . 202333) (
|
||||
\TEDIT.FLASHCARET 202335 . 204446) (\TEDIT.UPCARET 204448 . 205552) (TEDIT.NORMALIZECARET 205554 .
|
||||
208772) (\TEDIT.SETCARET 208774 . 214054) (\TEDIT.CARET 214056 . 214682)) (214718 226880 (
|
||||
TEDIT.ADD.MENUITEM 214728 . 217019) (TEDIT.DEFAULT.MENUFN 217021 . 224092) (TEDIT.REMOVE.MENUITEM
|
||||
224094 . 225091) (\TEDIT.CREATEMENU 225093 . 225658) (\TEDIT.MENU.WHENHELDFN 225660 . 226565) (
|
||||
\TEDIT.MENU.WHENSELECTEDFN 226567 . 226878)))))
|
||||
(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 "19-Feb-2025 12:22:24"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;207 53931
|
||||
(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 "17-Feb-2025 12:26:08" {WMEDLEY}<library>TEDIT>tedit-exports.all;206)
|
||||
: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-Feb-2025 11:25:32"))
|
||||
(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 "18-Feb-2025 22:06:22"))
|
||||
(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 "18-Feb-2025 12:50:32"))
|
||||
(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,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:59"))
|
||||
(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)
|
||||
@@ -481,20 +480,19 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
|
||||
(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 "17-Feb-2025 12:25:49"))
|
||||
(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 "19-Feb-2025 12:11:42"))
|
||||
(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 (* ;
|
||||
@@ -514,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 (* ;
|
||||
@@ -525,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.)"
|
||||
@@ -550,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 "19-Feb-2025 12:00:37"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "12-Feb-2025 12:18:37"))
|
||||
(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
|
||||
@@ -618,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
|
||||
@@ -632,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 "18-Feb-2025 23:57:08"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2025 15:02:06"))
|
||||
(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)
|
||||
@@ -644,10 +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 " 8-Feb-2025 23:19:34"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:36"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 09:12:22"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 23:42:18"))
|
||||
(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 (* ;
|
||||
@@ -661,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 " 6-Feb-2025 15:42:44"))
|
||||
(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."
|
||||
@@ -692,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 " 8-Feb-2025 23:42:12"))
|
||||
(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 "19-Feb-2025 12:18:40"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -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 "29-Jan-2025 19:20:27" {WMEDLEY}<lispusers>GITFNS.;535 133255
|
||||
(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 PRC-COMMAND)
|
||||
: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 "12-Jun-2024 23:02:26" {WMEDLEY}<lispusers>GITFNS.;531)
|
||||
: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"])
|
||||
@@ -2425,33 +2426,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4181 20760 (GIT-CLONEP 4191 . 5519) (GIT-INIT 5521 . 6151) (GIT-MAKE-PROJECT 6153 .
|
||||
13818) (GIT-GET-PROJECT 13820 . 15745) (GIT-PUT-PROJECT-FIELD 15747 . 17388) (GIT-PROJECT-PATH 17390
|
||||
. 18434) (FIND-ANCESTOR-DIRECTORY 18436 . 18785) (GIT-FIND-CLONE 18787 . 19868) (GIT-MAINBRANCH 19870
|
||||
. 20265) (GIT-MAINBRANCH? 20267 . 20758)) (26223 31152 (PRC-COMMAND 26233 . 31150)) (31208 33996 (
|
||||
ALLSUBDIRS 31218 . 32504) (MEDLEYSUBDIRS 32506 . 33199) (GITSUBDIRS 33201 . 33994)) (33997 38787 (
|
||||
TOGIT 34007 . 35413) (FROMGIT 35415 . 36396) (GIT-DELETE-FILE 36398 . 37244) (MYMEDLEY-DELETE-FILES
|
||||
37246 . 38785)) (38788 41791 (MYMEDLEYSUBDIR 38798 . 39254) (GITSUBDIR 39256 . 39699) (STRIPDIR 39701
|
||||
. 40072) (STRIPHOST 40074 . 40314) (STRIPNAME 40316 . 41069) (STRIPWHERE 41071 . 41789)) (41792 43694
|
||||
(GFILE4MFILE 41802 . 42165) (MFILE4GFILE 42167 . 42736) (GIT-REPO-FILENAME 42738 . 43692)) (43743
|
||||
54105 (GIT-COMMIT 43753 . 44579) (GIT-PUSH 44581 . 45341) (GIT-PULL 45343 . 46095) (GIT-APPROVAL 46097
|
||||
. 46446) (GIT-GET-FILE 46448 . 48470) (GIT-FILE-EXISTS? 48472 . 48746) (GIT-REMOTE-UPDATE 48748 .
|
||||
49583) (GIT-REMOTE-ADD 49585 . 49892) (GIT-FILE-DATE 49894 . 50941) (GIT-FILE-HISTORY 50943 . 52877) (
|
||||
GIT-PRINT-FILE-HISTORY 52879 . 53929) (GIT-FETCH 53931 . 54103)) (54135 65255 (GIT-BRANCH-DIFF 54145
|
||||
. 60892) (GIT-COMMIT-DIFFS 60894 . 61567) (GIT-BRANCH-RELATIONS 61569 . 65253)) (65300 84312 (
|
||||
GIT-BRANCH-NUM 65310 . 65883) (GIT-CHECKOUT 65885 . 67171) (GIT-WHICH-BRANCH 67173 . 67580) (
|
||||
GIT-MAKE-BRANCH 67582 . 70161) (GIT-BRANCHES 70163 . 72758) (GIT-BRANCH-EXISTS? 72760 . 73631) (
|
||||
GIT-PICK-BRANCH 73633 . 74123) (GIT-BRANCH-MENU 74125 . 75006) (GIT-BRANCH-WHENSELECTEDFN 75008 .
|
||||
77173) (GIT-PULL-REQUESTS 77175 . 80693) (GIT-SHORT-BRANCH-NAME 80695 . 80986) (GIT-LONG-NAME 80988 .
|
||||
81305) (GIT-PRC-BRANCHES 81307 . 84310)) (84342 87790 (GIT-MY-CURRENT-BRANCH 84352 . 84722) (
|
||||
GIT-MY-BRANCHP 84724 . 85342) (GIT-MY-NEXT-BRANCH 85344 . 85838) (GIT-MY-BRANCHES 85840 . 87788)) (
|
||||
87836 91911 (GIT-ADD-WORKTREE 87846 . 89453) (GIT-REMOVE-WORKTREE 89455 . 90385) (GIT-LIST-WORKTREES
|
||||
90387 . 91191) (WORKTREEDIR 91193 . 91909)) (91959 125093 (GIT-GET-DIFFERENT-FILES 91969 . 98393) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98395 . 105626) (GIT-WORKING-COMPARE-DIRECTORIES 105628 . 111076) (
|
||||
GIT-COMPARE-WORKTREE 111078 . 115056) (GITCDOBJBUTTONFN 115058 . 119548) (GIT-CD-LABELFN 119550 .
|
||||
120632) (GIT-CD-MENUFN 120634 . 123074) (GIT-WORKING-COMPARE-FILES 123076 . 123696) (
|
||||
GIT-BRANCHES-COMPARE-FILES 123698 . 124862) (GIT-PR-COMPARE 124864 . 125091)) (125163 133188 (CDGITDIR
|
||||
125173 . 125860) (GIT-COMMAND 125862 . 127420) (GITORIGIN 127422 . 128119) (GIT-INITIALS 128121 .
|
||||
128425) (GIT-COMMAND-TO-FILE 128427 . 131912) (GIT-RESULT-TO-LINES 131914 . 132521) (STRIPLOCAL 132523
|
||||
. 133186)))))
|
||||
(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.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,26 +1,16 @@
|
||||
Medley REGIONMANAGER
|
||||
2
|
||||
|
||||
4
|
||||
|
||||
1
|
||||
|
||||
REGIONMANAGER
|
||||
1
|
||||
|
||||
4
|
||||
|
||||
By Ron Kaplan
|
||||
This document created in December 2021, last edited September 2023.
|
||||
|
||||
Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications.
|
||||
Medley REGIONMANAGER
2
|
||||
4
|
||||
1
|
||||
REGIONMANAGER
1
|
||||
4
|
||||
By Ron Kaplan
This document created in December 2021, last edited September 2023.
|
||||
Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications.
|
||||
The REGIONMANAGER package provides simple extensions to the core region and window functions. These are aimed at giving users and application implementors more flexible and systematic control over the specification and reuse of screen regions. It introduces three new notions:
|
||||
A "typed region" allows the regions of particular applications to be specified, classified, and recycled according to their types.
|
||||
The size, location, and orientation of a "relative region" is specified with respect to particular screen points and the location of other windows.
|
||||
A "constellation region" encloses the collection of satellite windows (prompts, menus, etc) that surround the central window of an application.
|
||||
REGIONMANAGER is innocuous in that explicit user action is required to change the default behavior of any system components.
|
||||
|
||||
Typed regions
|
||||
Typed regions
|
||||
REGIONMANAGER adds overlay veneers to the core CREATEW, CLOSEW, and GETREGION functions to make it easier to predict and control how different applications arrange their windows on the screen without always needing to respond to a ghost-region prompt.
|
||||
The REGION/INITREGION arguments may now be region-type atoms in addition to either NIL or particular regions as CREATEW and GETREGION otherwise allow. The type-atom will resolve to a region drawn from a predefined pool of regions associated with that type, if the pool has at least one that is not currently allocated to another window. If the pool has no available regions, then the pool will be enlarged with a region that the user produces from a normal ghost-region prompt, and the type-atom will then resolve to the newly installed region.
|
||||
A typed-region is marked as "inuse" and therefore unavailable when CREATEW assigns it to a window, and the extended CLOSEW marks it as again available when the window is closed. The region of the most recently closed window will be offered the next time a region of its type is requested.
|
||||
@@ -44,15 +34,15 @@ Two functions are provided to make it easy to create regions relative and orient
|
||||
RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen.
|
||||
WIDTH and HEIGHT can be given as absolute (natural) numbers or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
|
||||
natural number: the number of screen points
|
||||
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corresponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
|
||||
region/window/SCREEN/TTY:equivalent to (region/window/SCREEN/TTY 1 0).
|
||||
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corresponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
|
||||
region/window/SCREEN/TTY: equivalent to (region/window/SCREEN/TTY 1 0).
|
||||
CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be displayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left.
|
||||
The reference-point arguments REFX and REFY are interpreted as follows:
|
||||
NIL: LASTMOUSEX/LASTMOUSEY
|
||||
natural number: an absolute screen coordinate
|
||||
(anchor fraction adjustment), or just region/window/SCREEN/TTY. The quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom to produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification (<window> .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region.
|
||||
If REFX and REFY are positions, then the XCCORD of REFX and the YCOORD of REFY are taken as the absolute values for REFX and REFY respectively. For conveninence, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY.
|
||||
Also for convenience, if WIDTH is potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call.
|
||||
(anchor fraction adjustment) or just region/window/SCREEN/TTY: the quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification (<window> .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region.
|
||||
For convenience, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY.
|
||||
Also for convenience, if WIDTH is a potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call.
|
||||
|
||||
(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function]
|
||||
Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen.
|
||||
@@ -60,10 +50,10 @@ Calls GETREGION with an initial ghost region as created by RELCREATEREGION. COR
|
||||
Creates a position with X and Y coordinates specified by REFX and REFY references as above.
|
||||
|
||||
Constellation regions
|
||||
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation, the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fits within the provided region.
|
||||
Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using the remainder as the region for the central window.
|
||||
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region.
|
||||
Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window.
|
||||
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
|
||||
REGIONMANAGER provides an overlay for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
|
||||
REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
|
||||
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
|
||||
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other windows are attached (e.g. expanded menus) by later user actions.
|
||||
|
||||
@@ -78,14 +68,14 @@ Establishes a link between the PARENT window and any number of CHILDREN windows
|
||||
If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before.
|
||||
|
||||
|
||||
(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))))
1 $ 4 È $È 4 È $È 1 $È $ 1 È $ 4 È $È 4 È $È 4 È $È 4 È $È 1 È $ 1 Š Š8 $ 1 Š Š8 $ J È $È PAGEHEADING RUNNINGHEAD MODERN
|
||||
CLASSIC
|
||||
TERMINAL MODERN TERMINAL ÿü TERMINAL ÿü
|
||||
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))
1 $ 4 È $È 4 È $È 1 $È $ 1 È $ 4 È $È 4 È $È 4 È $È 4 È $È 1 È $ 1 Š Š8 $ 1 Š Š8 $ J È $È PAGEHEADING RUNNINGHEAD MODERN
|
||||
r d(DEFAULTFONT 1 (TERMINAL 12) (TERMINAL 8) (TERMINAL 8) (PDF (TERMINAL 8)) (POSTSCRIPT (TERMINAL 8))) TERMINAL MODERN TERMINAL ÿü TERMINAL ÿü
|
||||
TIMESROMAN $
HRULE.GETFN
HRULE.GETFN HRULE.GETFN HRULE.GETFN HRULE.GETFN
|
||||
D È „ • ‘ } / ¯ [ <01> C × <00> T Û
Á 1
|
||||
|
||||
; 3 o ) Ä
ž
’
4 n © o 2 V @ 1 % !
A & M m I S - g <
|
||||
; 3 o ) Ä
ž
’
4 n © o 2 V @ 1 % !
A & M m I S - f <
|
||||
3 E
|
||||
"
|
||||
|
||||
l / 4 v 2 C ƒ & % " O = , l ¬ ) 9 š ¥ Ç
W ~ æ & 4 ! U h ' š 2 & µ $ " & (
) M DATE:ie½m 3\¨zº
|
||||
|
||||
l / 3
|
||||
t 2 C ƒ " O = , l ¬ ) 9 ™ ¤ Ç
S ~ æ - 4 ! U h ' š 2 & µ $ " & (
) M DATE:fû+Ë 2ɘzº
|
||||
@@ -1,73 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Aug-2024 11:31:37" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;13 3078
|
||||
|
||||
:CHANGES-TO (FNS START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS IS-KEY-DOWN? KEY-WINDOW)
|
||||
(VARS TAB-WINDOWSCOMS)
|
||||
(PROPS (TAB-WINDOWS :COMPILE-FILE))
|
||||
|
||||
:PREVIOUS-DATE " 4-Jun-2024 09:48:34" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TAB-WINDOWSCOMS)
|
||||
|
||||
(RPAQQ TAB-WINDOWSCOMS ((FNS IS-KEY-DOWN? START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS KEY-WINDOW)
|
||||
(PROP :COMPILE-FILE TAB-WINDOWS)))
|
||||
(DEFINEQ
|
||||
|
||||
(IS-KEY-DOWN?
|
||||
[LAMBDA (KEY-NAME KEYS-DOWN)
|
||||
(for KEY-NAME-LIST in KEYS-DOWN thereis (FMEMB KEY-NAME KEY-NAME-LIST])
|
||||
|
||||
(START-TAB-WINDOWS
|
||||
[LAMBDA (META-KEY-NAME)
|
||||
(ADD.PROCESS (LIST 'TAB-WINDOWS (KWOTE META-KEY-NAME))
|
||||
'NAME "Window Tabber" 'RESTARTABLE T])
|
||||
|
||||
(TAB-WINDOWS
|
||||
[LAMBDA (META-KEY-NAME)
|
||||
|
||||
(* ;; "When the meta and tab keys go down, TOTOPW the next window in OPENWINDOWS")
|
||||
|
||||
(DECLARE (CL:SPECIAL \KEYNAMES))
|
||||
(LET ((CURRENT-WINDOW NIL)
|
||||
(OPEN-WINDOWS (OPENWINDOWS)))
|
||||
(CL:UNWIND-PROTECT
|
||||
[PROGN (while T
|
||||
do ([LET ((KEYS-DOWN (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
|
||||
[if (AND (IS-KEY-DOWN? 'TAB KEYS-DOWN)
|
||||
(IS-KEY-DOWN? META-KEY-NAME KEYS-DOWN))
|
||||
then (if CURRENT-WINDOW
|
||||
then (TOTOPW CURRENT-WINDOW)
|
||||
(SETQ CURRENT-WINDOW (CADR (FMEMB CURRENT-WINDOW
|
||||
OPEN-WINDOWS)))
|
||||
else (SETQ CURRENT-WINDOW (CAR OPEN-WINDOWS]
|
||||
(if (NOT KEYS-DOWN)
|
||||
then (SETQ CURRENT-WINDOW NIL)
|
||||
(SETQ OPEN-WINDOWS (OPENWINDOWS]
|
||||
(BLOCK 20])])
|
||||
|
||||
(SHOW-KEYS
|
||||
[LAMBDA NIL
|
||||
(DECLARE (CL:SPECIAL \KEYNAMES))
|
||||
(LET ((WINDOW (CREATEW NIL "Keys down")))
|
||||
(WINDOWPROP WINDOW 'PROCESS (THIS.PROCESS))
|
||||
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
|
||||
(DEL.PROCESS (WINDOWPROP W 'PROCESS]
|
||||
(CL:UNWIND-PROTECT
|
||||
[PROGN (while T do (LET ((DOWN-KEYS (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
|
||||
(BLOCK 100)
|
||||
(CLEARW WINDOW)
|
||||
(COND
|
||||
(DOWN-KEYS (PRIN1 DOWN-KEYS WINDOW]
|
||||
(CLOSEW WINDOW))])
|
||||
|
||||
(KEY-WINDOW
|
||||
[LAMBDA NIL
|
||||
(ADD.PROCESS '(SHOW-KEYS)
|
||||
'NAME "Showing Keys" 'RESTARTABLE T])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (645 3055 (IS-KEY-DOWN? 655 . 791) (START-TAB-WINDOWS 793 . 950) (TAB-WINDOWS 952 . 2219
|
||||
) (SHOW-KEYS 2221 . 2939) (KEY-WINDOW 2941 . 3053)))))
|
||||
STOP
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,31 +1,32 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Dec-2024 19:26:20" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;133 11059
|
||||
(FILECREATED "31-Oct-2024 17:27:44" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;124 10208
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-2024 18:00:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;132)
|
||||
:CHANGES-TO (VARS TEDIT-PF-SEECOMS)
|
||||
|
||||
:PREVIOUS-DATE "31-Oct-2024 17:25:56" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;123)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
|
||||
|
||||
(RPAQQ TEDIT-PF-SEECOMS
|
||||
[(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
|
||||
(COMMANDS ts tf)
|
||||
(FILES (SYSLOAD)
|
||||
REGIONMANAGER VERSIONDEFS)
|
||||
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
|
||||
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
|
||||
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
|
||||
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
|
||||
(COMMANDS ts tf)
|
||||
(FILES (SYSLOAD)
|
||||
REGIONMANAGER)
|
||||
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
|
||||
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
|
||||
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
|
||||
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
|
||||
(NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(PF-TEDIT
|
||||
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 6-Dec-2024 19:15 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 13:03 by rmk")
|
||||
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Aug-2024 13:03 by rmk")
|
||||
(* ; "Edited 27-Mar-2024 23:45 by rmk")
|
||||
(* ; "Edited 25-Dec-2023 12:24 by rmk")
|
||||
(* ; "Edited 5-Dec-2023 23:50 by rmk")
|
||||
@@ -49,32 +50,21 @@
|
||||
((t T NIL)
|
||||
(SETQ REPRINT T)
|
||||
(SETQ FN LASTWORD))
|
||||
(if (VERSIONP FN)
|
||||
then (SETQ IFILES (CONS FN))
|
||||
(SETQ FN LASTWORD)
|
||||
else (SETQ LASTWORD FN)))
|
||||
(SETQ LASTWORD FN))
|
||||
(CL:UNLESS FN (ERROR "No function to print"))
|
||||
(CL:WHEN (AND (VERSIONP IFILES)
|
||||
(NULL VERSION))
|
||||
(SETQ VERSION IFILES)
|
||||
(SETQ IFILES NIL))
|
||||
(CL:WHEN (INTERSECTION '(T t)
|
||||
IFILES)
|
||||
(SETQ REPRINT T)
|
||||
[SETQ IFILES (LDIFFERENCE IFILES '(t T])
|
||||
(CL:UNLESS IFILES
|
||||
(SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
|
||||
(WHEREIS FN 'FUNCTIONS T))))
|
||||
(IF IFILES
|
||||
(IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
|
||||
(WHEREIS FN 'FUNCTIONS T]
|
||||
THEN (* ; "skip compiled files")
|
||||
|
||||
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
|
||||
|
||||
(FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES
|
||||
EACHTIME (CL:IF (VERSIONP IFILE)
|
||||
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
|
||||
IFILE))) UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*)
|
||||
UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*)
|
||||
DO (SETQ LOC (FINDFNDEF FN IFILE))
|
||||
(IF (LISTP LOC)
|
||||
THEN (SETQ TFPROP (LIST FN (CAR LOC)))
|
||||
@@ -144,8 +134,7 @@
|
||||
ELSE (PRINTOUT T FN " has no function definition" T])
|
||||
|
||||
(PF-TEDIT-FROM-TEXT
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 5-Dec-2024 22:20 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:13 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 26-Aug-2024 23:13 by rmk")
|
||||
|
||||
(* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL.")
|
||||
|
||||
@@ -160,27 +149,21 @@
|
||||
(if (EQ 0 (NCHARS FN))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
|
||||
elseif FILENAME
|
||||
then [PF-TEDIT FN (CAR (MEMB (FILENAMEFIELD FILENAME)
|
||||
(WHEREIS FN NIL T]
|
||||
then (PF-TEDIT FN FILENAME)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found")
|
||||
T])
|
||||
)
|
||||
|
||||
(DEFCOMMAND ts (FILE VERSION WINDOW FORMAT) (CL:WHEN (WINDOWP VERSION)
|
||||
(SETQ WINDOW VERSION)
|
||||
(SETQ VERSION -1))
|
||||
(CL:UNLESS VERSION (SETQ VERSION -1))
|
||||
(TEDIT-SEE (FINDFILEVERSION (OR (FINDFILE-WITH-EXTENSIONS FILE NIL
|
||||
'(NIL TEDIT TED TXT TEXT TEX))
|
||||
(ERROR "FILE NOT FOUND" FILE))
|
||||
VERSION)
|
||||
(DEFCOMMAND ts (FILE WINDOW FORMAT)
|
||||
(TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
|
||||
(ERROR "FILE NOT FOUND" FILE))
|
||||
(OR WINDOW 'SEE)
|
||||
FORMAT))
|
||||
|
||||
(DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION))
|
||||
(DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES))
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
REGIONMANAGER VERSIONDEFS)
|
||||
REGIONMANAGER)
|
||||
|
||||
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
|
||||
|
||||
@@ -198,5 +181,5 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (973 10035 (PF-TEDIT 983 . 8821) (PF-TEDIT-FROM-TEXT 8823 . 10033)))))
|
||||
(FILEMAP (NIL (1243 9524 (PF-TEDIT 1253 . 8506) (PF-TEDIT-FROM-TEXT 8508 . 9522)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,143 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12 5880
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GETVINFO)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT VERSIONDEFSCOMS)
|
||||
|
||||
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(FINDFILEVERSION
|
||||
[LAMBDA (FILE VERSION DIRLIST NOERROR) (* ; "Edited 6-Dec-2024 22:12 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 23:01 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 15:23 by rmk")
|
||||
|
||||
(* ;; "Returns the version of FILE in DIRLIST that correspond to the relative version specifier VERSION. Negative version count backwrd from the newest (=-1), positive count forward from the oldest (=1). F, FIRST,OLDEST are equivalent to 1 (= oldest), N NEWEST are equivalent to -1 (newest).")
|
||||
|
||||
(LET (FILES)
|
||||
(SETQ VERSION (VERSIONP VERSION))
|
||||
(if (EQ VERSION -1)
|
||||
then (FINDFILE FILE T DIRLIST)
|
||||
elseif [SETQ FILES (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST]
|
||||
then (CAR (if (ILESSP VERSION 0)
|
||||
then
|
||||
(* ;; "-2 is the second newest version")
|
||||
|
||||
(NTH FILES (IMINUS VERSION))
|
||||
else
|
||||
(* ;; "2 is the second oldest")
|
||||
|
||||
(NTH (DREVERSE FILES)
|
||||
VERSION)))
|
||||
elseif (NOT NOERROR)
|
||||
then (ERROR (CONCAT "Version " VERSION " of " FILE " not found"])
|
||||
|
||||
(GETVINFO
|
||||
[LAMBDA (NAME TYPE FILE VERSION DIRLIST) (* ; "Edited 27-Jan-2025 08:49 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 21:37 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 23:50 by rmk")
|
||||
|
||||
(* ;; "Gets the TYPE definition of NAME from version VERSION of FILE, returns the definition after storing it under an annotated name that the filepkg doesn't see. ")
|
||||
|
||||
(if (VERSIONP TYPE)
|
||||
then (SETQ VERSION TYPE)
|
||||
(SETQ TYPE NIL)
|
||||
elseif (VERSIONP FILE)
|
||||
then (SETQ VERSION FILE)
|
||||
(SETQ FILE NIL))
|
||||
(CL:UNLESS [OR FILE (SETQ FILE (CAR (WHEREIS NAME TYPE T]
|
||||
(ERROR (CONCAT "File for " NAME " not found")))
|
||||
(CL:UNLESS VERSION
|
||||
(SETQ VERSION 'NEWEST))
|
||||
(LET ((VFILE (FINDFILEVERSION FILE VERSION DIRLIST))
|
||||
(CONNECTED (DIRECTORYNAME T T))
|
||||
DEF VNAME HOST DIR) (* ; "Don't include the whole path if it's the connected one. Perhaps we should create/return both a short name and a long name")
|
||||
(SETQ DEF (GETDEF NAME TYPE VFILE))
|
||||
(SETQ HOST (FILENAMEFIELD VFILE 'HOST))
|
||||
(SETQ DIR (FILENAMEFIELD VFILE 'DIRECTORY))
|
||||
(CL:WHEN (STRING.EQUAL HOST (FILENAMEFIELD CONNECTED 'HOST))
|
||||
(SETQ HOST NIL))
|
||||
(CL:WHEN (STRING.EQUAL DIR (FILENAMEFIELD CONNECTED 'DIRECTORY))
|
||||
(SETQ DIR NIL))
|
||||
(SETQ VNAME (PACK* (CL:IF HOST
|
||||
(CONCAT "{" HOST "}")
|
||||
"")
|
||||
(CL:IF DIR
|
||||
(CONCAT "<" (L-CASE DIR)
|
||||
">")
|
||||
"")
|
||||
NAME ";" (FILENAMEFIELD VFILE 'VERSION)
|
||||
(SELECTQ VERSION
|
||||
(1 " (F)")
|
||||
(-1 " (N)")
|
||||
"")))
|
||||
(LIST VNAME TYPE DEF])
|
||||
|
||||
(VERSIONP
|
||||
[LAMBDA (X) (* ; "Edited 6-Dec-2024 20:26 by rmk")
|
||||
|
||||
(* ;; "Normalize X if X is a version designator, otherwise NIL")
|
||||
|
||||
(SELECTQ X
|
||||
((F FIRST OLDEST)
|
||||
1)
|
||||
((N NEWEST 0)
|
||||
-1)
|
||||
(FIXP X])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(EDV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:30 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:14 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(PROG ((NAME (POP ARGS))
|
||||
(TYPE (POP ARGS))
|
||||
(FILE (POP ARGS))
|
||||
(VERSION (POP ARGS))
|
||||
(DIRLIST (POP ARGS))
|
||||
VINFO)
|
||||
(SETQ VINFO (GETVINFO NAME TYPE FILE VERSION DIRLIST))
|
||||
(EDITE (CADDR VINFO)
|
||||
NIL
|
||||
(CAR VINFO)
|
||||
(CADR VINFO)
|
||||
NIL
|
||||
'(:DONTWAIT))
|
||||
(CAR VINFO])
|
||||
|
||||
(DFV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:08 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST (POP ARGS)
|
||||
NIL
|
||||
(POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA DFV EDV)
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
|
||||
4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
|
||||
STOP
|
||||
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user