Compare commits
63 Commits
medley-250
...
medley-250
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
330c5a01a7 | ||
|
|
2499b3546e | ||
|
|
7ad65469b1 | ||
|
|
9feba7f7c7 | ||
|
|
c1c2c757b9 | ||
|
|
0f8959a074 | ||
|
|
30872f62e7 | ||
|
|
40e3edc291 | ||
|
|
6c025089c1 | ||
|
|
f53da7518f | ||
|
|
39ebd40da4 | ||
|
|
ddbc8633eb | ||
|
|
a4b9099b80 | ||
|
|
f4b7e91a68 | ||
|
|
627f359b5e | ||
|
|
46fe81bf36 | ||
|
|
67a3e558f6 | ||
|
|
37195dc7d9 | ||
|
|
fe033efe22 | ||
|
|
1491fa91cc | ||
|
|
aec7aba530 | ||
|
|
b0551fb953 | ||
|
|
cd3889874f | ||
|
|
78e88e238b | ||
|
|
58aad924d2 | ||
|
|
39bf5ba6e5 | ||
|
|
810ac28628 | ||
|
|
3f5496f593 | ||
|
|
6f44e39101 | ||
|
|
b072b6ef52 | ||
|
|
b0c00e0636 | ||
|
|
75666aa979 | ||
|
|
36a7274390 | ||
|
|
2a66f76606 | ||
|
|
3d5d96686a | ||
|
|
86ddc4b404 | ||
|
|
140415f99c | ||
|
|
1bdaa63d49 | ||
|
|
88327b8644 | ||
|
|
1d8685e6cb | ||
|
|
5e897c50b1 | ||
|
|
ec03478fcf | ||
|
|
5366ae124c | ||
|
|
83c363ad28 | ||
|
|
97fdcbdfe3 | ||
|
|
d9f5bd5957 | ||
|
|
a4da0ec553 | ||
|
|
02411ef3f4 | ||
|
|
7242b998c7 | ||
|
|
70f0e97886 | ||
|
|
6bf26ebadd | ||
|
|
02031bbf81 | ||
|
|
d4b8656803 | ||
|
|
0aa52aa8cd | ||
|
|
ebe96bc7b0 | ||
|
|
98c481ba1a | ||
|
|
58f8fbdc53 | ||
|
|
3aa58b6374 | ||
|
|
0400c1ec7f | ||
|
|
736ac51a8c | ||
|
|
c7f08aade9 | ||
|
|
c0e0aea80a | ||
|
|
f56033fca0 |
6
.github/workflows/buildDocker.yml
vendored
6
.github/workflows/buildDocker.yml
vendored
@@ -154,7 +154,8 @@ jobs:
|
||||
if [ "${{ inputs.draft }}" = "false" ];
|
||||
then
|
||||
docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
|
||||
platforms="linux/amd64,linux/arm64"
|
||||
platforms="linux/amd64"
|
||||
#,linux/arm64
|
||||
else
|
||||
docker_tags="${docker_image}:draft"
|
||||
platforms="linux/amd64"
|
||||
@@ -171,7 +172,8 @@ jobs:
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@v3
|
||||
with:
|
||||
platforms: linux/amd64,linux/arm64,linux/arm/v7
|
||||
platforms: linux/amd64
|
||||
# ,linux/arm64,linux/arm/v7
|
||||
|
||||
# Setup the Docker Buildx funtion
|
||||
- name: Set up Docker Buildx
|
||||
|
||||
2
.github/workflows/buildReleaseInclDocker.yml
vendored
2
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -131,7 +131,7 @@ jobs:
|
||||
run: |
|
||||
if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
|
||||
then
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref main
|
||||
fi
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}
|
||||
|
||||
9
.gitignore
vendored
9
.gitignore
vendored
@@ -13,11 +13,9 @@ maiko/
|
||||
# normally when you have derived files, you ignore them from git
|
||||
# because they will get regenerated when you rebuild.
|
||||
# MEDLEY-UTILS HCFILES regenerates
|
||||
|
||||
# do not ignore .pdf files after all... rather, [new workflow](scripts/make-gh-pages.md) stores it in the src repository gh-pages branch.
|
||||
|
||||
# *.pdf
|
||||
# index.html
|
||||
# index.html files are also produced by HCFILES
|
||||
*.pdf
|
||||
index.html
|
||||
|
||||
|
||||
# all loadup files
|
||||
@@ -32,6 +30,7 @@ loadups/*.dribble
|
||||
loadups/whereis.hash
|
||||
loadups/apps.sysout
|
||||
loadups/fuller.database
|
||||
loadups/build/
|
||||
|
||||
# manual cross-reference files
|
||||
|
||||
|
||||
@@ -1,164 +1,352 @@
|
||||
<h1>NAME</h1>
|
||||
<p><strong>medley</strong> — starts up Medley Interlisp</p>
|
||||
<h1>SYNOPSIS</h1>
|
||||
<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ -- <em>PASS_ON_ARGS</em> ]</p>
|
||||
<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ --
|
||||
<em>PASS_ON_ARGS</em> ]</p>
|
||||
<h1>DESCRIPTION</h1>
|
||||
<p>Starts Medley Interlisp in a window.</p>
|
||||
<h1>OPTIONS</h1>
|
||||
<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley and used by many of the options described below. MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of medley.</p>
|
||||
<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley
|
||||
and used by many of the options described below. MEDLEYDIR is the top
|
||||
level directory of the Medley installation that contains the specific
|
||||
medley script that is invoked after all symbolic links are resolved. In
|
||||
the standard global installation this will be
|
||||
/usr/local/interlisp/medley. But Medley can be installed in multiple
|
||||
places on any given machine and hence MEDLEYDIR is computed on each
|
||||
invocation of medley.</p>
|
||||
<h2>Flags</h2>
|
||||
<dl>
|
||||
<dt>-h, --help</dt>
|
||||
<dd><p>Prints out a brief summary of the flags and arguments to medley.</p>
|
||||
<dd>
|
||||
<p>Prints out a brief summary of the flags and arguments to medley.</p>
|
||||
</dd>
|
||||
<dt>-z, --man</dt>
|
||||
<dd><p>Show the man page for medley</p>
|
||||
<dd>
|
||||
<p>Show the man page for medley</p>
|
||||
</dd>
|
||||
<dt>-c [<em>FILE</em> | -], --config [<em>FILE</em> | -]</dt>
|
||||
<dd><p>Use <em>FILE</em> as the config file for this run of Medley. See information on <em>CONFIG FILE</em> below.</p>
|
||||
<p>If the given value is “-”, then suppress the use of a config file for this run of Medley.</p>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the config file for this run of Medley. See
|
||||
information on <em>CONFIG FILE</em> below.</p>
|
||||
<p>If the given value is “-”, then suppress the use of a config file for
|
||||
this run of Medley.</p>
|
||||
</dd>
|
||||
<dt>-f, --full</dt>
|
||||
<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
<dd>
|
||||
<p>Start Medley from the standard “full” sysout. full.sysout includes a
|
||||
complete Interlisp and CommonLisp environment with a standard set of
|
||||
development tools. It does not include any of the applications built
|
||||
using Medley.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting
|
||||
sysouts.)</p>
|
||||
</dd>
|
||||
<dt>-l, --lisp</dt>
|
||||
<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
<dd>
|
||||
<p>Start Medley from the standard “lisp” sysout. lisp.sysout only
|
||||
includes the basic Interlisp and CommonLisp environment.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting
|
||||
sysouts.)</p>
|
||||
</dd>
|
||||
<dt>-a, --apps</dt>
|
||||
<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
<dd>
|
||||
<p>Start Medley from the standard “apps” sysout. apps.sysout includes
|
||||
everything in full.sysout plus Medley applications including Notecards,
|
||||
Rooms and CLOS. It also includes pre-installed links to key Medley
|
||||
documentation.</p>
|
||||
<p>(See <em>SYSOUT_FILE</em> below for more information on starting
|
||||
sysouts.)</p>
|
||||
</dd>
|
||||
<dt>-u, --continue</dt>
|
||||
<dd><p>Nullify any prior setting of the sysout file (e.g., from the config file) - causing Medley to start from the virtual memory file resulting from the previous invocation (with the same values for –id and –logindir), if any. If there is no matching virtual memory file, Medley will start from the full.sysout (see -f/–full above).</p>
|
||||
<dd>
|
||||
<p>Nullify any prior setting of the sysout file (e.g., from the config
|
||||
file) - causing Medley to start from the virtual memory file resulting
|
||||
from the previous invocation (with the same values for –id and
|
||||
–logindir), if any. If there is no matching virtual memory file, Medley
|
||||
will start from the full.sysout (see -f/–full above).</p>
|
||||
<p>Equivalent to “-y -”.</p>
|
||||
<p>(See <em>SYSOUT FILE</em> section below.)</p>
|
||||
</dd>
|
||||
<dt>-y [<em>SYSOUT_FILE</em> | -], --sysout [<em>SYSOUT-FILE</em> | -]</dt>
|
||||
<dd><p>Start Medley from the specified <em>SYSOUT-FILE</em>. This is an alternative to specifying the <em>SYSOUT-FILE</em> as the last argument on the command line (but before any <em>PASS_ON_ARGS</em>). It can be used to specify the <em>SYSOUT-FILE</em> in the config file (see information on <em>CONFIG FILE</em> below).</p>
|
||||
<p>If the given value is “-”, then any prior setting of the sysout file (e.g., from the config file) is nullified (see -u/–continue above).</p>
|
||||
<dt>-y [<em>SYSOUT_FILE</em> | -], --sysout [<em>SYSOUT-FILE</em> |
|
||||
-]</dt>
|
||||
<dd>
|
||||
<p>Start Medley from the specified <em>SYSOUT-FILE</em>. This is an
|
||||
alternative to specifying the <em>SYSOUT-FILE</em> as the last argument
|
||||
on the command line (but before any <em>PASS_ON_ARGS</em>). It can be
|
||||
used to specify the <em>SYSOUT-FILE</em> in the config file (see
|
||||
information on <em>CONFIG FILE</em> below).</p>
|
||||
<p>If the given value is “-”, then any prior setting of the sysout file
|
||||
(e.g., from the config file) is nullified (see -u/–continue above).</p>
|
||||
<p>(See <em>SYSOUT FILE</em> section below.)</p>
|
||||
</dd>
|
||||
<dt>-e [+ | -], --interlisp [+ | -]</dt>
|
||||
<dd><p>If value is “+” or no value, make the initial Exec window within Medley be an Interlisp Exec. If value is “-”, make the initial Exec window be the default XCL Exec.</p>
|
||||
<dd>
|
||||
<p>If value is “+” or no value, make the initial Exec window within
|
||||
Medley be an Interlisp Exec. If value is “-”, make the initial Exec
|
||||
window be the default XCL Exec.</p>
|
||||
<p>This flag applies only when the –apps flag is used.</p>
|
||||
</dd>
|
||||
<dt>-n [+ | -], --noscroll [+ | -]</dt>
|
||||
<dd><p>Medley ordinarily displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window.</p>
|
||||
<p>Specifying “-n +” (–noscroll +) turns off scroll bars. Specifying “-n -” (–scroll -) turns on scroll bars. Specifying -n (–noscroll) with no value is equivalent to specifying “–noscroll +”.</p>
|
||||
<dd>
|
||||
<p>Medley ordinarily displays scroll bars to enable the user to pan the
|
||||
Medley virtual display within the Medley window. This is true even when
|
||||
the entire virtual display fits within the window.</p>
|
||||
<p>Specifying “-n +” (–noscroll +) turns off scroll bars. Specifying “-n
|
||||
-” (–scroll -) turns on scroll bars. Specifying -n (–noscroll) with no
|
||||
value is equivalent to specifying “–noscroll +”.</p>
|
||||
<p>Default is scroll bars off.</p>
|
||||
<p>Note: If scroll bars are off and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
|
||||
<p>Note: If scroll bars are off and the virtual screen is larger than
|
||||
the window, there will be no way to pan to the non-visible parts of the
|
||||
virtual display.</p>
|
||||
</dd>
|
||||
<dt>-g [<em>WxH</em> | -], --geometry [<em>WxH</em> | -]</dt>
|
||||
<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported).</p>
|
||||
<dd>
|
||||
<p>Sets the size of the X Window (or VNC window) that Medley runs in to
|
||||
be Width x Height. (Full X Windows geomtery specification with +X+Y is
|
||||
not currently supported).</p>
|
||||
<p>If a value of “-” is given, geometry is set to the default value.</p>
|
||||
<p>If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
|
||||
<p>If --geometry is not specified but --screensize is, then the window
|
||||
size will be determined based on the --screensize values and the
|
||||
--noscroll flag. If neither --geometry nor --screensize is provided,
|
||||
then the window size is set to 1440x900 if --noscroll is set and
|
||||
1462x922 if --noscroll is not set.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of
|
||||
geometry and screensize in config files.)</p>
|
||||
</dd>
|
||||
<dt>-s [<em>WxH</em> | -], --screensize [<em>WxH</em> | -]</dt>
|
||||
<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. The Medley window is an unscaled viewport onto this virtual display.</p>
|
||||
<p>If a value of “-” is given, screensize is set to the default value.</p>
|
||||
<p>If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of geometry and screensize in config files.)</p>
|
||||
<dd>
|
||||
<p>Sets the size of the virtual display as seen from Medley’s point of
|
||||
view. The Medley window is an unscaled viewport onto this virtual
|
||||
display.</p>
|
||||
<p>If a value of “-” is given, screensize is set to the default
|
||||
value.</p>
|
||||
<p>If --screensize is not specified but --geometry is, then the virtual
|
||||
display size will be set so that the entire virtual display fits into
|
||||
the given window geometry. If neither --screensize nor --geometry is
|
||||
provided, then the screen size is set to 1440x900.</p>
|
||||
<p>(Also see note below under <em>CONFIG FILE</em> on the use of
|
||||
geometry and screensize in config files.)</p>
|
||||
</dd>
|
||||
<dt>-ps [<em>N</em> | -], –pixelscale [<em>N</em> | -] ** <strong>Applicable only when display is SDL-based (e.g., on Windows/Cygwin)</strong> **</dt>
|
||||
<dd><p>Sets the pixel scaling factor to <em>N</em>, an integer</p>
|
||||
<p>If value of “-” is given, the pixel scale factor is set to its default of 1.</p>
|
||||
<dt>-ps [<em>N</em> | -], –pixelscale [<em>N</em> | -] **
|
||||
<strong>Applicable only when display is SDL-based (e.g., on
|
||||
Windows/Cygwin)</strong> **</dt>
|
||||
<dd>
|
||||
<p>Sets the pixel scaling factor to <em>N</em>, an integer</p>
|
||||
<p>If value of “-” is given, the pixel scale factor is set to its
|
||||
default of 1.</p>
|
||||
</dd>
|
||||
<dt>-t [<em>STRING</em> | -], --title [<em>STRING</em> | -]</dt>
|
||||
<dd><p>Use <em>STRING</em> as title of Medley window.</p>
|
||||
<p>If <em>STRING</em> includes the character sequence “%i”, then the value of the id string (see –id flag below) prefixed by “::” will be substituited for the “%i”. Example: if the id is “run_45” and <em>STRING</em> is “Medley Interlisp %i”, then the actual window title will be “Medley Interlisp :: run_45”.</p>
|
||||
<p>If the value of “-” is given, sets the title to its default value (“Medley Interlisp %i”).</p>
|
||||
<dd>
|
||||
<p>Use <em>STRING</em> as title of Medley window.</p>
|
||||
<p>If <em>STRING</em> includes the character sequence “%i”, then the
|
||||
value of the id string (see –id flag below) prefixed by “::” will be
|
||||
substituited for the “%i”. Example: if the id is “run_45” and
|
||||
<em>STRING</em> is “Medley Interlisp %i”, then the actual window title
|
||||
will be “Medley Interlisp :: run_45”.</p>
|
||||
<p>If the value of “-” is given, sets the title to its default value
|
||||
(“Medley Interlisp %i”).</p>
|
||||
<p>This flag is ignored when when the --vnc flag is set.</p>
|
||||
</dd>
|
||||
<dt>-d [<em>:N</em> | -], --display [<em>:N</em> | -]</dt>
|
||||
<dd><p>Use X display <em>:N</em>.</p>
|
||||
<p>If value is “-”, reset display to its default value. Default value is the value of $DISPLAY.</p>
|
||||
<p>On platforms that support both SDL and X Windows, set the value of -d (–display) to “SDL” to select using SDL instead of X Windows.</p>
|
||||
<p>This flag is ignored on the Windows/Cygwin platform and when the --vnc flag is set on Windows System for Linux.</p>
|
||||
<dd>
|
||||
<p>Use X display <em>:N</em>.</p>
|
||||
<p>If value is “-”, reset display to its default value. Default value is
|
||||
the value of $DISPLAY.</p>
|
||||
<p>On platforms that support both SDL and X Windows, set the value of -d
|
||||
(–display) to “SDL” to select using SDL instead of X Windows.</p>
|
||||
<p>This flag is ignored on the Windows/Cygwin platform and when the
|
||||
--vnc flag is set on Windows System for Linux.</p>
|
||||
</dd>
|
||||
<dt>-v [+ | -] , --vnc [+ | -] ** <strong>Applicable only to WSL installations</strong> **</dt>
|
||||
<dd><p>If value is “+” or no value is given, then use a VNC window running on the Windows side instead of an X window. If value is “-”, then do not use a VNC window, relying instead on a standard X Window.</p>
|
||||
<p>A VNC window will folllow the Windows desktop scaling setting allowing for much more usable Medley on high resolution displays. On WSL, X windows do not scale well.</p>
|
||||
<dt>-v [+ | -] , --vnc [+ | -] ** <strong>Applicable only to WSL
|
||||
installations</strong> **</dt>
|
||||
<dd>
|
||||
<p>If value is “+” or no value is given, then use a VNC window running
|
||||
on the Windows side instead of an X window. If value is “-”, then do not
|
||||
use a VNC window, relying instead on a standard X Window.</p>
|
||||
<p>A VNC window will folllow the Windows desktop scaling setting
|
||||
allowing for much more usable Medley on high resolution displays. On
|
||||
WSL, X windows do not scale well.</p>
|
||||
<p>This flag is always set for WSL1 installations.</p>
|
||||
</dd>
|
||||
<dt>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - | --]</dt>
|
||||
<dd><p>Use <em>ID_STRING</em> as the id for this run of Medley, unless the given value is “-”, “--”, or “---”.</p>
|
||||
<p>Only one instance of Medley can be run simultaneously for any given id.</p>
|
||||
<p><em>ID-STRING</em> can consist of any alphanumeric character plus the underscore (_) character, ending (optionally) in a “+” character. If <em>ID_STRING</em> ends with a “+” (including just a singleton “+”), then Medley will add a number to the id to make it unique among currently running Medley intsances.</p>
|
||||
<p>If the given value is “-”, then the id will be (re)set to “default” (e.g., if it was previously set in the config file). If it is “--”, then id will be set to the basename of $MEDLEYDIR. If ID_STRING is “---”, then id will be set to the basename of the parent directory of $MEDLEYDIR.</p>
|
||||
<dt>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - |
|
||||
--]</dt>
|
||||
<dd>
|
||||
<p>Use <em>ID_STRING</em> as the id for this run of Medley, unless the
|
||||
given value is “-”, “--”, or “---”.</p>
|
||||
<p>Only one instance of Medley can be run simultaneously for any given
|
||||
id.</p>
|
||||
<p><em>ID-STRING</em> can consist of any alphanumeric character plus the
|
||||
underscore (_) character, ending (optionally) in a “+” character. If
|
||||
<em>ID_STRING</em> ends with a “+” (including just a singleton “+”),
|
||||
then Medley will add a number to the id to make it unique among
|
||||
currently running Medley intsances.</p>
|
||||
<p>If the given value is “-”, then the id will be (re)set to “default”
|
||||
(e.g., if it was previously set in the config file). If it is “--”, then
|
||||
id will be set to the basename of $MEDLEYDIR. If ID_STRING is “---”,
|
||||
then id will be set to the basename of the parent directory of
|
||||
$MEDLEYDIR.</p>
|
||||
<p>Default id is “default”.</p>
|
||||
</dd>
|
||||
<dt>-m [<em>N</em> | -], --mem [<em>N</em> | -]</dt>
|
||||
<dd><p>Set Medley to run in <em>N</em> MB of virtual memory. Defaults to 256MB.</p>
|
||||
<dd>
|
||||
<p>Set Medley to run in <em>N</em> MB of virtual memory. Defaults to
|
||||
256MB.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<p>If a value of “-” is given, resets to default value.</p>
|
||||
<dl>
|
||||
<dt>-p [<em>FILE</em> | -], --vmem [<em>FILE</em> | -]</dt>
|
||||
<dd><p>Use <em>FILE</em> as the Medley virtual memory (vmem) store. <em>FILE</em> must be writeable by the current user.</p>
|
||||
<p>Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously. The --id flag will not protect against vmem collisions when the --vmem flag is used.</p>
|
||||
<p>If the value “-” is given, then resets the vmem file to the default.</p>
|
||||
<p>Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem, where III is the id of this Medley run (see --id flag above). See --logindir below for setting of LOGINDIR.</p>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the Medley virtual memory (vmem) store.
|
||||
<em>FILE</em> must be writeable by the current user.</p>
|
||||
<p>Care must be taken not to use the same vmem FILE for two instances of
|
||||
Medley running simultaneously. The --id flag will not protect against
|
||||
vmem collisions when the --vmem flag is used.</p>
|
||||
<p>If the value “-” is given, then resets the vmem file to the
|
||||
default.</p>
|
||||
<p>Default is to store the vmem in LOGINDIR/vmem/lisp_III.virtualmem,
|
||||
where III is the id of this Medley run (see --id flag above). See
|
||||
--logindir below for setting of LOGINDIR.</p>
|
||||
</dd>
|
||||
<dt>-r [<em>FILE</em> | -], --greet [<em>FILE</em> | -]</dt>
|
||||
<dd><p>Use <em>FILE</em> as the Medley greetfile.</p>
|
||||
<p>If the given value is “-”, Medley will start up without using a greetfile.</p>
|
||||
<p>The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the Medley greetfile.</p>
|
||||
<p>If the given value is “-”, Medley will start up without using a
|
||||
greetfile.</p>
|
||||
<p>The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT,
|
||||
except when the --apps flag is used in which case it is
|
||||
$MEDLEYDIR/greetfiles/APPS-INIT.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-cm [<em>FILE</em> | -], --rem.cm [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Use <em>FILE</em> as the REM.CM file that Medley reads and executes
|
||||
at startup - after any greet files. Usually used only for loadups and
|
||||
other maintenance operations .</p>
|
||||
<p>If the given value is “-”, Medley will start up without using REM.CM
|
||||
file.</p>
|
||||
<p>There is no default Medley REM.CM file.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-x [<em>DIR</em> | - | –], --logindir [<em>DIR</em> | - | –]</dt>
|
||||
<dd><p>Use <em>DIR</em> as LOGINDIR in Medley. <em>DIR</em> must be writeable by the current user.</p>
|
||||
<p>LOGINDIR is used by Medley as the working directory on start-up and where it loads any “personal” initialization file from.</p>
|
||||
<p>If the given value is “-”, then reset LOGINDIR to its default value. If the given value is “–”, uses $MEDLEYDIR/logindir as LOGINDIR.</p>
|
||||
<dd>
|
||||
<p>Use <em>DIR</em> as LOGINDIR in Medley. <em>DIR</em> must be
|
||||
writeable by the current user.</p>
|
||||
<p>LOGINDIR is used by Medley as the working directory on start-up and
|
||||
where it loads any “personal” initialization file from.</p>
|
||||
<p>If the given value is “-”, then reset LOGINDIR to its default value.
|
||||
If the given value is “–”, uses $MEDLEYDIR/logindir as LOGINDIR.</p>
|
||||
<p>LOGINDIR defaults to $HOME/il.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt>-nh <em>Host:Port:Mac:Debug</em>, --nethub <em>Host:Port:Mac:Debug</em></dt>
|
||||
<dd><p>Set the parameters for using Nethub XNS networking. <em>Host</em> is the full domain name of the nethub host. <em>Port</em> is the port on <em>Host</em> that nethub is using. <em>Mac</em> is the Mac address that this instance of Medley should use when contacting the nethub host. <em>Debug</em> is the level of nethub debug information that should be printed on stdout (value is 0, 1, or 2). A <em>Host</em> value is required and serves to turn nethub functionality on. <em>Port</em>, <em>Mac</em> and <em>Debug</em> parameters are optional and will default if left off.</p>
|
||||
<p>If any of the parameters have a value of “-”, any previous setting (e.g., in a config file) for the parameter will be reset to the default value - which in the case of <em>Host</em> is the null string, turning nethub functionality off.</p>
|
||||
<dt>-nh <em>Host:Port:Mac:Debug</em>, --nethub
|
||||
<em>Host:Port:Mac:Debug</em></dt>
|
||||
<dd>
|
||||
<p>Set the parameters for using Nethub XNS networking. <em>Host</em> is
|
||||
the full domain name of the nethub host. <em>Port</em> is the port on
|
||||
<em>Host</em> that nethub is using. <em>Mac</em> is the Mac address that
|
||||
this instance of Medley should use when contacting the nethub host.
|
||||
<em>Debug</em> is the level of nethub debug information that should be
|
||||
printed on stdout (value is 0, 1, or 2). A <em>Host</em> value is
|
||||
required and serves to turn nethub functionality on. <em>Port</em>,
|
||||
<em>Mac</em> and <em>Debug</em> parameters are optional and will default
|
||||
if left off.</p>
|
||||
<p>If any of the parameters have a value of “-”, any previous setting
|
||||
(e.g., in a config file) for the parameter will be reset to the default
|
||||
value - which in the case of <em>Host</em> is the null string, turning
|
||||
nethub functionality off.</p>
|
||||
</dd>
|
||||
<dt>-nf, -NF, –nofork</dt>
|
||||
<dd><p>No fork. Relevant only to the Medley loadup workflow.</p>
|
||||
<dd>
|
||||
<p>No fork. Relevant only to the Medley loadup workflow.</p>
|
||||
</dd>
|
||||
<dt>-prog <em>EXE</em>, –maikoprog <em>EXE</em></dt>
|
||||
<dd><p>Use <em>EXE</em> as the basename of the Maiko executable. Relevant only to the Medley loadup workflow.</p>
|
||||
<dd>
|
||||
<p>Use <em>EXE</em> as the basename of the Maiko executable. Relevant
|
||||
only to the Medley loadup workflow.</p>
|
||||
</dd>
|
||||
<dt>–maikodir <em>DIR</em></dt>
|
||||
<dd><p>Use <em>DIR</em> as the directory containing the Maiko emulator. For testing purposes only.</p>
|
||||
<dd>
|
||||
<p>Use <em>DIR</em> as the directory containing the Maiko emulator. For
|
||||
testing purposes only.</p>
|
||||
</dd>
|
||||
<dt>-cc [<em>FILE</em> | -], --repeat [<em>FILE</em> | -]</dt>
|
||||
<dd>
|
||||
<p>Run Medley once. And then as long as <em>FILE</em> exists and is
|
||||
greater then zero length, repeatedly run Medley using <em>FILE</em> as
|
||||
the REM.CM file that Medley reads and executes at startup. Each run of
|
||||
Medley can change the contents of <em>FILE</em> to effect the subsequent
|
||||
run of Medley. To end the cycle, Medley needs to delete <em>FILE</em>.
|
||||
WIthin Medley, <em>FILE</em> can be found as the value of the
|
||||
environment variable LDEREPEATCM.</p>
|
||||
<p>On Windows/Cygwin installations, <em>FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h2>Other Options</h2>
|
||||
<dl>
|
||||
<dt><em>SYSOUT_FILE</em></dt>
|
||||
<dd><p>The pathname of the file to use as a sysout for Medley to start from. If SYSOUT_FILE is not provided and none of the flags (--apps, --full, --lisp) is used, then Medley will start from the saved virtual memory file from the previous session with the same ID_STRING as this run. If no such virtual memory file exists, then Medley will start from the standard full.sysout (equivalent to specifying the --full flag). On Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
|
||||
<dd>
|
||||
<p>The pathname of the file to use as a sysout for Medley to start from.
|
||||
If SYSOUT_FILE is not provided and none of the flags (--apps, --full,
|
||||
--lisp) is used, then Medley will start from the saved virtual memory
|
||||
file from the previous session with the same ID_STRING as this run. If
|
||||
no such virtual memory file exists, then Medley will start from the
|
||||
standard full.sysout (equivalent to specifying the --full flag). On
|
||||
Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the
|
||||
Medley file system, not the host Windows file system.</p>
|
||||
</dd>
|
||||
<dt><em>PASS_ON_ARGS</em></dt>
|
||||
<dd><p>All arguments after the “--” flag, are passed unaltered to the Maiko emulator.</p>
|
||||
<dd>
|
||||
<p>All arguments after the “--” flag, are passed unaltered to the Maiko
|
||||
emulator.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>CONFIG FILE</h1>
|
||||
<p>A config file can be used to “pre-specify” any of the above command line arguments. The config file consists of command line arguments (flags or flag-value pairs), <em>one per line</em>. These arguments are read from the config file and prepended to the arguments actually given on the command line. Since later arguments override earlier arguments, any argument actually given on the command line will override a conflicting argument given in the config file.</p>
|
||||
<p>Unless specified using the -c (–config) argument, the default config file will be $MEDLEYDIR/.medley_config, if it exists, and $HOME/.medley_config, otherwise.</p>
|
||||
<p>Specifying, “-c -” or “–config -” on the command line will suppress the use of config files for the current run of Medley.</p>
|
||||
<p><em>Note:</em> care must be taken when using -g (–geometry) and/or -s (–screensize) arguments in config files. If only one of these is specified, then the other is conputed. But if both are specified, then the specified dimensions are used as given. Unexpected results can arise if one is specified in the config file but the other is specified on the command line. In this case, the two specified dimensions will be used as given. It will not be the case, as might be expected, that the dimension given in the config file will be overridden by a dimension computed from the dimension given on the command line.</p>
|
||||
<p>A config file can be used to “pre-specify” any of the above command
|
||||
line arguments. The config file consists of command line arguments
|
||||
(flags or flag-value pairs), <em>one per line</em>. These arguments are
|
||||
read from the config file and prepended to the arguments actually given
|
||||
on the command line. Since later arguments override earlier arguments,
|
||||
any argument actually given on the command line will override a
|
||||
conflicting argument given in the config file.</p>
|
||||
<p>Unless specified using the -c (–config) argument, the default config
|
||||
file will be $MEDLEYDIR/.medley_config, if it exists, and
|
||||
$HOME/.medley_config, otherwise.</p>
|
||||
<p>Specifying, “-c -” or “–config -” on the command line will suppress
|
||||
the use of config files for the current run of Medley.</p>
|
||||
<p><em>Note:</em> care must be taken when using -g (–geometry) and/or -s
|
||||
(–screensize) arguments in config files. If only one of these is
|
||||
specified, then the other is conputed. But if both are specified, then
|
||||
the specified dimensions are used as given. Unexpected results can arise
|
||||
if one is specified in the config file but the other is specified on the
|
||||
command line. In this case, the two specified dimensions will be used as
|
||||
given. It will not be the case, as might be expected, that the dimension
|
||||
given in the config file will be overridden by a dimension computed from
|
||||
the dimension given on the command line.</p>
|
||||
<h1>OTHER FILES</h1>
|
||||
<dl>
|
||||
<dt>$HOME/il</dt>
|
||||
<dd><p>Default Medley LOGINDIR</p>
|
||||
<dd>
|
||||
<p>Default Medley LOGINDIR</p>
|
||||
</dd>
|
||||
<dt>$HOME/il/vmem/lisp.virtualmem</dt>
|
||||
<dd><p>Default virtual memory file</p>
|
||||
<dd>
|
||||
<p>Default virtual memory file</p>
|
||||
</dd>
|
||||
<dt>$HOME/il/INIT(.LCOM)</dt>
|
||||
<dd><p>Default personal init file</p>
|
||||
<dd>
|
||||
<p>Default personal init file</p>
|
||||
</dd>
|
||||
<dt>$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)</dt>
|
||||
<dd><p>Default Medley greetfile</p>
|
||||
<dd>
|
||||
<p>Default Medley greetfile</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>BUGS</h1>
|
||||
<p>See GitHub Issues: <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,5 +1,19 @@
|
||||
.\" Automatically generated by Pandoc 2.9.2.1
|
||||
.\" Automatically generated by Pandoc 3.1.3
|
||||
.\"
|
||||
.\" Define V font for inline verbatim, using C font in formats
|
||||
.\" that render this, and otherwise B font.
|
||||
.ie "\f[CB]x\f[]"x" \{\
|
||||
. ftr V B
|
||||
. ftr VI BI
|
||||
. ftr VB B
|
||||
. ftr VBI BI
|
||||
.\}
|
||||
.el \{\
|
||||
. ftr V CR
|
||||
. ftr VI CI
|
||||
. ftr VB CB
|
||||
. ftr VBI CBI
|
||||
.\}
|
||||
.ad l
|
||||
.TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
|
||||
.nh
|
||||
@@ -8,8 +22,8 @@
|
||||
\f[B]medley\f[R] \[em] starts up Medley Interlisp
|
||||
.SH SYNOPSIS
|
||||
.PP
|
||||
\f[B]medley\f[R] [ flags \&... ] [ \f[I]SYSOUT_FILE\f[R] ] [ --
|
||||
\f[I]PASS_ON_ARGS\f[R] ]
|
||||
\f[B]medley\f[R] [ flags \&...
|
||||
] [ \f[I]SYSOUT_FILE\f[R] ] [ -- \f[I]PASS_ON_ARGS\f[R] ]
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Starts Medley Interlisp in a window.
|
||||
@@ -291,6 +305,21 @@ On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
|
||||
Medley file system, not the host Windows file system.
|
||||
.RE
|
||||
.TP
|
||||
-cm [\f[I]FILE\f[R] | -], --rem.cm [\f[I]FILE\f[R] | -]
|
||||
Use \f[I]FILE\f[R] as the REM.CM file that Medley reads and executes at
|
||||
startup - after any greet files.
|
||||
Usually used only for loadups and other maintenance operations .
|
||||
.RS
|
||||
.PP
|
||||
If the given value is \[lq]-\[rq], Medley will start up without using
|
||||
REM.CM file.
|
||||
.PP
|
||||
There is no default Medley REM.CM file.
|
||||
.PP
|
||||
On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
|
||||
Medley file system, not the host Windows file system.
|
||||
.RE
|
||||
.TP
|
||||
-x [\f[I]DIR\f[R] | - | \[en]], --logindir [\f[I]DIR\f[R] | - | \[en]]
|
||||
Use \f[I]DIR\f[R] as LOGINDIR in Medley.
|
||||
\f[I]DIR\f[R] must be writeable by the current user.
|
||||
@@ -341,6 +370,22 @@ Relevant only to the Medley loadup workflow.
|
||||
\[en]maikodir \f[I]DIR\f[R]
|
||||
Use \f[I]DIR\f[R] as the directory containing the Maiko emulator.
|
||||
For testing purposes only.
|
||||
.TP
|
||||
-cc [\f[I]FILE\f[R] | -], --repeat [\f[I]FILE\f[R] | -]
|
||||
Run Medley once.
|
||||
And then as long as \f[I]FILE\f[R] exists and is greater then zero
|
||||
length, repeatedly run Medley using \f[I]FILE\f[R] as the REM.CM file
|
||||
that Medley reads and executes at startup.
|
||||
Each run of Medley can change the contents of \f[I]FILE\f[R] to effect
|
||||
the subsequent run of Medley.
|
||||
To end the cycle, Medley needs to delete \f[I]FILE\f[R].
|
||||
WIthin Medley, \f[I]FILE\f[R] can be found as the value of the
|
||||
environment variable LDEREPEATCM.
|
||||
.RS
|
||||
.PP
|
||||
On Windows/Cygwin installations, \f[I]FILE\f[R] is specified in the
|
||||
Medley file system, not the host Windows file system.
|
||||
.RE
|
||||
.SS Other Options
|
||||
.PP
|
||||
\
|
||||
|
||||
Binary file not shown.
@@ -1,4 +1,4 @@
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
|
||||
---
|
||||
adjusting: l
|
||||
@@ -210,6 +210,16 @@ in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.
|
||||
On Windows/Cygwin installations, *FILE* is
|
||||
specified in the Medley file system, not the host Windows file system.
|
||||
|
||||
-cm \[*FILE* | -], \-\-rem.cm \[*FILE* | -]
|
||||
: Use *FILE* as the REM.CM file that Medley reads and executes at startup - after any greet files. Usually used only for loadups and other maintenance operations .
|
||||
|
||||
If the given value is "-", Medley will start up without using REM.CM file.
|
||||
|
||||
There is no default Medley REM.CM file.
|
||||
|
||||
On Windows/Cygwin installations, *FILE* is
|
||||
specified in the Medley file system, not the host Windows file system.
|
||||
|
||||
-x \[*DIR* | - | --], \-\-logindir \[*DIR* | - | --]
|
||||
: Use *DIR* as LOGINDIR in Medley. *DIR* must be writeable by the current user.
|
||||
|
||||
@@ -242,6 +252,12 @@ for the parameter will be reset to the default value - which in the case of *Hos
|
||||
--maikodir *DIR*
|
||||
: Use *DIR* as the directory containing the Maiko emulator. For testing purposes only.
|
||||
|
||||
-cc \[*FILE* | -], \-\-repeat \[*FILE* | -]
|
||||
: Run Medley once. And then as long as *FILE* exists and is greater then zero length, repeatedly run Medley using *FILE* as the REM.CM file that Medley reads and executes at startup. Each run of Medley can change the contents of *FILE* to effect the subsequent run of Medley. To end the cycle, Medley needs to delete *FILE*. WIthin Medley, *FILE* can be found as the value of the environment variable LDEREPEATCM.
|
||||
|
||||
On Windows/Cygwin installations, *FILE* is
|
||||
specified in the Medley file system, not the host Windows file system.
|
||||
|
||||
|
||||
Other Options
|
||||
-------------
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Apr-2024 09:25:49" {WMEDLEY}<doctools>IMINDEX.;6 37064
|
||||
(FILECREATED "24-Mar-2025 10:31:37" {WMEDLEY}<doctools>IMINDEX.;10 37350
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS IM.INDEX.PUTFN IM.INDEX.GETFN)
|
||||
:CHANGES-TO (FNS IM.INDEX.EDIT)
|
||||
|
||||
:PREVIOUS-DATE " 4-Apr-2024 23:17:47" {WMEDLEY}<doctools>IMINDEX.;5)
|
||||
:PREVIOUS-DATE "17-Mar-2025 12:07:55" {WMEDLEY}<doctools>IMINDEX.;9)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMINDEXCOMS)
|
||||
@@ -163,11 +163,13 @@
|
||||
(TERPRI PTRFILE])
|
||||
|
||||
(IM.INDEX.EDIT
|
||||
[LAMBDA (OBJ TEXTSTREAM) (* ; "Edited 18-Jul-88 14:10 by burns")
|
||||
|
||||
[LAMBDA (OBJ TEXTSTREAM) (* ; "Edited 24-Mar-2025 10:30 by rmk")
|
||||
(* ; "Edited 17-Mar-2025 12:06 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:14 by rmk")
|
||||
(* ; "Edited 18-Jul-88 14:10 by burns")
|
||||
(PROG* ((W (FREEMENU IM.INDEX.OBJ.FREEMENU.SPECS))
|
||||
(REGION (WINDOWREGION W))
|
||||
[TEDIT.WINDOW (CAR (fetch \WINDOW of (TEXTOBJ TEXTSTREAM]
|
||||
(TEDIT.WINDOW (TEDITWINDOWP TEXTSTREAM))
|
||||
(TEDIT.REGION (AND TEDIT.WINDOW (WINDOWREGION TEDIT.WINDOW)))
|
||||
OBJ.DATA OBJ.DATA.PROPLIST)
|
||||
(WINDOWPROP W 'IM.INDEX.OBJ OBJ)
|
||||
@@ -640,13 +642,13 @@
|
||||
|
||||
(IM.INDEX.INIT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1692 15373 (IM.INDEX.CLOSEF 1702 . 2393) (IM.INDEX.COPYFN 2395 . 2580) (
|
||||
IM.INDEX.CREATEOBJ 2582 . 3928) (IM.INDEX.DISPLAY.STRING 3930 . 4351) (IM.INDEX.DISPLAYFN 4353 . 8450)
|
||||
(IM.INDEX.EDIT 8452 . 11920) (IM.INDEX.LIST.FROM.STRING 11922 . 12956) (IM.INDEX.SIZEFN 12958 . 13718
|
||||
) (IM.INDEX.STRING.FROM.LIST 13720 . 13965) (IM.INDEX.PUTFN 13967 . 14313) (IM.INDEX.GETFN 14315 .
|
||||
14612) (IM.INDEX.BUTTONEVENTFN 14614 . 15371)) (15374 17444 (IM.INDEX.INIT 15384 . 17442)) (17445
|
||||
29361 (IM.INDEX.MENU 17455 . 19143) (IM.INDEX.MENU.WHENSELECTEDFN 19145 . 25900) (
|
||||
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25902 . 29359)) (31877 37020 (IM.CHAP.COPYFN 31887 . 32067) (
|
||||
IM.CHAP.CREATEOBJ 32069 . 33495) (IM.CHAP.DISPLAYFN 33497 . 35457) (IM.CHAP.SIZEFN 35459 . 36461) (
|
||||
IM.CHAP.PUTFN 36463 . 36647) (IM.CHAP.GETFN 36649 . 36810) (IM.CHAP.BUTTONEVENTFN 36812 . 37018)))))
|
||||
(FILEMAP (NIL (1677 15659 (IM.INDEX.CLOSEF 1687 . 2378) (IM.INDEX.COPYFN 2380 . 2565) (
|
||||
IM.INDEX.CREATEOBJ 2567 . 3913) (IM.INDEX.DISPLAY.STRING 3915 . 4336) (IM.INDEX.DISPLAYFN 4338 . 8435)
|
||||
(IM.INDEX.EDIT 8437 . 12206) (IM.INDEX.LIST.FROM.STRING 12208 . 13242) (IM.INDEX.SIZEFN 13244 . 14004
|
||||
) (IM.INDEX.STRING.FROM.LIST 14006 . 14251) (IM.INDEX.PUTFN 14253 . 14599) (IM.INDEX.GETFN 14601 .
|
||||
14898) (IM.INDEX.BUTTONEVENTFN 14900 . 15657)) (15660 17730 (IM.INDEX.INIT 15670 . 17728)) (17731
|
||||
29647 (IM.INDEX.MENU 17741 . 19429) (IM.INDEX.MENU.WHENSELECTEDFN 19431 . 26186) (
|
||||
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 26188 . 29645)) (32163 37306 (IM.CHAP.COPYFN 32173 . 32353) (
|
||||
IM.CHAP.CREATEOBJ 32355 . 33781) (IM.CHAP.DISPLAYFN 33783 . 35743) (IM.CHAP.SIZEFN 35745 . 36747) (
|
||||
IM.CHAP.PUTFN 36749 . 36933) (IM.CHAP.GETFN 36935 . 37096) (IM.CHAP.BUTTONEVENTFN 37098 . 37304)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jul-2024 12:51:12" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;16 30093
|
||||
(FILECREATED "28-Mar-2025 08:53:43" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;2 30243
|
||||
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14)
|
||||
:CHANGES-TO (FNS MAKE-FULLER-DB)
|
||||
|
||||
:PREVIOUS-DATE "14-Jul-2024 12:51:12" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
@@ -108,12 +110,14 @@
|
||||
(HELP])
|
||||
|
||||
(MAKE-FULLER-DB
|
||||
[LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE) (* ; "Edited 3-Aug-2023 18:12 by frank")
|
||||
[LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE) (* ; "Edited 28-Mar-2025 08:53 by lmm")
|
||||
(* ; "Edited 3-Aug-2023 18:12 by frank")
|
||||
(* ; "Edited 16-Jul-2022 22:07 by larry")
|
||||
(* ; "Edited 20-Jun-2022 17:23 by larry")
|
||||
(FILESLOAD (SOURCE)
|
||||
FILESETS)
|
||||
(DRIBBLE (OR DRIBBLEFILE "fuller.dribble"))
|
||||
(FILESLOAD LAFITE)
|
||||
(DOFILESLOAD (SUBSET (APPEND OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
'FINDFILE))
|
||||
(GATHER-INFO 'ALL)
|
||||
@@ -528,9 +532,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1086 12345 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS
|
||||
7259 . 11714) (MEDLEY-FIX-LINKS 11716 . 12109) (MEDLEY-FIX-DATES 12111 . 12343)) (13524 16312 (
|
||||
MAKE-EXPORTS-ALL 13534 . 14593) (MAKE-WHEREIS-HASH 14595 . 15784) (MAKE-WHEREIS-LOOPS 15786 . 16310))
|
||||
(16313 25045 (HCFILES 16323 . 20586) (MAKE-INDEX-HTMLS 20588 . 25043)) (25295 29907 (RECOMPILE-ONE
|
||||
25305 . 27202) (RECMPL 27204 . 27807) (COMPILE-SETUP 27809 . 28433) (REMAKEFILES 28435 . 29905)))))
|
||||
(FILEMAP (NIL (1104 12495 (GATHER-INFO 1114 . 6496) (MAKE-FULLER-DB 6498 . 7407) (MAKE-INDEX-HTMLS
|
||||
7409 . 11864) (MEDLEY-FIX-LINKS 11866 . 12259) (MEDLEY-FIX-DATES 12261 . 12493)) (13674 16462 (
|
||||
MAKE-EXPORTS-ALL 13684 . 14743) (MAKE-WHEREIS-HASH 14745 . 15934) (MAKE-WHEREIS-LOOPS 15936 . 16460))
|
||||
(16463 25195 (HCFILES 16473 . 20736) (MAKE-INDEX-HTMLS 20738 . 25193)) (25445 30057 (RECOMPILE-ONE
|
||||
25455 . 27352) (RECMPL 27354 . 27957) (COMPILE-SETUP 27959 . 28583) (REMAKEFILES 28585 . 30055)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2025 10:15:55" {WMEDLEY}<internal>TEDIT-DEBUG.;131 130299
|
||||
(FILECREATED "29-Mar-2025 22:37:05" {WMEDLEY}<internal>TEDIT-DEBUG.;143 131559
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (MACROS DEBUGOUTPUT)
|
||||
(FNS SP SL SSP SPF STL TEST.TEMPLATE)
|
||||
|
||||
:PREVIOUS-DATE " 1-Feb-2025 08:28:14" {WMEDLEY}<internal>TEDIT-DEBUG.;130)
|
||||
:PREVIOUS-DATE "28-Mar-2025 20:51:43" {WMEDLEY}<internal>TEDIT-DEBUG.;141)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
||||
@@ -26,11 +27,14 @@
|
||||
(COMS (* ;
|
||||
"Get/set (default) object, stream, window, selection")
|
||||
(FNS GTO GTS GTW GSEL)
|
||||
(INITVARS (LASTTEXTSTREAM NIL)))
|
||||
(INITVARS (LASTTEXTSTREAM NIL))
|
||||
(FNS TEST.TEMPLATE))
|
||||
(FNS TESTACTION)
|
||||
(COMS (* ; "Inspect")
|
||||
(FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES))
|
||||
(COMS (* ; "Show")
|
||||
(FNS SP SL SSP STL SPF SLF SHOWLINE SLL STBYTES))
|
||||
(FNS SP SL SSP SPF SLF SHOWLINE SLL STBYTES SSEL)
|
||||
(FNS STL CLEARTHISLINE))
|
||||
(COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES))
|
||||
(COMS (FNS FILEBYTES TFILEBYTES))
|
||||
(FNS TRELMOVE TSCROLL TSCROLL*)
|
||||
@@ -52,7 +56,7 @@
|
||||
(FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC))
|
||||
(INITVARS (LASTTS NIL))
|
||||
(VARS (OK.TO.MODIFY.FNS T))
|
||||
(FNS DFOV OLDWI DFOV.OLDEST COMP DFR)
|
||||
(FNS OLDWI COMP DFR)
|
||||
(FNS DFGV GDIRECTORIES)
|
||||
(COMS (FNS TTEST LTEST THC)
|
||||
(INITVARS (LASTTTESTFILE))
|
||||
@@ -70,7 +74,7 @@
|
||||
(FILES (NOERROR)
|
||||
VERSIONDEFS)
|
||||
(* ; "Until this is release")
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV DFOV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV)
|
||||
(NLAML DFVENUE DFR)
|
||||
(LAMA])
|
||||
|
||||
@@ -150,6 +154,39 @@
|
||||
)
|
||||
|
||||
(RPAQ? LASTTEXTSTREAM NIL)
|
||||
(DEFINEQ
|
||||
|
||||
(TEST.TEMPLATE
|
||||
[LAMBDA (FILE) (* ; "Edited 29-Mar-2025 09:51 by rmk")
|
||||
(CL:WHEN (AND (TEXTSTREAM LASTTEXTSTREAM)
|
||||
(TEDITWINDOWP LASTTEXTSTREAM)
|
||||
(OPENWP (TEDITWINDOWP LASTTEXTSTREAM)))
|
||||
(TEXTPROP LASTTEXTSTREAM 'DIRTY NIL)
|
||||
(CLOSEW (TEDITWINDOWP LASTTEXTSTREAM)))
|
||||
(LET [(TSTREAM (TEXTSTREAM (TEDIT FILE NIL NIL '(LEAVETTY T]
|
||||
(SETQ LASTTEXTSTREAM TSTREAM)
|
||||
(GTS TSTREAM)
|
||||
(STUFF TSTREAM)
|
||||
TSTREAM])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TESTACTION
|
||||
[LAMBDA (CHAR TSTREAM) (* ; "Edited 23-Mar-2025 11:06 by rmk")
|
||||
|
||||
(* ;; "If CHAR is bound to an action in TSTREAM's read table, execute it.")
|
||||
|
||||
(SETQ TSTREAM (GTS TSTREAM))
|
||||
(\TEDIT.COMMAND.FUNCTION? TSTREAM (if (CHARCODEP CHAR)
|
||||
then CHAR
|
||||
elseif (CHARCODEP CHAR T)
|
||||
elseif (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM))
|
||||
then (SETQ CHAR (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM)))
|
||||
(CL:IF (CHARCODEP CHAR)
|
||||
CHAR
|
||||
(CHARCODE.DECODE CHAR))
|
||||
else (ERROR CHAR "is not a keybinding"])
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -323,25 +360,31 @@
|
||||
(LENGTH UNDONEEVENTS])
|
||||
|
||||
(IPCTB
|
||||
[LAMBDA (ARG) (* ; "Edited 31-Oct-2023 19:45 by rmk")
|
||||
[LAMBDA (ARG) (* ; "Edited 28-Mar-2025 20:42 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:45 by rmk")
|
||||
(* ; "Edited 4-May-2023 20:28 by rmk")
|
||||
(INSPECT (FETCH (TEXTOBJ PCTB) of (GTO ARG))
|
||||
'LIST])
|
||||
(SETQ ARG (GTO ARG))
|
||||
(INSPECT (GETTOBJ ARG PCTB)
|
||||
'LIST)
|
||||
ARG])
|
||||
|
||||
(IMB
|
||||
[LAMBDA (KEY ARG) (* ; "Edited 22-Aug-2024 16:34 by rmk")
|
||||
[LAMBDA (IDENTIFIER ARG) (* ; "Edited 28-Mar-2025 20:45 by rmk")
|
||||
(* ; "Edited 22-Aug-2024 16:34 by rmk")
|
||||
(* ; "Edited 21-Aug-2024 10:00 by rmk")
|
||||
(* ; "Edited 8-Aug-2024 09:08 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 09:05 by rmk")
|
||||
|
||||
(* ;; "Inspect the menu button for KEY")
|
||||
(* ;; "Inspect the menu button for IDENTIFIER")
|
||||
|
||||
(LET [(OBJ (MB.FIND KEY (GTO ARG)
|
||||
(LET [(OBJ (MB.GET IDENTIFIER (GTO ARG)
|
||||
'OBJECT]
|
||||
(CL:IF OBJ (INSPECT OBJ NIL NIL KEY])
|
||||
(CL:IF OBJ (INSPECT OBJ NIL NIL IDENTIFIER))
|
||||
OBJ])
|
||||
|
||||
(ICL
|
||||
[LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
[LAMBDA (PC ARG) (* ; "Edited 28-Mar-2025 20:39 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 13:33 by rmk")
|
||||
|
||||
(* ;; "Inspect the character looks of PC")
|
||||
@@ -349,21 +392,27 @@
|
||||
(LET ((DECODED (IPC.DECODEARGS PC ARG)))
|
||||
(SETQ PC (POP DECODED))
|
||||
(INSPECT (PCHARLOOKS PC)
|
||||
NIL NIL (CONCAT PC " " (POP DECODED])
|
||||
NIL NIL (CONCAT PC " " (POP DECODED)))
|
||||
(PCHARLOOKS PC])
|
||||
|
||||
(IPL
|
||||
[LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
[LAMBDA (PC ARG) (* ; "Edited 28-Mar-2025 20:39 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 17:01 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 11:42 by rmk")
|
||||
(LET ((DECODED (IPC.DECODEARGS PC ARG)))
|
||||
(SETQ PC (POP DECODED))
|
||||
(INSPECT (PPARALOOKS PC)
|
||||
NIL NIL (CONCAT PC " " (POP DECODED])
|
||||
NIL NIL (CONCAT PC " " (POP DECODED)))
|
||||
(PPARALOOKS PC])
|
||||
|
||||
(ICARET
|
||||
[LAMBDA (ARG) (* ; "Edited 27-Nov-2024 13:48 by rmk")
|
||||
[LAMBDA (ARG) (* ; "Edited 28-Mar-2025 20:40 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 13:48 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 13:33 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 11:42 by rmk")
|
||||
(INSPECT (PANECARET (GTW ARG])
|
||||
(SETQ ARG (GTW ARG))
|
||||
(INSPECT (PANECARET ARG))
|
||||
(PANECARET ARG])
|
||||
|
||||
(INSPECTPIECES
|
||||
[LAMBDA (PIECE N TAG WHERE) (* ; "Edited 16-Mar-2024 10:07 by rmk")
|
||||
@@ -395,7 +444,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SP
|
||||
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 6-Jan-2025 22:18 by rmk")
|
||||
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 29-Mar-2025 22:34 by rmk")
|
||||
(* ; "Edited 6-Jan-2025 22:18 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 15:50 by rmk")
|
||||
(* ; "Edited 30-Nov-2024 19:34 by rmk")
|
||||
(* ; "Edited 9-Sep-2024 14:53 by rmk")
|
||||
@@ -414,7 +464,7 @@
|
||||
(PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC)
|
||||
PC
|
||||
(GTO TOBJ)))
|
||||
WTYPE)
|
||||
WTYPE TITLE)
|
||||
(if OFILE
|
||||
then (CL:WHEN (MEMB OFILE '(T TEDIT))
|
||||
(SETQ WTYPE 'SP)
|
||||
@@ -452,8 +502,8 @@
|
||||
(SETQ NP (CL:IF NP
|
||||
20
|
||||
MAX.SMALLP)))
|
||||
(DEBUGOUTPUT OFILE WTYPE (DSPFONT (OR FONT '(TERMINAL 8))
|
||||
OFILE)
|
||||
(DEBUGOUTPUT OFILE WTYPE TITLE (DSPFONT (OR FONT '(TERMINAL 8))
|
||||
OFILE)
|
||||
(for P PFILES inpieces PC as I from 1 to NP as PCNO
|
||||
from (OR (PIECENUM PC TEXTOBJ)
|
||||
1) do
|
||||
@@ -475,7 +525,8 @@
|
||||
(RETURN PC])
|
||||
|
||||
(SL
|
||||
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 21-Jan-2025 15:39 by rmk")
|
||||
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 29-Mar-2025 20:27 by rmk")
|
||||
(* ; "Edited 21-Jan-2025 15:39 by rmk")
|
||||
(* ; "Edited 6-Jan-2025 22:58 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 16:34 by rmk")
|
||||
(* ; "Edited 3-Dec-2024 10:29 by rmk")
|
||||
@@ -489,13 +540,17 @@
|
||||
|
||||
(* ;; "Shows a selection of the lines backing the display in PANE")
|
||||
|
||||
(LET (LINES WTYPE PNO)
|
||||
(LET (LINES WTYPE PNO TITLE)
|
||||
(if OFILE
|
||||
then (CL:WHEN (MEMB OFILE '(T TEDIT))
|
||||
(SETQ WTYPE 'SL)
|
||||
(SETQ OFILE NIL))
|
||||
elseif (MEMB LASTLINE '(T TEDIT))
|
||||
then (SETQ WTYPE 'SL)
|
||||
(SETQ LASTLINE NIL)
|
||||
elseif (STRINGP LASTLINE)
|
||||
then (SETQ WTYPE 'SL)
|
||||
(SETQ TITLE (CONCAT "SL: " LASTLINE))
|
||||
(SETQ LASTLINE NIL))
|
||||
(CL:WHEN [AND (type? LINEDESCRIPTOR (CAR (LISTP FIRSTLINE)))
|
||||
(NULL LASTLINE)
|
||||
@@ -509,8 +564,8 @@
|
||||
(SETQ TOBJ (pop LINES))
|
||||
(SETQ PANE (pop LINES))
|
||||
(SETQ PNO (pop LINES))
|
||||
(DEBUGOUTPUT OFILE WTYPE (PRINTOUT OFILE .FONT '(TERMINAL 8)
|
||||
"Pane " PNO " = " PANE T)
|
||||
(DEBUGOUTPUT OFILE WTYPE TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8)
|
||||
"Pane " PNO " = " PANE T)
|
||||
(PRINTOUT OFILE .FONT '(TERMINAL 8)
|
||||
15 "HT" -3 "BOT" 27 .FONT '(TERMINAL 8 BOLD)
|
||||
"C1" 36 "CN" .FONT '(TERMINAL 8)
|
||||
@@ -526,7 +581,8 @@
|
||||
FIRSTLINE])
|
||||
|
||||
(SSP
|
||||
[LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 30-Jan-2025 11:25 by rmk")
|
||||
[LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 29-Mar-2025 22:35 by rmk")
|
||||
(* ; "Edited 30-Jan-2025 11:25 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 20:54 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:58 by rmk")
|
||||
(* ; "Edited 12-Feb-2024 12:33 by rmk")
|
||||
@@ -545,147 +601,15 @@
|
||||
(SETQ OFILE NIL)
|
||||
else (GTO TEXTOBJ))
|
||||
(DEBUGOUTPUT OFILE (CL:UNLESS OFILE 'SSP)
|
||||
NIL
|
||||
(for PC inselpieces SELPIECES as I from 1 to (OR NP 50)
|
||||
do (PRINTOUT OFILE .I3 I "/")
|
||||
(SPPRINT PC OFILE TEXTOBJ)))
|
||||
SELPIECES])
|
||||
|
||||
(STL
|
||||
[LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 22-Aug-2024 23:51 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 12:08 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 19:55 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 09:20 by rmk")
|
||||
(* ; "Edited 1-Feb-2024 17:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 10:50 by rmk")
|
||||
(* ; "Edited 23-Nov-2023 11:41 by rmk")
|
||||
(* ; "Edited 23-Mar-2023 23:00 by rmk")
|
||||
|
||||
(* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done. During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible. When complete, they shouldn't appear.")
|
||||
|
||||
(* ;; "If OFILE isn't given, this goes to a textstream")
|
||||
|
||||
(DECLARE (USEDFREE PREVSP CHARSLOT))
|
||||
(CL:UNLESS (type? THISLINE THISLINE)
|
||||
(CL:WHEN (EQ THISLINE T)
|
||||
(SETQ THISLINE NIL)
|
||||
(SETQ LASTCS CHARSLOT))
|
||||
(SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE))))
|
||||
(\DTEST THISLINE 'THISLINE)
|
||||
(DEBUGOUTPUT OFILE (CL:IF OFILE
|
||||
NIL
|
||||
'STL)
|
||||
(for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH TLSPACEFACTOR
|
||||
OF THISLINE))
|
||||
(FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE))
|
||||
(LINE _ (fetch (THISLINE DESC) of THISLINE))
|
||||
(NSPACES _ 0)
|
||||
(NCHARS _ 0)
|
||||
(SPACETOTAL _ 0)
|
||||
(PSP _ (AND (BOUNDP 'PREVSP)
|
||||
(NEQ PREVSP (GETATOMVAL 'PREVSP))
|
||||
PREVSP)) incharslots THISLINE as NSLOTS from 0
|
||||
first (if (NULL LINE)
|
||||
then (printout OFILE THISLINE ":" T 5
|
||||
"No line parameters, start at CHNO = 1 LX1 = 0" T)
|
||||
(SETQ CHNO 1)
|
||||
(SETQ TX 0)
|
||||
elseif (type? LINEDESCRIPTOR LINE)
|
||||
then (SETQ CHNO (GETLD LINE LCHAR1))
|
||||
(SETQ TX (GETLD LINE LX1))
|
||||
(printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO
|
||||
" LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM)
|
||||
T))
|
||||
(CL:WHEN LCHAR1
|
||||
(SETQ CHNO (OR LCHAR1 1)))
|
||||
(SETQ LENGTH TX)
|
||||
(printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT))
|
||||
(SETQ CHARW (CHARW CSLOT))
|
||||
(CL:UNLESS (CHARSLOTP CSLOT THISLINE)
|
||||
(HELP "THISLINE RUNS OFF THE EDGE"
|
||||
THISLINE))
|
||||
repeatuntil [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE]
|
||||
do (printout OFILE .I4 NSLOTS)
|
||||
[if (IMAGEOBJP CHAR)
|
||||
then (add NCHARS 1)
|
||||
(printout OFILE " " .I5 CHNO ": ")
|
||||
(add TX CHARW)
|
||||
(printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ")
|
||||
(SPPRINT.OBJ CHAR OFILE)
|
||||
(add LENGTH CHARW)
|
||||
(ADD CHNO 1)
|
||||
elseif (SMALLP CHAR)
|
||||
then (add NCHARS 1)
|
||||
(printout OFILE " " .I5 CHNO ": ")
|
||||
(printout OFILE .I3 CHAR " "
|
||||
(SELCHARQ CHAR
|
||||
((EOL CR LF)
|
||||
(add TX CHARW)
|
||||
(add LENGTH CHARW)
|
||||
"EOL")
|
||||
(FORM "FORM")
|
||||
(SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT)
|
||||
(SETQ EXPANDSPACES T))
|
||||
(if EXPANDSPACES
|
||||
then (add LENGTH (SCALEUP SPACEFACTOR CHARW))
|
||||
(add TX (SCALEUP SPACEFACTOR CHARW))
|
||||
else (add LENGTH CHARW)
|
||||
(add TX CHARW))
|
||||
(ADD NSPACES 1)
|
||||
" ")
|
||||
(TAB (add LENGTH CHARW)
|
||||
(add TX CHARW)
|
||||
"TAB")
|
||||
(Meta,TAB (add LENGTH CHARW)
|
||||
(add TX CHARW)
|
||||
"MTAB")
|
||||
(PROGN (add LENGTH CHARW)
|
||||
(add TX CHARW)
|
||||
(CHARACTER CHAR)))
|
||||
.FR 28 CHARW " " .I4 TX 35 CSLOT)
|
||||
(ADD CHNO 1)
|
||||
elseif [AND [OR (CHARSLOTP CHAR THISLINE)
|
||||
(AND (NULL CHAR)
|
||||
(NOT (TYPE? CHARLOOKS CHARW]
|
||||
(OR (EQ CSLOT PSP)
|
||||
(find CS incharslots (NEXTCHARSLOT CSLOT)
|
||||
while (CHARSLOTP CS THISLINE) suchthat (EQ CSLOT CHAR]
|
||||
then (* ; "Presumably a PREVSP")
|
||||
(ADD NSPACES 1)
|
||||
(printout OFILE " " .I5 CHNO ":")
|
||||
(ADD LENGTH CHARW)
|
||||
(ADD TX CHARW)
|
||||
(PRINTOUT OFILE " " (OR CHAR "[ENDSP]")
|
||||
.FR 28 CHARW " " .I4 TX 35 CSLOT)
|
||||
(ADD CHNO 1)
|
||||
elseif (SMALLP CHARW)
|
||||
then (if (EQ CSLOT FIRSTSPACESLOT)
|
||||
then (PRINTOUT OFILE "First space")
|
||||
else (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW)
|
||||
(add CHNO CHARW))
|
||||
elseif (type? CHARLOOKS CHARW)
|
||||
then (printout OFILE 7 CHARW 35 CSLOT)
|
||||
else (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T
|
||||
)
|
||||
(TERPRI OFILE)
|
||||
(GO $$OUT)
|
||||
(AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? "))
|
||||
(TERPRI OFILE)
|
||||
(GO $$OUT))]
|
||||
(TERPRI OFILE)
|
||||
finally (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2
|
||||
"next avail = " (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE)
|
||||
T)
|
||||
(printout OFILE "line length = " LENGTH -3 "right margin = "
|
||||
(AND LINE (GETLD LINE RIGHTMARGIN))
|
||||
-3 "X limit = " (AND LINE (GETLD (fetch (THISLINE DESC) of THISLINE)
|
||||
LXLIM))
|
||||
T)
|
||||
(printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = "
|
||||
(CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR))
|
||||
T])
|
||||
|
||||
(SPF
|
||||
[LAMBDA (ARG TITLE OFILE) (* ; "Edited 30-Aug-2024 21:25 by rmk")
|
||||
[LAMBDA (ARG TITLE OFILE) (* ; "Edited 29-Mar-2025 22:36 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 21:25 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 22:39 by rmk")
|
||||
(* ; "Edited 13-Aug-2024 10:45 by rmk")
|
||||
(* ; "Edited 11-Jul-2024 10:34 by rmk")
|
||||
@@ -703,9 +627,9 @@
|
||||
(SETQ TEXTOBJ (TEXTOBJ (\TEDIT.MAINW TEXTOBJ))))
|
||||
(SETQ PAGEREGIONS (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))
|
||||
(SETQ TITLE (CONCAT "Page regions for " (OR TITLE TEXTOBJ PAGEREGIONS)))
|
||||
(DEBUGOUTPUT OFILE 'SPF (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD)
|
||||
TITLE .FONT '(TERMINAL 8)
|
||||
T)
|
||||
(DEBUGOUTPUT OFILE 'SPF TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD)
|
||||
TITLE .FONT '(TERMINAL 8)
|
||||
T)
|
||||
(for TYPE PF (FIRSTPF _ (TEDIT.GET.PAGEFORMAT PAGEREGIONS 'FIRST/DEFAULT))
|
||||
in '(FIRST/DEFAULT LEFT RIGHT)
|
||||
collect (SETQ PF (TEDIT.GET.PAGEFORMAT PAGEREGIONS TYPE))
|
||||
@@ -975,6 +899,160 @@
|
||||
(SETQ VERSION (\SMALLPIN STREAM))
|
||||
(PRINTOUT OUTFILE VERSION " (" (IDIFFERENCE VERSION 31415)
|
||||
")" T])
|
||||
|
||||
(SSEL
|
||||
[LAMBDA (SEL TEXTOBJ OFILE) (* ; "Edited 3-Feb-2025 23:05 by rmk")
|
||||
(SETQ TEXTOBJ (GTO TEXTOBJ))
|
||||
(CL:UNLESS SEL
|
||||
(SETQ SEL (TEXTSEL TEXTOBJ)))
|
||||
(for I from (GETSEL SEL CH#) to (GETSEL SEL CHLAST) do (PRINTOUT OFILE (TEDIT.NTHCHAR TEXTOBJ I))
|
||||
)
|
||||
(TERPRI OFILE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(STL
|
||||
[LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 29-Mar-2025 22:36 by rmk")
|
||||
(* ; "Edited 22-Aug-2024 23:51 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 12:08 by rmk")
|
||||
(* ; "Edited 31-Jul-2024 19:55 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 09:20 by rmk")
|
||||
(* ; "Edited 1-Feb-2024 17:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 10:50 by rmk")
|
||||
(* ; "Edited 23-Nov-2023 11:41 by rmk")
|
||||
(* ; "Edited 23-Mar-2023 23:00 by rmk")
|
||||
|
||||
(* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done. During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible. When complete, they shouldn't appear.")
|
||||
|
||||
(* ;; "If OFILE isn't given, this goes to a textstream")
|
||||
|
||||
(DECLARE (USEDFREE PREVSP CHARSLOT))
|
||||
(CL:UNLESS (type? THISLINE THISLINE)
|
||||
(CL:WHEN (EQ THISLINE T)
|
||||
(SETQ THISLINE NIL)
|
||||
(SETQ LASTCS CHARSLOT))
|
||||
(SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE))))
|
||||
(\DTEST THISLINE 'THISLINE)
|
||||
(DEBUGOUTPUT OFILE (CL:IF OFILE
|
||||
NIL
|
||||
'STL)
|
||||
NIL
|
||||
(for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH TLSPACEFACTOR
|
||||
OF THISLINE))
|
||||
(FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE))
|
||||
(LINE _ (fetch (THISLINE DESC) of THISLINE))
|
||||
(NSPACES _ 0)
|
||||
(NCHARS _ 0)
|
||||
(SPACETOTAL _ 0)
|
||||
(PSP _ (AND (BOUNDP 'PREVSP)
|
||||
(NEQ PREVSP (GETATOMVAL 'PREVSP))
|
||||
PREVSP)) incharslots THISLINE as NSLOTS from 0
|
||||
first (if (NULL LINE)
|
||||
then (printout OFILE THISLINE ":" T 5
|
||||
"No line parameters, start at CHNO = 1 LX1 = 0" T)
|
||||
(SETQ CHNO 1)
|
||||
(SETQ TX 0)
|
||||
elseif (type? LINEDESCRIPTOR LINE)
|
||||
then (SETQ CHNO (GETLD LINE LCHAR1))
|
||||
(SETQ TX (GETLD LINE LX1))
|
||||
(printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO
|
||||
" LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM)
|
||||
T))
|
||||
(CL:WHEN LCHAR1
|
||||
(SETQ CHNO (OR LCHAR1 1)))
|
||||
(SETQ LENGTH TX)
|
||||
(printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT))
|
||||
(SETQ CHARW (CHARW CSLOT))
|
||||
(CL:UNLESS (CHARSLOTP CSLOT THISLINE)
|
||||
(HELP "THISLINE RUNS OFF THE EDGE"
|
||||
THISLINE))
|
||||
repeatuntil [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE]
|
||||
do (printout OFILE .I4 NSLOTS)
|
||||
[if (IMAGEOBJP CHAR)
|
||||
then (add NCHARS 1)
|
||||
(printout OFILE " " .I5 CHNO ": ")
|
||||
(add TX CHARW)
|
||||
(printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ")
|
||||
(SPPRINT.OBJ CHAR OFILE)
|
||||
(add LENGTH CHARW)
|
||||
(ADD CHNO 1)
|
||||
elseif (SMALLP CHAR)
|
||||
then (add NCHARS 1)
|
||||
(printout OFILE " " .I5 CHNO ": ")
|
||||
(printout OFILE .I3 CHAR " "
|
||||
(SELCHARQ CHAR
|
||||
((EOL CR LF)
|
||||
(add TX CHARW)
|
||||
(add LENGTH CHARW)
|
||||
"EOL")
|
||||
(FORM "FORM")
|
||||
(SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT)
|
||||
(SETQ EXPANDSPACES T))
|
||||
(if EXPANDSPACES
|
||||
then (add LENGTH (SCALEUP SPACEFACTOR CHARW))
|
||||
(add TX (SCALEUP SPACEFACTOR CHARW))
|
||||
else (add LENGTH CHARW)
|
||||
(add TX CHARW))
|
||||
(ADD NSPACES 1)
|
||||
" ")
|
||||
(TAB (add LENGTH CHARW)
|
||||
(add TX CHARW)
|
||||
"TAB")
|
||||
(Meta,TAB (add LENGTH CHARW)
|
||||
(add TX CHARW)
|
||||
"MTAB")
|
||||
(PROGN (add LENGTH CHARW)
|
||||
(add TX CHARW)
|
||||
(CHARACTER CHAR)))
|
||||
.FR 28 CHARW " " .I4 TX 35 CSLOT)
|
||||
(ADD CHNO 1)
|
||||
elseif [AND [OR (CHARSLOTP CHAR THISLINE)
|
||||
(AND (NULL CHAR)
|
||||
(NOT (TYPE? CHARLOOKS CHARW]
|
||||
(OR (EQ CSLOT PSP)
|
||||
(find CS incharslots (NEXTCHARSLOT CSLOT)
|
||||
while (CHARSLOTP CS THISLINE) suchthat (EQ CSLOT CHAR]
|
||||
then (* ; "Presumably a PREVSP")
|
||||
(ADD NSPACES 1)
|
||||
(printout OFILE " " .I5 CHNO ":")
|
||||
(ADD LENGTH CHARW)
|
||||
(ADD TX CHARW)
|
||||
(PRINTOUT OFILE " " (OR CHAR "[ENDSP]")
|
||||
.FR 28 CHARW " " .I4 TX 35 CSLOT)
|
||||
(ADD CHNO 1)
|
||||
elseif (SMALLP CHARW)
|
||||
then (if (EQ CSLOT FIRSTSPACESLOT)
|
||||
then (PRINTOUT OFILE "First space")
|
||||
else (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW)
|
||||
(add CHNO CHARW))
|
||||
elseif (type? CHARLOOKS CHARW)
|
||||
then (printout OFILE 7 CHARW 35 CSLOT)
|
||||
else (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T
|
||||
)
|
||||
(TERPRI OFILE)
|
||||
(GO $$OUT)
|
||||
(AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? "))
|
||||
(TERPRI OFILE)
|
||||
(GO $$OUT))]
|
||||
(TERPRI OFILE)
|
||||
finally (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2
|
||||
"next avail = " (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE)
|
||||
T)
|
||||
(printout OFILE "line length = " LENGTH -3 "right margin = "
|
||||
(AND LINE (GETLD LINE RIGHTMARGIN))
|
||||
-3 "X limit = " (AND LINE (GETLD (fetch (THISLINE DESC) of THISLINE)
|
||||
LXLIM))
|
||||
T)
|
||||
(printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = "
|
||||
(CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR))
|
||||
T])
|
||||
|
||||
(CLEARTHISLINE
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 6-Mar-2025 11:28 by rmk")
|
||||
(LET ((THISLINE (GETTOBJ (GTO TSTREAM)
|
||||
THISLINE)))
|
||||
(replace (THISLINE DESC) of THISLINE with NIL)
|
||||
(for CSLOT incharslots THISLINE do (FILLCHARSLOT CSLOT NIL NIL])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1212,7 +1290,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SPPRINT
|
||||
[LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "Edited 5-Aug-2024 00:30 by rmk")
|
||||
[LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "Edited 19-Feb-2025 12:21 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:41 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 00:30 by rmk")
|
||||
(* ; "Edited 5-May-2024 12:55 by rmk")
|
||||
(* ; "Edited 23-Apr-2024 08:54 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:58 by rmk")
|
||||
@@ -1275,12 +1355,12 @@
|
||||
.I4 PLEN (CL:IF (PPARALAST P)
|
||||
"*"
|
||||
"")
|
||||
(CL:IF (type? FMTSPEC PARALOOKS)
|
||||
(if (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOKS)
|
||||
then (CL:IF (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOKS)
|
||||
(CL:IF (type? PARALOOKS PARALOOKS)
|
||||
(if (GETPLOOKS PARALOOKS FMTNEWPAGEBEFORE)
|
||||
then (CL:IF (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
|
||||
"ba"
|
||||
"b")
|
||||
elseif (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOKS)
|
||||
elseif (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
|
||||
then "a"
|
||||
else "")
|
||||
"")
|
||||
@@ -1434,13 +1514,15 @@
|
||||
P])
|
||||
|
||||
(SBT
|
||||
[LAMBDA (DONTCLOSE ARG) (* ; "Edited 13-Jun-2024 22:00 by rmk")
|
||||
[LAMBDA (DONTCLOSE ARG) (* ; "Edited 28-Mar-2025 20:41 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 22:00 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:44 by rmk")
|
||||
(* ; "Edited 29-May-2023 17:23 by rmk")
|
||||
(* ; "Edited 26-May-2023 11:05 by rmk")
|
||||
|
||||
(* ;; "Inspect the BTREE")
|
||||
|
||||
(SETQ ARG (GTO ARG))
|
||||
(LET ([W (WINDOWP (GETATOMVAL 'BTW]
|
||||
(POS (CREATEPOSITION 50 10)))
|
||||
(if DONTCLOSE
|
||||
@@ -1449,8 +1531,9 @@
|
||||
OF (WINDOWPROP W 'REGION]
|
||||
10)))
|
||||
else (CLOSEW W))
|
||||
(SETATOMVAL 'BTW (INSPECT (fetch PCTB of (GTO ARG))
|
||||
'LIST POS])
|
||||
(SETATOMVAL 'BTW (INSPECT (GETTOBJ ARG PCTB)
|
||||
'LIST POS))
|
||||
(GETTOBJ ARG PCTB])
|
||||
|
||||
(COPYPCHAIN
|
||||
[LAMBDA (PIECES I J) (* ; "Edited 23-Sep-2023 11:38 by rmk")
|
||||
@@ -2006,58 +2089,12 @@
|
||||
(RPAQQ OK.TO.MODIFY.FNS T)
|
||||
(DEFINEQ
|
||||
|
||||
(DFOV
|
||||
[NLAMBDA ARGS (* ; "Edited 2-Dec-2024 08:14 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 22:17 by rmk")
|
||||
(* ; "Edited 12-Jan-2024 00:30 by rmk")
|
||||
(* ; "Edited 15-Dec-2023 12:36 by rmk")
|
||||
(* ; "Edited 13-Aug-2023 14:09 by rmk")
|
||||
|
||||
(* ;; "Brings in a function from an earlier version, for comparison. If FILE is a version number, it uses WHEREIS")
|
||||
|
||||
(SETQ ARGS (NLAMBDA.ARGS ARGS))
|
||||
(PROG ((FN (POP ARGS))
|
||||
(FNFILE (POP ARGS))
|
||||
(VERSION (POP ARGS))
|
||||
(DIRLIST (POP ARGS))
|
||||
ALTFNS)
|
||||
(CL:WHEN (FIXP FNFILE)
|
||||
(SETQ VERSION FNFILE)
|
||||
(SETQ FNFILE NIL))
|
||||
[if (AND FNFILE (MEMB FNFILE (WHEREIS FN 'FNS T)))
|
||||
elseif (SETQ FNFILE (CAR (WHEREIS FN 'FNS T)))
|
||||
else (CL:WHEN (EQ (CHARCODE \)
|
||||
(CHCON1 FN))
|
||||
(push ALTFNS (SUBATOM FN 2)))
|
||||
(if (STRPOS "TEDIT." FN NIL NIL T)
|
||||
then (push ALTFNS (PACK* "\" FN))
|
||||
elseif (NOT (STRPOS "\TEDIT." FN 1 NIL T))
|
||||
then (push ALTFNS (PACK* "\TEDIT." FN)))
|
||||
(for AF F in ALTFNS when (SETQ F (CAR (WHEREIS AF 'FNS T)))
|
||||
collect (LIST AF F) finally (if (CDR $$VAL)
|
||||
then (PRINTOUT T "Possible names/files for " FN
|
||||
", be more specific" T)
|
||||
elseif $$VAL
|
||||
then (SETQ FN (CAAR $$VAL))
|
||||
(SETQ FNFILE (CADAR $$VAL))
|
||||
elseif FNFILE
|
||||
then (PRINTOUT T FN " not found on " FNFILE T)
|
||||
else (PRINTOUT T FN " not found" T]
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST FN 'FNS FNFILE VERSION DIRLIST NIL NIL NIL '(:DONTWAIT])
|
||||
|
||||
(OLDWI
|
||||
[LAMBDA (FN) (* ; "Edited 16-May-2023 12:02 by rmk")
|
||||
(for F COMS in TEDITFILES when (AND (SETQ F (DFOV.OLDEST F))
|
||||
(INFILECOMS? FN NIL (GETDEF (FILECOMS F)
|
||||
'VARS F))) collect F])
|
||||
|
||||
(DFOV.OLDEST
|
||||
[LAMBDA (FILE DIRLIST) (* ; "Edited 15-Dec-2023 12:22 by rmk")
|
||||
(* ; "Edited 13-Aug-2023 07:30 by rmk")
|
||||
(* ; "Edited 16-May-2023 11:07 by rmk")
|
||||
(CAR (LAST (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST])
|
||||
|
||||
(COMP
|
||||
[LAMBDA (FN) (* ; "Edited 5-Feb-2023 20:14 by rmk")
|
||||
(COMPAREDEFS FN 'FNS (LIST 'SAVE (CAR (REMOVE 'SAVE (WHEREIS FN 'FNS T])
|
||||
@@ -2325,25 +2362,27 @@
|
||||
|
||||
(PUTPROPS DEBUGOUTPUT MACRO
|
||||
[ARGS
|
||||
`(LET [(OFILE ,(CAR ARGS))
|
||||
(WTYPE ,(CADR ARGS]
|
||||
(RESETLST
|
||||
[if WTYPE
|
||||
then [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE)
|
||||
NIL NIL '(FONT DEFAULTFONT]
|
||||
[RESETSAVE NIL
|
||||
`(PROGN (CL:UNLESS RESETSTATE
|
||||
[TEDIT OFILE WTYPE NIL
|
||||
`(READONLY QUIET LEAVETTY T TITLE
|
||||
,WTYPE]
|
||||
(WINDOWPROP (WFROMDS OFILE)
|
||||
'TEDIT-DEBUG T))]
|
||||
elseif OFILE
|
||||
then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE (DSPFONT NIL OFILE)
|
||||
'(PROGN (DSPFONT OLDVALUE OFILE]
|
||||
,@(CDDR ARGS))])
|
||||
`(LET
|
||||
[(OFILE ,(CAR ARGS))
|
||||
(WTYPE ,(CADR ARGS))
|
||||
(TITLE ,(CADDR ARGS]
|
||||
(RESETLST
|
||||
[if WTYPE
|
||||
then [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE)
|
||||
NIL NIL '(FONT DEFAULTFONT]
|
||||
[RESETSAVE NIL
|
||||
`(PROGN (CL:UNLESS RESETSTATE
|
||||
[TEDIT OFILE WTYPE NIL
|
||||
`(READONLY QUIET LEAVETTY T TITLE
|
||||
,(OR TITLE WTYPE]
|
||||
(WINDOWPROP (WFROMDS OFILE)
|
||||
'TEDIT-DEBUG T))]
|
||||
elseif OFILE
|
||||
then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE (DSPFONT NIL OFILE)
|
||||
'(PROGN (DSPFONT OLDVALUE OFILE]
|
||||
,@(CDDDR ARGS))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2423,37 +2462,37 @@
|
||||
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA VSEE DFGV DFOV)
|
||||
(ADDTOVAR NLAMA VSEE DFGV)
|
||||
|
||||
(ADDTOVAR NLAML DFVENUE DFR)
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4852 7411 (GTO 4862 . 5112) (GTS 5114 . 6885) (GTW 6887 . 7043) (GSEL 7045 . 7409)) (
|
||||
7468 20599 (IPC 7478 . 8982) (ILINES 8984 . 11525) (ISEL 11527 . 12138) (ITS 12140 . 13864) (IPANES
|
||||
13866 . 14101) (ITL 14103 . 14522) (IHIST 14524 . 17186) (IPCTB 17188 . 17496) (IMB 17498 . 18113) (
|
||||
ICL 18115 . 18680) (IPL 18682 . 19086) (ICARET 19088 . 19465) (INSPECTPIECES 19467 . 20597)) (20621
|
||||
55720 (SP 20631 . 25148) (SL 25150 . 28294) (SSP 28296 . 29727) (STL 29729 . 38241) (SPF 38243 . 40542
|
||||
) (SLF 40544 . 49677) (SHOWLINE 49679 . 53241) (SLL 53243 . 53990) (STBYTES 53992 . 55718)) (55721
|
||||
61094 (NTHPIECE 55731 . 56863) (NPIECES 56865 . 57730) (NTHPIECECHAR 57732 . 59040) (SELPIECE 59042 .
|
||||
59484) (PIECENUM 59486 . 60205) (PCBYTES 60207 . 61092)) (61095 63569 (FILEBYTES 61105 . 62529) (
|
||||
TFILEBYTES 62531 . 63567)) (63570 64892 (TRELMOVE 63580 . 63823) (TSCROLL 63825 . 63991) (TSCROLL*
|
||||
63993 . 64890)) (64893 67942 (TRY 64903 . 66172) (TEDITCLOSEW 66174 . 66517) (PARALASTWITHOUTEOL 66519
|
||||
. 67404) (FIXPARALAST 67406 . 67940)) (67943 82273 (SPPRINT 67953 . 74369) (SPPRINT.CHAR 74371 .
|
||||
75355) (SPPRINT.OBJ 75357 . 78415) (SHOWPIECEBYTES 78417 . 79973) (CHECKPLENGTHS 79975 . 80432) (SBT
|
||||
80434 . 81423) (COPYPCHAIN 81425 . 82271)) (82274 84335 (POSLINE 82284 . 84333)) (84336 85219 (
|
||||
PRESPLIT 84346 . 85217)) (85220 86933 (ALLTL 85230 . 86483) (NTHCHARSLOT 86485 . 86931)) (86959 97172
|
||||
(PLCHAIN 86969 . 87497) (PRINTLINE 87499 . 90489) (SL.GETLINES 90491 . 93784) (CHECKLINES 93786 .
|
||||
94766) (COLLECTLINES 94768 . 95020) (NTHLINE 95022 . 96027) (HEIGHT 96029 . 96317) (LINEBOTS 96319 .
|
||||
97170)) (97173 99621 (IPC.DECODEARGS 97183 . 99619)) (99622 100215 (SPF1 99632 . 100213)) (100244
|
||||
102622 (SLF.FATPLEN 100254 . 101113) (FILEPIECE 101115 . 102620)) (102655 103423 (SELTEDIT 102665 .
|
||||
103421)) (103493 109105 (PPARA 103503 . 103925) (PRUN 103927 . 105403) (ADDLINEPOSITIONS 105405 .
|
||||
106832) (SBR 106834 . 107488) (SBC 107490 . 109103)) (109162 113837 (DFOV 109172 . 111642) (OLDWI
|
||||
111644 . 112019) (DFOV.OLDEST 112021 . 112446) (COMP 112448 . 112643) (DFR 112645 . 113835)) (113838
|
||||
114871 (DFGV 113848 . 114374) (GDIRECTORIES 114376 . 114869)) (114872 121437 (TTEST 114882 . 119414) (
|
||||
LTEST 119416 . 120781) (THC 120783 . 121435)) (121751 122443 (SHOWSAFE 121761 . 122441)) (122496
|
||||
122943 (MYH 122506 . 122941)) (123188 124283 (DFVENUE 123198 . 124077) (VSEE 124079 . 124281)) (124284
|
||||
124738 (PTT 124294 . 124736)) (125985 128301 (TEDIT-DEBUG 125995 . 128299)) (128302 130038 (TRENAME
|
||||
128312 . 130036)))))
|
||||
(FILEMAP (NIL (4984 7543 (GTO 4994 . 5244) (GTS 5246 . 7017) (GTW 7019 . 7175) (GSEL 7177 . 7541)) (
|
||||
7576 8135 (TEST.TEMPLATE 7586 . 8133)) (8136 9071 (TESTACTION 8146 . 9069)) (9096 22911 (IPC 9106 .
|
||||
10610) (ILINES 10612 . 13153) (ISEL 13155 . 13766) (ITS 13768 . 15492) (IPANES 15494 . 15729) (ITL
|
||||
15731 . 16150) (IHIST 16152 . 18814) (IPCTB 18816 . 19242) (IMB 19244 . 20003) (ICL 20005 . 20706) (
|
||||
IPL 20708 . 21248) (ICARET 21250 . 21777) (INSPECTPIECES 21779 . 22909)) (22933 50561 (SP 22943 .
|
||||
27587) (SL 27589 . 31035) (SSP 31037 . 32592) (SPF 32594 . 35020) (SLF 35022 . 44155) (SHOWLINE 44157
|
||||
. 47719) (SLL 47721 . 48468) (STBYTES 48470 . 50196) (SSEL 50198 . 50559)) (50562 59579 (STL 50572 .
|
||||
59208) (CLEARTHISLINE 59210 . 59577)) (59580 64953 (NTHPIECE 59590 . 60722) (NPIECES 60724 . 61589) (
|
||||
NTHPIECECHAR 61591 . 62899) (SELPIECE 62901 . 63343) (PIECENUM 63345 . 64064) (PCBYTES 64066 . 64951))
|
||||
(64954 67428 (FILEBYTES 64964 . 66388) (TFILEBYTES 66390 . 67426)) (67429 68751 (TRELMOVE 67439 .
|
||||
67682) (TSCROLL 67684 . 67850) (TSCROLL* 67852 . 68749)) (68752 71801 (TRY 68762 . 70031) (TEDITCLOSEW
|
||||
70033 . 70376) (PARALASTWITHOUTEOL 70378 . 71263) (FIXPARALAST 71265 . 71799)) (71802 86449 (SPPRINT
|
||||
71812 . 78397) (SPPRINT.CHAR 78399 . 79383) (SPPRINT.OBJ 79385 . 82443) (SHOWPIECEBYTES 82445 . 84001)
|
||||
(CHECKPLENGTHS 84003 . 84460) (SBT 84462 . 85599) (COPYPCHAIN 85601 . 86447)) (86450 88511 (POSLINE
|
||||
86460 . 88509)) (88512 89395 (PRESPLIT 88522 . 89393)) (89396 91109 (ALLTL 89406 . 90659) (NTHCHARSLOT
|
||||
90661 . 91107)) (91135 101348 (PLCHAIN 91145 . 91673) (PRINTLINE 91675 . 94665) (SL.GETLINES 94667 .
|
||||
97960) (CHECKLINES 97962 . 98942) (COLLECTLINES 98944 . 99196) (NTHLINE 99198 . 100203) (HEIGHT 100205
|
||||
. 100493) (LINEBOTS 100495 . 101346)) (101349 103797 (IPC.DECODEARGS 101359 . 103795)) (103798 104391
|
||||
(SPF1 103808 . 104389)) (104420 106798 (SLF.FATPLEN 104430 . 105289) (FILEPIECE 105291 . 106796)) (
|
||||
106831 107599 (SELTEDIT 106841 . 107597)) (107669 113281 (PPARA 107679 . 108101) (PRUN 108103 . 109579
|
||||
) (ADDLINEPOSITIONS 109581 . 111008) (SBR 111010 . 111664) (SBC 111666 . 113279)) (113338 115114 (
|
||||
OLDWI 113348 . 113723) (COMP 113725 . 113920) (DFR 113922 . 115112)) (115115 116148 (DFGV 115125 .
|
||||
115651) (GDIRECTORIES 115653 . 116146)) (116149 122714 (TTEST 116159 . 120691) (LTEST 120693 . 122058)
|
||||
(THC 122060 . 122712)) (123028 123720 (SHOWSAFE 123038 . 123718)) (123773 124220 (MYH 123783 . 124218
|
||||
)) (124465 125560 (DFVENUE 124475 . 125354) (VSEE 125356 . 125558)) (125561 126015 (PTT 125571 .
|
||||
126013)) (127250 129566 (TEDIT-DEBUG 127260 . 129564)) (129567 131303 (TRENAME 129577 . 131301)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,43 +1,86 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jan-2023 20:34:02" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;3 2095
|
||||
(FILECREATED " 9-Mar-2025 20:03:27" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;10 3274
|
||||
|
||||
:CHANGES-TO (FNS Apps.RemoveBackgroundMenuItem)
|
||||
:EDIT-BY "frank"
|
||||
|
||||
:PREVIOUS-DATE "17-Jan-2023 20:29:39" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;2
|
||||
:CHANGES-TO (FNS LOADUP-APPS)
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2025 19:42:36" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;8
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-APPSCOMS)
|
||||
|
||||
(RPAQQ LOADUP-APPSCOMS ((GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
|
||||
(FNS Apps.LOADUP Apps.RemoveBackgroundMenuItem)))
|
||||
(FNS LOADUP-APPS Apps.RemoveBackgroundMenuItem)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(Apps.LOADUP
|
||||
[LAMBDA NIL (* ; "Edited 12-Nov-2022 14:03 by FGH")
|
||||
(PROGN
|
||||
(* ;; " Delete button(s) that are created when lispusers/BUTTONS is loaded")
|
||||
(LOADUP-APPS
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-2025 20:02 by frank")
|
||||
(* ; "Edited 2-Jan-2025 20:38 by lmm")
|
||||
(* ; "Edited 2-Jan-2025 06:30 by larry")
|
||||
|
||||
(for B in *ALL-BUTTONS* do (DELETE-BUTTON B))
|
||||
(* ;; "= = = = = = = = = = = = = = = = = =")
|
||||
|
||||
(* ;; " Remove the BUTTONS BackgroundMenu item")
|
||||
(* ;; " Load ROOMS")
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem "Button Control")
|
||||
(* ;; "")
|
||||
|
||||
(* ;; " Remove the NoteCards Background Menu Item")
|
||||
(DOFILESLOAD `((SYSLOAD SOURCE)
|
||||
(FROM ,(MEDLEYDIR "ROOMS"))
|
||||
ROOMS))
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem 'NoteCards)
|
||||
(* ;; "======================")
|
||||
|
||||
(* ;; " Remove the CLOS Background Menu Item")
|
||||
(* ;; " Load Notecards and %"fix up%"")
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem 'BrowseClass)
|
||||
(RPLACA [CAR (LIST '(A B C]
|
||||
NIL])
|
||||
(* ;; "")
|
||||
|
||||
(DOFILESLOAD `((SYSLOAD)
|
||||
(FROM ,(CONCAT (UNIX-GETENV "NOTECARDSDIR")
|
||||
"/system"))
|
||||
NOTECARDS))
|
||||
(Apps.RemoveBackgroundMenuItem 'NoteCards) (* ; "")
|
||||
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS_COMMIT_ID))
|
||||
SYSOUTCOMMITS)
|
||||
|
||||
(* ;; "======================")
|
||||
|
||||
(* ;; " Load CLOS and %"fix up%"")
|
||||
|
||||
(* ;; " Assumes that clos/DEFSYS.DFASL has already been loaded (so CLOS: package is defined)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(LOADUP-CLOS)
|
||||
(CLOS::LOAD-CLOS) (* ; "")
|
||||
(Apps.RemoveBackgroundMenuItem 'BrowseClass)
|
||||
|
||||
(* ;; "= = = = = = = = = = = = = == = = = ")
|
||||
|
||||
(* ;; " Load lispusers/BUTTONS and %"fix up%"")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(DOFILESLOAD '((SYSLOAD)
|
||||
BUTTONS))
|
||||
(Apps.RemoveBackgroundMenuItem "Button Control")
|
||||
(for B in *ALL-BUTTONS* do (DELETE-BUTTON B))
|
||||
|
||||
(* ;; "= = = = = = = = = = = = = == = = = ")
|
||||
|
||||
(* ;; " Do misc")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP_COMMIT_ID))
|
||||
SYSOUTCOMMITS)
|
||||
(PRINTOUT T "commits-- " SYSOUTCOMMITS T])
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem
|
||||
[LAMBDA (ItemStringOrAtom)
|
||||
@@ -52,5 +95,5 @@
|
||||
Apps.SBG])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (647 2072 (Apps.LOADUP 657 . 1400) (Apps.RemoveBackgroundMenuItem 1402 . 2070)))))
|
||||
(FILEMAP (NIL (656 3251 (LOADUP-APPS 666 . 2579) (Apps.RemoveBackgroundMenuItem 2581 . 3249)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
23
internal/loadups/LOADUP-CLOS
Normal file
23
internal/loadups/LOADUP-CLOS
Normal file
@@ -0,0 +1,23 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Mar-2025 19:04:34" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-CLOS.;1 600
|
||||
|
||||
:EDIT-BY "frank"
|
||||
|
||||
:CHANGES-TO (VARS LOADUP-CLOSCOMS))
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-CLOSCOMS)
|
||||
|
||||
(RPAQQ LOADUP-CLOSCOMS ((FNS LOADUP-CLOS)))
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-CLOS
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-2025 18:53 by frank")
|
||||
(DOFILESLOAD `((SYSLOAD)
|
||||
(FROM ,(MEDLEYDIR "CLOS"))
|
||||
DEFSYS])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (333 577 (LOADUP-CLOS 343 . 575)))))
|
||||
STOP
|
||||
BIN
internal/loadups/LOADUP-CLOS.LCOM
Normal file
BIN
internal/loadups/LOADUP-CLOS.LCOM
Normal file
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Jul-2023 18:28:53" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;4 4521
|
||||
(FILECREATED "23-Apr-2025 05:14:27" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;2 4662
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-FULL)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2023 16:23:36" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;3
|
||||
:CHANGES-TO (FNS LOADFULLFONTS)
|
||||
|
||||
:PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;1
|
||||
)
|
||||
|
||||
|
||||
@@ -15,7 +17,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADFULLFONTS
|
||||
[LAMBDA NIL (* ; "Edited 13-Feb-2021 22:51 by larry")
|
||||
[LAMBDA NIL (* ; "Edited 23-Apr-2025 05:13 by lmm")
|
||||
(* ; "Edited 13-Feb-2021 22:51 by larry")
|
||||
|
||||
(* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")
|
||||
|
||||
@@ -35,7 +38,7 @@
|
||||
(PRINTOUT T T))
|
||||
(PRINTOUT T " Loading postscript fonts" T)
|
||||
(for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
|
||||
">c0>*.*")) do (PSCFONT.READFONT F))
|
||||
">c0>*.PSCFONT")) do (PSCFONT.READFONT F))
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
@@ -86,5 +89,5 @@
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (467 4483 (LOADFULLFONTS 477 . 1918) (LOADUP-FULL 1920 . 4233) (FIXMETA 4235 . 4481)))))
|
||||
(FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
351
internal/loadups/man-page/loadup.1
Normal file
351
internal/loadups/man-page/loadup.1
Normal file
@@ -0,0 +1,351 @@
|
||||
.\" Automatically generated by Pandoc 3.1.3
|
||||
.\"
|
||||
.\" Define V font for inline verbatim, using C font in formats
|
||||
.\" that render this, and otherwise B font.
|
||||
.ie "\f[CB]x\f[]"x" \{\
|
||||
. ftr V B
|
||||
. ftr VI BI
|
||||
. ftr VB B
|
||||
. ftr VBI BI
|
||||
.\}
|
||||
.el \{\
|
||||
. ftr V CR
|
||||
. ftr VI CI
|
||||
. ftr VB CB
|
||||
. ftr VBI CBI
|
||||
.\}
|
||||
.ad l
|
||||
.TH "loadup" "1" "" "" "Run the Medley loadup procedure"
|
||||
.nh
|
||||
.SH NAME
|
||||
.PP
|
||||
\f[B]loadup\f[R] \[em] runs a loadup procedure for Medley Interlisp
|
||||
.SH SYNOPSIS
|
||||
.PP
|
||||
\f[B]<MEDLEYDIR>/scripts/loadup\f[R] [ options \&...
|
||||
]
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Runs all or part of the \f[B]loadup\f[R] procedure for Medley Interlisp.
|
||||
The loadup procedure is used to create the standard sysout files from
|
||||
which you can start a Medley session as well as other standard files
|
||||
that are useful in running Medley.
|
||||
After cloning Medley from GitHub or after making significant changes to
|
||||
the Medley source, you need to run the loadup procedure to (re)create
|
||||
these standard files.
|
||||
.PP
|
||||
The complete loadup procedure happens in 5 sequential stages with each
|
||||
stage depending on successful completion of the previous stage.
|
||||
There are two other non-sequential stages (Aux and DB), which depend
|
||||
only on the completion of Stage 4 (full.sysout).
|
||||
.PP
|
||||
You need not run all 5 stages, depending on what sysout files you need
|
||||
to create for your work.
|
||||
The target files created in each stage are copied into a loadups
|
||||
directory (<MEDLEYDIR>/loadups).
|
||||
The \f[I]medley\f[R] run script and other Medley tools look for these
|
||||
files in the loadups directory.
|
||||
.PP
|
||||
The 5 sequential stages and their main products are:
|
||||
.RS
|
||||
.IP "1." 3
|
||||
\f[B]Init:\f[R] create an \f[I]init.dlinit\f[R] sysout file.
|
||||
This init.dlinit file is used internally for Stage 2 and is not copied
|
||||
into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "2." 3
|
||||
\f[B]Mid:\f[R] create an \f[I]init-mid.sysout\f[R].
|
||||
This init-mid.sysout is used only internally for Stage 3 and is not
|
||||
copied into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "3." 3
|
||||
\f[B]Lisp:\f[R] create \f[I]lisp.sysout\f[R].
|
||||
Lisp.sysout has a minimal set of Medley\[cq]s functionality loaded and
|
||||
can be used as the basis for running a stripped-down Medley session.
|
||||
Lisp.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "4." 3
|
||||
\f[B]Full:\f[R] create \f[I]full.sysout\f[R].
|
||||
Full.sysout has all of the \[lq]standard\[rq] set of Medley
|
||||
functionality loaded and is the primary sysout used for running Medley
|
||||
sessions.
|
||||
Full.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RS
|
||||
.IP "5." 3
|
||||
\f[B]Apps:\f[R]: create \f[I]apps.sysout\f[R].
|
||||
Apps.sysout includes everything in full.sysout plus the Medley
|
||||
applications Buttons, CLOS, Rooms, and Notecards.
|
||||
.RE
|
||||
.PP
|
||||
The two independent stages that can be run if the first 4 sequential
|
||||
stages complete successfully are:
|
||||
.RS
|
||||
.IP \[bu] 2
|
||||
\f[B]Aux:\f[R]: create the \f[I]whereis.hash\f[R] and
|
||||
\f[I]exports.all\f[R] files.
|
||||
These are databases that are commonly used when working on Medley source
|
||||
code.
|
||||
They are copied into the loadups directory.
|
||||
.IP \[bu] 2
|
||||
\f[B]DB:\f[R]: creates the \f[I]fuller.database\f[R] file.
|
||||
Fuller.database is a Mastercope database created by analyzing all of the
|
||||
source code included in full.sysout.
|
||||
(Stage 4) Fuller.database is copied into the loadups directory.
|
||||
.RE
|
||||
.PP
|
||||
Loadup does all of its work in a work directory
|
||||
(<MEDLEYDIR>loadups/build).
|
||||
The target files are copied from this work directory to the loadups
|
||||
directory if the loadup is successful.
|
||||
Each stage of the loadup also creates a dribble file containing the
|
||||
terminal output from within the Medley environment.
|
||||
These dribble files are also copied to the loadups directory, but also
|
||||
remain available in the work directory after the loadup completes.
|
||||
.PP
|
||||
Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
|
||||
There is lock file to prevent simultaneous loadups in the work directory
|
||||
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
|
||||
The lock can also be automatically overridden (see the \[en]override
|
||||
flag below).
|
||||
Alternatively, if a lock is encountered at run time, the user will be
|
||||
asked to choose whether to override or simply exit the loadup.
|
||||
.PP
|
||||
Note: \f[B]MEDLEYDIR\f[R] is an environment variable set by the loadup
|
||||
script.
|
||||
It is set to the top level directory of the Medley installation that
|
||||
contains the specific loadup script that is invoked after all symbolic
|
||||
links are resolved.
|
||||
In the standard global installation this will be
|
||||
/usr/local/interlisp/medley.
|
||||
But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of loadup.
|
||||
.SH OPTIONS
|
||||
.TP
|
||||
\f[B]-z, --man, -man\f[R]
|
||||
Print this manual page on the screen.
|
||||
.TP
|
||||
\f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
|
||||
Run the sequential loadup procedure until the STAGE is complete,
|
||||
starting from the files created by the previously run STAGE specified in
|
||||
the \[en]start option.
|
||||
.RS
|
||||
.PP
|
||||
STAGE can be one of the following:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
|
||||
Init.dlinit is \f[I]not\f[R] copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout).
|
||||
Init-mid.sysout is \f[I]not\f[R] copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout).
|
||||
Lisp.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
f, full, 4: Run the loadup sequence through Stage 4 (full.sysout).
|
||||
Full.sysout is copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
Also run the Aux stage as if \[en]aux option had been specified.
|
||||
Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
The Aux stage is not run unless otherwise specified.
|
||||
Apps.sysout is copied into the loadups directory.
|
||||
Also run the Aux stage as if \[en]aux option had been specified.
|
||||
.RE
|
||||
.RE
|
||||
.TP
|
||||
\f[B]-s STAGE --start STAGE, -start STAGE\f[R]
|
||||
Start the loadup process using the files previously created by STAGE.
|
||||
These files are looked for first in the loadups directory or, if not
|
||||
found there, in the work directory.
|
||||
It is an error if the files created by STAGE cannot be found.
|
||||
.RS
|
||||
.PP
|
||||
STAGE can be one of the following:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
s, scratch, 0 : Start the loadup process from the beginning.
|
||||
This is the default.
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
i, init, 1 : Start the loadup process using the files created by Stage 1
|
||||
(init.dlinit).
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
m, mid, 2 : Start the loadup process using the files created by Stage 2
|
||||
(init-mid.sysout).
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
l, lisp, 3 : Start the loadup process using the files created by Stage 3
|
||||
(lisp.sysout)
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
f, full, 4 : Start the loadup process using the files created by Stage 4
|
||||
(full.sysout).
|
||||
.RE
|
||||
.RE
|
||||
.TP
|
||||
\f[B]-x, --aux, -aux\f[R]
|
||||
Run the Aux loadup stage, creating the \f[I]whereis.hash\f[R] and
|
||||
\f[I]exports.all\f[R] files.
|
||||
If loadup completes successfully, these files are copied into loadups.
|
||||
.TP
|
||||
\f[B]-b, --db, -db\f[R]
|
||||
Run the DB loadup stage, creating the \f[I]fuller.database\f[R] file.
|
||||
If this stage complete successfully, these files are copied into
|
||||
loadups.
|
||||
.TP
|
||||
\f[B]-i, --init, -init, -1\f[R]
|
||||
Synonym for \[lq]\[en]target init\[rq]
|
||||
.TP
|
||||
\f[B]-m, --mid, -mid, -2\f[R]
|
||||
Synonym for \[lq]\[en]target mid\[rq]
|
||||
.TP
|
||||
\f[B]-l, --lisp, -lisp, -3\f[R]
|
||||
Synonym for \[lq]\[en]target lisp\[rq]
|
||||
.TP
|
||||
\f[B]-f, --full. -full, -4\f[R]
|
||||
Synonym for \[lq]\[en]target full\[rq]
|
||||
.TP
|
||||
\f[B]-a, --apps, -apps, -5\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
.TP
|
||||
\f[B]-a-, --apps-, -apps-, -5-\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
.TP
|
||||
\f[B]-ov, --override, -override\f[R]
|
||||
Automatically override the lock that prevents two loadups from running
|
||||
simultaneously.
|
||||
If this flag is not set and an active lock is encountered, the user will
|
||||
be asked to choose whether to override or exit.
|
||||
.TP
|
||||
\f[B]-nc, --nocopy, -nocopy\f[R]
|
||||
Run the specified loadups, but do not copy results into loadups
|
||||
directory.
|
||||
.TP
|
||||
\f[B]-tw, --thinw, -thinw\f[R]
|
||||
Before running loadups (if any), thin the working directory by deleting
|
||||
all versioned (\f[I].\[ti][0-9]\f[R]\[ti]) files.
|
||||
.TP
|
||||
\f[B]-tl, --thinl, -thinl\f[R]
|
||||
Before running loadups (if any), thin the loadups directory by deleting
|
||||
all versioned (\f[I].\[ti][0-9]\f[R]\[ti]) files.
|
||||
.TP
|
||||
\f[B]-d DIR --maikodir DIR, -maikodir DIR\f[R]
|
||||
Use DIR as the directory from which to execute lde (Miko) when running
|
||||
Medley in the loadup process.
|
||||
If this flag is not present, the value of the environment variable
|
||||
MAIKODIR will be used instead.
|
||||
And if MAIKODIR does not exist, then the default Maiko directory search
|
||||
within Medley will be used.
|
||||
.SH DEFAULTS
|
||||
.PP
|
||||
The defaults for the Options context-dependent and somewhat complicated
|
||||
due to the goal of maintaining compatibility with legacy loadup scripts.
|
||||
All of the following defaults rules hold independent of the
|
||||
\[en]maikodir (-d) option.
|
||||
.IP "1." 3
|
||||
If none of \[en]target, \[en]start, \[en]aux, and \[en]db are specified,
|
||||
then:
|
||||
.RS
|
||||
.PP
|
||||
1A.
|
||||
If neither \[en]thinw nor \[en]thinl are specified, the options default
|
||||
to:
|
||||
.RE
|
||||
.RS
|
||||
.RS
|
||||
.PP
|
||||
\f[B]\[en]target full \[en]start 0 \[en]aux\f[R]
|
||||
.RE
|
||||
.RE
|
||||
.RS
|
||||
.PP
|
||||
1B.
|
||||
If either \[en]thinw or \[en]thinl are specified, no loadups are run.
|
||||
.RE
|
||||
.IP "2." 3
|
||||
If neither \[en]start nor \[en]target are specified but either -aux or
|
||||
-db or both are, then \[en]start defaults to \f[I]full\f[R] and
|
||||
\[en]target is irrelevant.
|
||||
.IP "3." 3
|
||||
If \[en]start is specified and \[en]target is not, then \[en]target
|
||||
defaults to \f[I]full\f[R]
|
||||
.IP "4." 3
|
||||
If \[en]target is specified and \[en]start is not, then \[en]start
|
||||
defaults to \f[I]0\f[R]
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
\f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
|
||||
starting from existing Stage 3 outputs (lisp.sysout).
|
||||
.PP
|
||||
\f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
|
||||
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
.PP
|
||||
\f[B]./loadup -5 \[en]aux\f[R] : run loadup from the beginning thru
|
||||
Stage 5 (apps.sysout) then run the Aux \[lq]stage\[rq] to create
|
||||
\f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
|
||||
.PP
|
||||
\f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
|
||||
an existing full.sysout; do not run any of the sequential stages.
|
||||
.PP
|
||||
\f[B]./loadup \[en]maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
|
||||
from beginning to full plus the loadup Aux stage, while using
|
||||
\f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
|
||||
running Medley.
|
||||
.PP
|
||||
\f[B]./loadup -full\f[R] : run loadup sequence from beginning thru full
|
||||
.PP
|
||||
\f[B]./loadup -apps\f[R] : run loadup sequence from beginning thru app.
|
||||
Also run the Aux stage loadup.
|
||||
.PP
|
||||
\f[B]./loadup -apps-\f[R] : run loadup sequence from beginning thru app.
|
||||
Do not run the Aux stage loadup.
|
||||
.SH BUGS
|
||||
.PP
|
||||
See GitHub Issues: <https://github.com/Interlisp/medley/issues>
|
||||
.SH COPYRIGHT
|
||||
.PP
|
||||
Copyright(c) 2025 by Interlisp.org
|
||||
BIN
internal/loadups/man-page/loadup.1.gz
Normal file
BIN
internal/loadups/man-page/loadup.1.gz
Normal file
Binary file not shown.
182
internal/loadups/man-page/loadup.1.md
Normal file
182
internal/loadups/man-page/loadup.1.md
Normal file
@@ -0,0 +1,182 @@
|
||||
% loadup(1) | Run the Medley loadup procedure
|
||||
|
||||
---
|
||||
adjusting: l
|
||||
hyphenate: false
|
||||
---
|
||||
|
||||
NAME
|
||||
====
|
||||
|
||||
**loadup** — runs a loadup procedure for Medley Interlisp
|
||||
|
||||
SYNOPSIS
|
||||
========
|
||||
|
||||
**\<MEDLEYDIR>/scripts/loadup** \[ options ... ]
|
||||
|
||||
|
||||
DESCRIPTION
|
||||
===========
|
||||
|
||||
Runs all or part of the **loadup** procedure for Medley Interlisp. The loadup procedure is used to create the standard sysout files from which you can start a Medley session as well as other standard files that are useful in running Medley. After cloning Medley from GitHub or after making significant changes to the Medley source, you need to run the loadup procedure to (re)create these standard files.
|
||||
|
||||
The complete loadup procedure happens in 5 sequential stages with each stage depending on successful completion
|
||||
of the previous stage. There are two other non-sequential stages (Aux and DB), which depend only on the completion
|
||||
of Stage 4 (full.sysout).
|
||||
|
||||
You need not run all 5 stages, depending on what sysout files you need to create for your work.
|
||||
The target files created in each stage are copied into a loadups directory (\<MEDLEYDIR>/loadups).
|
||||
The *medley* run script and other Medley tools look for these files in the loadups directory.
|
||||
|
||||
The 5 sequential stages and their main products are:
|
||||
|
||||
>1. **Init:** create an *init.dlinit* sysout file. This init.dlinit file is used internally for Stage 2 and is not copied into the loadups directory.
|
||||
|
||||
>2. **Mid:** create an *init-mid.sysout*. This init-mid.sysout is used only internally for Stage 3 and is not copied into the loadups directory.
|
||||
|
||||
>3. **Lisp:** create *lisp.sysout*. Lisp.sysout has a minimal set of Medley's functionality loaded and can be used as the basis for running a stripped-down Medley session. Lisp.sysout is copied into the loadups directory.
|
||||
|
||||
>4. **Full:** create *full.sysout*. Full.sysout has all of the "standard" set of Medley functionality loaded and is the primary sysout used for running Medley sessions. Full.sysout is copied into the loadups directory.
|
||||
|
||||
>5. **Apps:**: create *apps.sysout*. Apps.sysout includes everything in full.sysout plus the Medley applications Buttons, CLOS, Rooms, and Notecards.
|
||||
|
||||
|
||||
The two independent stages that can be run if the first 4 sequential stages complete successfully are:
|
||||
|
||||
>+ **Aux:**: create the *whereis.hash* and *exports.all* files. These are databases that are commonly used when working on Medley source code. They are copied into the loadups directory.
|
||||
>+ **DB:**: creates the *fuller.database* file. Fuller.database is a Mastercope database created by analyzing all of the source code included in full.sysout. (Stage 4) Fuller.database is copied into the loadups directory.
|
||||
|
||||
|
||||
Loadup does all of its work in a work directory (\<MEDLEYDIR>loadups/build). The target files are copied from this work directory to the loadups directory if the loadup is successful. Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment. These dribble files are also copied to the loadups directory, but also remain available in the work directory after the loadup completes.
|
||||
|
||||
|
||||
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
||||
|
||||
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
|
||||
is invoked after all symbolic links are resolved. In the standard global installation this will
|
||||
be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of loadup.
|
||||
|
||||
OPTIONS
|
||||
=======
|
||||
**-z, \-\-man, \-man**
|
||||
: Print this manual page on the screen.
|
||||
|
||||
**-t STAGE, \-\-target STAGE, -target STAGE**
|
||||
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the --start option.
|
||||
|
||||
>STAGE can be one of the following:
|
||||
|
||||
>>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit). Init.dlinit is *not* copied into the loadups directory.
|
||||
|
||||
>>m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout). Init-mid.sysout is *not* copied into the loadups directory.
|
||||
|
||||
>>l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout). Lisp.sysout is copied into the loadups directory.
|
||||
|
||||
>>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.
|
||||
|
||||
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if --aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
|
||||
|
||||
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if --aux option had been specified.
|
||||
|
||||
|
||||
**-s STAGE \-\-start STAGE, -start STAGE**
|
||||
: Start the loadup process using the files previously created by STAGE. These files are looked for first in the loadups directory or, if not found there, in the work directory. It is an error if the files created by STAGE cannot be found.
|
||||
|
||||
>STAGE can be one of the following:
|
||||
|
||||
>>s, scratch, 0 : Start the loadup process from the beginning. This is the default.
|
||||
|
||||
>> i, init, 1 : Start the loadup process using the files created by Stage 1 (init.dlinit).
|
||||
|
||||
>>m, mid, 2 : Start the loadup process using the files created by Stage 2 (init-mid.sysout).
|
||||
|
||||
>>l, lisp, 3 : Start the loadup process using the files created by Stage 3 (lisp.sysout)
|
||||
|
||||
>>f, full, 4 : Start the loadup process using the files created by Stage 4 (full.sysout).
|
||||
|
||||
**-x, \-\-aux, -aux**
|
||||
: Run the Aux loadup stage, creating the *whereis.hash* and *exports.all* files. If loadup completes successfully, these files are copied into loadups.
|
||||
|
||||
**-b, \-\-db, \-db**
|
||||
: Run the DB loadup stage, creating the *fuller.database* file. If this stage complete successfully, these files are copied into loadups.
|
||||
|
||||
**-i, \-\-init, -init, -1**
|
||||
: Synonym for "--target init"
|
||||
|
||||
**-m, \-\-mid, -mid, -2**
|
||||
: Synonym for "--target mid"
|
||||
|
||||
**-l, \-\-lisp, -lisp, -3**
|
||||
: Synonym for "--target lisp"
|
||||
|
||||
**-f, \-\-full. -full, -4**
|
||||
: Synonym for "--target full"
|
||||
|
||||
**-a, \-\-apps, -apps, -5**
|
||||
: Synonym for "--target apps"
|
||||
|
||||
**-a-, \-\-apps-, -apps-, -5-**
|
||||
: Synonym for "--target apps"
|
||||
|
||||
**-ov, \-\-override, -override**
|
||||
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
|
||||
|
||||
**-nc, \-\-nocopy, -nocopy**
|
||||
: Run the specified loadups, but do not copy results into loadups directory.
|
||||
|
||||
**-tw, \-\-thinw, -thinw**
|
||||
: Before running loadups (if any), thin the working directory by deleting all versioned (*.~[0-9]*~) files.
|
||||
|
||||
**-tl, \-\-thinl, -thinl**
|
||||
: Before running loadups (if any), thin the loadups directory by deleting all versioned (*.~[0-9]*~) files.
|
||||
|
||||
**-d DIR \-\-maikodir DIR, -maikodir DIR**
|
||||
: Use DIR as the directory from which to execute lde (Miko) when running Medley in the loadup process. If this flag is not present, the value of the environment variable MAIKODIR will be used instead. And if MAIKODIR does not exist, then the default Maiko directory search within Medley will be used.
|
||||
|
||||
DEFAULTS
|
||||
====
|
||||
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the --maikodir (-d) option.
|
||||
|
||||
1. If none of --target, --start, --aux, and --db are specified, then:
|
||||
|
||||
>1A. If neither --thinw nor --thinl are specified, the options default to:
|
||||
|
||||
>> **--target full --start 0 --aux**
|
||||
|
||||
>1B. If either --thinw or --thinl are specified, no loadups are run.
|
||||
|
||||
2. If neither --start nor --target are specified but either -aux or -db or both are, then --start defaults to *full* and --target is irrelevant.
|
||||
|
||||
3. If --start is specified and --target is not, then --target defaults to *full*
|
||||
|
||||
4. If --target is specified and --start is not, then --start defaults to *0*
|
||||
|
||||
EXAMPLES
|
||||
====
|
||||
**./loadup -full -s lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
|
||||
**./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||
|
||||
**./loadup -5 --aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
|
||||
|
||||
**./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
|
||||
|
||||
**./loadup --maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
|
||||
|
||||
**./loadup -full** : run loadup sequence from beginning thru full
|
||||
|
||||
**./loadup -apps** : run loadup sequence from beginning thru app. Also run the Aux stage loadup.
|
||||
|
||||
**./loadup -apps-** : run loadup sequence from beginning thru app. Do not run the Aux stage loadup.
|
||||
|
||||
BUGS
|
||||
====
|
||||
|
||||
See GitHub Issues: <https://github.com/Interlisp/medley/issues>
|
||||
|
||||
COPYRIGHT
|
||||
=========
|
||||
|
||||
Copyright(c) 2025 by Interlisp.org
|
||||
2
internal/loadups/man-page/man2html.sh
Executable file
2
internal/loadups/man-page/man2html.sh
Executable file
@@ -0,0 +1,2 @@
|
||||
#!/bin/bash
|
||||
pandoc --from man --to html < loadup.1 > man_loadup.html
|
||||
279
internal/loadups/man-page/man_loadup.html
Normal file
279
internal/loadups/man-page/man_loadup.html
Normal file
@@ -0,0 +1,279 @@
|
||||
<h1>NAME</h1>
|
||||
<p><strong>loadup</strong> — runs a loadup procedure for Medley
|
||||
Interlisp</p>
|
||||
<h1>SYNOPSIS</h1>
|
||||
<p><strong><MEDLEYDIR>/scripts/loadup</strong> [ options ... ]</p>
|
||||
<h1>DESCRIPTION</h1>
|
||||
<p>Runs all or part of the <strong>loadup</strong> procedure for Medley
|
||||
Interlisp. The loadup procedure is used to create the standard sysout
|
||||
files from which you can start a Medley session as well as other
|
||||
standard files that are useful in running Medley. After cloning Medley
|
||||
from GitHub or after making significant changes to the Medley source,
|
||||
you need to run the loadup procedure to (re)create these standard
|
||||
files.</p>
|
||||
<p>The complete loadup procedure happens in 5 sequential stages with
|
||||
each stage depending on successful completion of the previous stage.
|
||||
There are two other non-sequential stages (Aux and DB), which depend
|
||||
only on the completion of Stage 4 (full.sysout).</p>
|
||||
<p>You need not run all 5 stages, depending on what sysout files you
|
||||
need to create for your work. The target files created in each stage are
|
||||
copied into a loadups directory (<MEDLEYDIR>/loadups). The
|
||||
<em>medley</em> run script and other Medley tools look for these files
|
||||
in the loadups directory.</p>
|
||||
<p>The 5 sequential stages and their main products are:</p>
|
||||
<blockquote>
|
||||
<ol type="1">
|
||||
<li><p><strong>Init:</strong> create an <em>init.dlinit</em> sysout
|
||||
file. This init.dlinit file is used internally for Stage 2 and is not
|
||||
copied into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="2" type="1">
|
||||
<li><p><strong>Mid:</strong> create an <em>init-mid.sysout</em>. This
|
||||
init-mid.sysout is used only internally for Stage 3 and is not copied
|
||||
into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="3" type="1">
|
||||
<li><p><strong>Lisp:</strong> create <em>lisp.sysout</em>. Lisp.sysout
|
||||
has a minimal set of Medley’s functionality loaded and can be used as
|
||||
the basis for running a stripped-down Medley session. Lisp.sysout is
|
||||
copied into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="4" type="1">
|
||||
<li><p><strong>Full:</strong> create <em>full.sysout</em>. Full.sysout
|
||||
has all of the “standard” set of Medley functionality loaded and is the
|
||||
primary sysout used for running Medley sessions. Full.sysout is copied
|
||||
into the loadups directory.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<ol start="5" type="1">
|
||||
<li><p><strong>Apps:</strong>: create <em>apps.sysout</em>. Apps.sysout
|
||||
includes everything in full.sysout plus the Medley applications Buttons,
|
||||
CLOS, Rooms, and Notecards.</p></li>
|
||||
</ol>
|
||||
</blockquote>
|
||||
<p>The two independent stages that can be run if the first 4 sequential
|
||||
stages complete successfully are:</p>
|
||||
<blockquote>
|
||||
<ul>
|
||||
<li><p><strong>Aux:</strong>: create the <em>whereis.hash</em> and
|
||||
<em>exports.all</em> files. These are databases that are commonly used
|
||||
when working on Medley source code. They are copied into the loadups
|
||||
directory.</p></li>
|
||||
<li><p><strong>DB:</strong>: creates the <em>fuller.database</em> file.
|
||||
Fuller.database is a Mastercope database created by analyzing all of the
|
||||
source code included in full.sysout. (Stage 4) Fuller.database is copied
|
||||
into the loadups directory.</p></li>
|
||||
</ul>
|
||||
</blockquote>
|
||||
<p>Loadup does all of its work in a work directory
|
||||
(<MEDLEYDIR>loadups/build). The target files are copied from this
|
||||
work directory to the loadups directory if the loadup is successful.
|
||||
Each stage of the loadup also creates a dribble file containing the
|
||||
terminal output from within the Medley environment. These dribble files
|
||||
are also copied to the loadups directory, but also remain available in
|
||||
the work directory after the loadup completes.</p>
|
||||
<p>Only one instance (per <MEDLEIDIR>) of loadup can be run at a
|
||||
time. There is lock file to prevent simultaneous loadups in the work
|
||||
directory (named <strong><em>lock</em></strong>) that can be manually
|
||||
removed. The lock can also be automatically overridden (see the
|
||||
–override flag below). Alternatively, if a lock is encountered at run
|
||||
time, the user will be asked to choose whether to override or simply
|
||||
exit the loadup.</p>
|
||||
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
|
||||
the loadup script. It is set to the top level directory of the Medley
|
||||
installation that contains the specific loadup script that is invoked
|
||||
after all symbolic links are resolved. In the standard global
|
||||
installation this will be /usr/local/interlisp/medley. But Medley can be
|
||||
installed in multiple places on any given machine and hence MEDLEYDIR is
|
||||
computed on each invocation of loadup.</p>
|
||||
<h1>OPTIONS</h1>
|
||||
<dl>
|
||||
<dt><strong>-z, --man, -man</strong></dt>
|
||||
<dd>
|
||||
<p>Print this manual page on the screen.</p>
|
||||
</dd>
|
||||
<dt><strong>-t STAGE, --target STAGE, -target STAGE</strong></dt>
|
||||
<dd>
|
||||
<p>Run the sequential loadup procedure until the STAGE is complete,
|
||||
starting from the files created by the previously run STAGE specified in
|
||||
the –start option.</p>
|
||||
<p>STAGE can be one of the following:</p>
|
||||
<blockquote>
|
||||
<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
|
||||
Init.dlinit is <em>not</em> copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>m, mid, 2: Run the loadup sequence through Stage 2 (init-mid.sysout).
|
||||
Init-mid.sysout is <em>not</em> copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>l, lisp, 3: Run the loadup sequence through Stage 3 (lisp.sysout).
|
||||
Lisp.sysout is copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout).
|
||||
Full.sysout is copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
Also run the Aux stage as if –aux option had been specified. Apps.sysout
|
||||
and the Aux files are copied into the loadups directory.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||
The Aux stage is not run unless otherwise specified. Apps.sysout is
|
||||
copied into the loadups directory. Also run the Aux stage as if –aux
|
||||
option had been specified.</p>
|
||||
</blockquote>
|
||||
</dd>
|
||||
<dt><strong>-s STAGE --start STAGE, -start STAGE</strong></dt>
|
||||
<dd>
|
||||
<p>Start the loadup process using the files previously created by STAGE.
|
||||
These files are looked for first in the loadups directory or, if not
|
||||
found there, in the work directory. It is an error if the files created
|
||||
by STAGE cannot be found.</p>
|
||||
<p>STAGE can be one of the following:</p>
|
||||
<blockquote>
|
||||
<p>s, scratch, 0 : Start the loadup process from the beginning. This is
|
||||
the default.</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>i, init, 1 : Start the loadup process using the files created by
|
||||
Stage 1 (init.dlinit).</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>m, mid, 2 : Start the loadup process using the files created by Stage
|
||||
2 (init-mid.sysout).</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>l, lisp, 3 : Start the loadup process using the files created by
|
||||
Stage 3 (lisp.sysout)</p>
|
||||
</blockquote>
|
||||
<blockquote>
|
||||
<p>f, full, 4 : Start the loadup process using the files created by
|
||||
Stage 4 (full.sysout).</p>
|
||||
</blockquote>
|
||||
</dd>
|
||||
<dt><strong>-x, --aux, -aux</strong></dt>
|
||||
<dd>
|
||||
<p>Run the Aux loadup stage, creating the <em>whereis.hash</em> and
|
||||
<em>exports.all</em> files. If loadup completes successfully, these
|
||||
files are copied into loadups.</p>
|
||||
</dd>
|
||||
<dt><strong>-b, --db, -db</strong></dt>
|
||||
<dd>
|
||||
<p>Run the DB loadup stage, creating the <em>fuller.database</em> file.
|
||||
If this stage complete successfully, these files are copied into
|
||||
loadups.</p>
|
||||
</dd>
|
||||
<dt><strong>-i, --init, -init, -1</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target init”</p>
|
||||
</dd>
|
||||
<dt><strong>-m, --mid, -mid, -2</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target mid”</p>
|
||||
</dd>
|
||||
<dt><strong>-l, --lisp, -lisp, -3</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target lisp”</p>
|
||||
</dd>
|
||||
<dt><strong>-f, --full. -full, -4</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target full”</p>
|
||||
</dd>
|
||||
<dt><strong>-a, --apps, -apps, -5</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
|
||||
<dd>
|
||||
<p>Synonym for “–target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-ov, --override, -override</strong></dt>
|
||||
<dd>
|
||||
<p>Automatically override the lock that prevents two loadups from
|
||||
running simultaneously. If this flag is not set and an active lock is
|
||||
encountered, the user will be asked to choose whether to override or
|
||||
exit.</p>
|
||||
</dd>
|
||||
<dt><strong>-nc, --nocopy, -nocopy</strong></dt>
|
||||
<dd>
|
||||
<p>Run the specified loadups, but do not copy results into loadups
|
||||
directory.</p>
|
||||
</dd>
|
||||
<dt><strong>-tw, --thinw, -thinw</strong></dt>
|
||||
<dd>
|
||||
<p>Before running loadups (if any), thin the working directory by
|
||||
deleting all versioned (<em>.~[0-9]</em>~) files.</p>
|
||||
</dd>
|
||||
<dt><strong>-tl, --thinl, -thinl</strong></dt>
|
||||
<dd>
|
||||
<p>Before running loadups (if any), thin the loadups directory by
|
||||
deleting all versioned (<em>.~[0-9]</em>~) files.</p>
|
||||
</dd>
|
||||
<dt><strong>-d DIR --maikodir DIR, -maikodir DIR</strong></dt>
|
||||
<dd>
|
||||
<p>Use DIR as the directory from which to execute lde (Miko) when
|
||||
running Medley in the loadup process. If this flag is not present, the
|
||||
value of the environment variable MAIKODIR will be used instead. And if
|
||||
MAIKODIR does not exist, then the default Maiko directory search within
|
||||
Medley will be used.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>DEFAULTS</h1>
|
||||
<p>The defaults for the Options context-dependent and somewhat
|
||||
complicated due to the goal of maintaining compatibility with legacy
|
||||
loadup scripts. All of the following defaults rules hold independent of
|
||||
the –maikodir (-d) option.</p>
|
||||
<ol type="1">
|
||||
<li><p>If none of –target, –start, –aux, and –db are specified,
|
||||
then:</p>
|
||||
<p>1A. If neither –thinw nor –thinl are specified, the options default
|
||||
to:</p>
|
||||
<blockquote>
|
||||
<p><strong>–target full –start 0 –aux</strong></p>
|
||||
</blockquote>
|
||||
<p>1B. If either –thinw or –thinl are specified, no loadups are
|
||||
run.</p></li>
|
||||
<li><p>If neither –start nor –target are specified but either -aux or
|
||||
-db or both are, then –start defaults to <em>full</em> and –target is
|
||||
irrelevant.</p></li>
|
||||
<li><p>If –start is specified and –target is not, then –target defaults
|
||||
to <em>full</em></p></li>
|
||||
<li><p>If –target is specified and –start is not, then –start defaults
|
||||
to <em>0</em></p></li>
|
||||
</ol>
|
||||
<h1>EXAMPLES</h1>
|
||||
<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
|
||||
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).</p>
|
||||
<p><strong>./loadup --target full --start lisp</strong> : run loadup
|
||||
thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
|
||||
(lisp.sysout).</p>
|
||||
<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning
|
||||
thru Stage 5 (apps.sysout) then run the Aux “stage” to create
|
||||
<em>whereis.hash</em> and <em>exports.all</em></p>
|
||||
<p><strong>./loadup -db</strong> : just run the DB “stage” starting from
|
||||
an existing full.sysout; do not run any of the sequential stages.</p>
|
||||
<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup
|
||||
sequence from beginning to full plus the loadup Aux stage, while using
|
||||
<em>~/il/newmaiko</em> as the location for the lde executables when
|
||||
running Medley.</p>
|
||||
<p><strong>./loadup -full</strong> : run loadup sequence from beginning
|
||||
thru full</p>
|
||||
<p><strong>./loadup -apps</strong> : run loadup sequence from beginning
|
||||
thru app. Also run the Aux stage loadup.</p>
|
||||
<p><strong>./loadup -apps-</strong> : run loadup sequence from beginning
|
||||
thru app. Do not run the Aux stage loadup.</p>
|
||||
<h1>BUGS</h1>
|
||||
<p>See GitHub Issues:
|
||||
<https://github.com/Interlisp/medley/issues></p>
|
||||
<h1>COPYRIGHT</h1>
|
||||
<p>Copyright(c) 2025 by Interlisp.org</p>
|
||||
3
internal/loadups/man-page/md2man.sh
Executable file
3
internal/loadups/man-page/md2man.sh
Executable file
@@ -0,0 +1,3 @@
|
||||
#!/bin/bash
|
||||
pandoc loadup.1.md -s -t man -o loadup.1
|
||||
gzip --stdout loadup.1 >loadup.1.gz
|
||||
4
internal/loadups/man-page/publish.sh
Executable file
4
internal/loadups/man-page/publish.sh
Executable file
@@ -0,0 +1,4 @@
|
||||
#!/bin/bash
|
||||
./md2man.sh
|
||||
./man2html.sh
|
||||
|
||||
2
internal/loadups/man-page/showmd.sh
Executable file
2
internal/loadups/man-page/showmd.sh
Executable file
@@ -0,0 +1,2 @@
|
||||
#!/bin/bash
|
||||
pandoc loadup.1.md -s -t man | /usr/bin/man -l -
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28 197707
|
||||
(FILECREATED " 5-Apr-2025 11:49:04" {WMEDLEY}<library>MASTERSCOPE.;29 197994
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jul-2024 11:54:48" {WMEDLEY}<library>MASTERSCOPE.;27)
|
||||
:PREVIOUS-DATE "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||
@@ -2577,7 +2577,7 @@
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE "14-Jul-2024")
|
||||
(RPAQ MASTERSCOPEDATE " 5-Apr-2025")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3526,7 +3526,8 @@
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 5-Apr-2025 11:48 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||
(LET ((LLENGTH FILELINELENGTH))
|
||||
@@ -3536,10 +3537,12 @@
|
||||
'(TEDIT :TEDIT))
|
||||
(GETD (FUNCTION TEDIT)))
|
||||
|
||||
(* ;; "If no TEDIT, leave the current OUTPUT")
|
||||
(* ;;
|
||||
"If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
|
||||
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT]
|
||||
,DEFAULTFONT BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE]
|
||||
(SETQ LLENGTH T)
|
||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
||||
@@ -3778,7 +3781,7 @@ CHANGEI.S. 118360 . 119693) (CHANGERECORD 119695 . 120566) (MSNEEDUNSAVE 120568
|
||||
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)))))
|
||||
) (CHECKPATHS 161990 . 162630) (ONFILE 162632 . 167810)) (167813 192172 (MSINTERPRET 167823 . 184676)
|
||||
(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187300) (MSCHECKEMPTY 187302 . 188506) (
|
||||
CHECKFORCHANGED 188508 . 189028) (MSSOLVE 189030 . 192170)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60 14292
|
||||
(FILECREATED "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62 14729
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SEE-PDF)
|
||||
:CHANGES-TO (FNS OPEN-PDF-STREAM)
|
||||
|
||||
:PREVIOUS-DATE "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59)
|
||||
:PREVIOUS-DATE "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -153,7 +153,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPEN-PDF-STREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Feb-2025 12:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 14:49 by rmk")
|
||||
|
||||
@@ -171,20 +172,26 @@
|
||||
(* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
else (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
|
||||
(SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
elseif (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE)
|
||||
'HOST))
|
||||
then
|
||||
(* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index. Nothing to convert")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
elseif (SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
then (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
|
||||
(CLOSE-PDF-STREAM
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
@@ -285,8 +292,8 @@
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3255 5869 (PDFFILEP 3265 . 4179) (PDF.HARDCOPYW 4181 . 4779) (PDF.TEXT 4781 . 5498) (
|
||||
PDF.TEDIT 5500 . 5867)) (6309 13369 (OPEN-PDF-STREAM 6319 . 8455) (CLOSE-PDF-STREAM 8457 . 9744) (
|
||||
PS-TO-PDF 9746 . 13367)) (13370 13934 (SEE-PDF 13380 . 13932)) (13985 14269 (PDFCONVERTER 13995 .
|
||||
14267)))))
|
||||
(FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
|
||||
PDF.TEDIT 5508 . 5875)) (6317 13806 (OPEN-PDF-STREAM 6327 . 8892) (CLOSE-PDF-STREAM 8894 . 10181) (
|
||||
PS-TO-PDF 10183 . 13804)) (13807 14371 (SEE-PDF 13817 . 14369)) (14422 14706 (PDFCONVERTER 14432 .
|
||||
14704)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2 164484
|
||||
(FILECREATED "15-Feb-2025 13:05:52" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;3 164570
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
|
||||
:CHANGES-TO (FNS LAFITE.SET.LOOKS LAFITE.SUBSTITUTE.VP.EOL)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
|
||||
@@ -560,7 +560,7 @@
|
||||
(LAFITE.SET.LOOKS TEXTSTREAM LAFITEFIXEDWIDTHFONT])
|
||||
|
||||
(LAFITE.SET.LOOKS
|
||||
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN)
|
||||
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN) (* ; "Edited 15-Feb-2025 13:02 by rmk")
|
||||
(* ; "Edited 3-Nov-89 14:50 by bvm")
|
||||
|
||||
(* ;; "Called from Looks (sub)commands of Lafite display window. Change the looks of the current selection (if there is an interesting one) or the whole message to be NEWLOOKS. If NEWLOOKS is T, we use TEdit's menu interface. PARALOOKS is for paragraph formatting. USERFN is arbitrary function called with arg textstream & selection set appropriately. Any of NEWLOOKS, PARALOOKS, USERFN can be NIL. If OMITHEADER is true, the header is left out of the modification if user has not selected a region of text already.")
|
||||
@@ -571,57 +571,56 @@
|
||||
(LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
|
||||
START LEN WIDTH FIXEDLOOKS)
|
||||
[if (AND (NOT PARALOOKS)
|
||||
(FONTP NEWLOOKS)
|
||||
(EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
|
||||
NEWLOOKS))
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
NEWLOOKS)))
|
||||
then (* ; "If font is fixed-width, let's make the tab the right width. Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")
|
||||
(SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
|
||||
(if (> (SETQ LEN (fetch (SELECTION DCH) of SEL))
|
||||
1)
|
||||
then (* ; "User has already selected something. Assume any selection greater than a single character is not accidental.")
|
||||
(if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM
|
||||
'LAFITEFIXEDLOOKS))
|
||||
T))
|
||||
then
|
||||
(FONTP NEWLOOKS)
|
||||
(EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
|
||||
NEWLOOKS))
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
NEWLOOKS)))
|
||||
then (* ; "If font is fixed-width, let's make the tab the right width. Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")
|
||||
(SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
|
||||
(if (> (SETQ LEN (TEDIT.SELPROP SEL 'LENGTH))
|
||||
1)
|
||||
then (* ; "User has already selected something. Assume any selection greater than a single character is not accidental.")
|
||||
(if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM
|
||||
'LAFITEFIXEDLOOKS))
|
||||
T))
|
||||
then
|
||||
(* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything. If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")
|
||||
|
||||
(* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything. If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")
|
||||
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
|
||||
(CONS (CONS (fetch (SELECTION CH#) of SEL)
|
||||
LEN)
|
||||
FIXEDLOOKS)))
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
|
||||
(CONS (CONS (TEDIT.SELPROP SEL 'CH#)
|
||||
LEN)
|
||||
FIXEDLOOKS)))
|
||||
else (SETQ START (if OMITHEADER
|
||||
then (* ;
|
||||
"Start after the blank line following the header")
|
||||
(\LAFITE.HEADER.EOF TEXTSTREAM)
|
||||
else 0))
|
||||
(SETQ LEN (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
START))
|
||||
(TEDIT.SETSEL TEXTSTREAM (ADD1 START)
|
||||
LEN
|
||||
'RIGHT)
|
||||
(if FIXEDLOOKS
|
||||
then (* ; "The whole thing is fixed now")
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
|
||||
then (* ;
|
||||
"Start after the blank line following the header")
|
||||
(\LAFITE.HEADER.EOF TEXTSTREAM)
|
||||
else 0))
|
||||
(SETQ LEN (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
START))
|
||||
(TEDIT.SETSEL TEXTSTREAM (ADD1 START)
|
||||
LEN
|
||||
'RIGHT)
|
||||
(if FIXEDLOOKS
|
||||
then (* ; "The whole thing is fixed now")
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
|
||||
|
||||
(* ;; "Now do the modification")
|
||||
|
||||
(if (EQ NEWLOOKS T)
|
||||
then (* ; "Use menu")
|
||||
(\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
|
||||
then (* ; "Use menu")
|
||||
(\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
|
||||
elseif NEWLOOKS
|
||||
then (TEDIT.LOOKS TEXTSTREAM NEWLOOKS))
|
||||
(if PARALOOKS
|
||||
then (* ; "Paragraph looks")
|
||||
(TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
|
||||
then (* ; "Paragraph looks")
|
||||
(TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
|
||||
(if USERFN
|
||||
then (* ; "Arbitrary user manipulation.")
|
||||
(CL:FUNCALL USERFN TEXTSTREAM))
|
||||
then (* ; "Arbitrary user manipulation.")
|
||||
(CL:FUNCALL USERFN TEXTSTREAM))
|
||||
|
||||
(* ;; "Finally, set selection back to where it was.")
|
||||
|
||||
@@ -657,31 +656,31 @@
|
||||
STR])
|
||||
|
||||
(LAFITE.SUBSTITUTE.VP.EOL
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 4-Aug-89 16:55 by bvm")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 13:03 by rmk")
|
||||
(* ; "Edited 4-Aug-89 16:55 by bvm")
|
||||
|
||||
(* ;;
|
||||
"Called from Looks (sub)commands of Lafite display window. Replace VP eol (29) with ours.")
|
||||
(* ;; "Called from Looks (sub)commands of Lafite display window. Replace VP eol (29) with ours.")
|
||||
|
||||
(RESETLST
|
||||
(RESETSAVE NIL (LIST 'TEXTPROP TEXTSTREAM 'READONLY T))
|
||||
(TEXTPROP TEXTSTREAM 'READONLY NIL)
|
||||
(LET* ((SEL (TEDIT.GETSEL TEXTSTREAM))
|
||||
(LEN (fetch (SELECTION DCH) of SEL))
|
||||
POS)
|
||||
(if (<= LEN 1)
|
||||
then (* ;
|
||||
"If user has already selected something (more than a single character), assume is not accidental.")
|
||||
(SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
|
||||
(TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
POS)))
|
||||
(TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
|
||||
(ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
(if POS
|
||||
then (* ; "Undo the selection")
|
||||
(TEDIT.SETSEL TEXTSTREAM 1 0))))])
|
||||
(LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
|
||||
POS)
|
||||
(if (<= (TEDIT.SELPROP SEL 'LENGTH)
|
||||
1)
|
||||
then (* ;
|
||||
"If user has already selected something (more than a single character), assume is not accidental.")
|
||||
(SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
|
||||
(TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
|
||||
(if LAFITEENDOFMESSAGESTR
|
||||
then (NCHARS LAFITEENDOFMESSAGESTR)
|
||||
else 0)
|
||||
POS)))
|
||||
(TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
|
||||
(ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
(if POS
|
||||
then (* ; "Undo the selection")
|
||||
(TEDIT.SETSEL TEXTSTREAM 1 0))))])
|
||||
)
|
||||
|
||||
(RPAQ? \LAFITE.DISPLAY.COMMANDS NIL)
|
||||
@@ -2546,37 +2545,37 @@
|
||||
(ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) (
|
||||
SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 .
|
||||
24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548
|
||||
36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) (
|
||||
\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV
|
||||
31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138)
|
||||
) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) (
|
||||
\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 .
|
||||
41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) (
|
||||
LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) (
|
||||
\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) (
|
||||
\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST
|
||||
55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC
|
||||
60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU
|
||||
69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) (
|
||||
\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 (
|
||||
\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175)
|
||||
(\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) (
|
||||
LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877
|
||||
. 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) (
|
||||
\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) (
|
||||
LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1
|
||||
105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) (
|
||||
\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387
|
||||
. 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) (
|
||||
\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY
|
||||
138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288
|
||||
163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) (
|
||||
\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) (
|
||||
\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) (
|
||||
\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) (
|
||||
\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) (
|
||||
\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261)))))
|
||||
(FILEMAP (NIL (7764 27568 (\LAFITE.DISPLAY 7774 . 9479) (\LAFITE.DO.DISPLAY 9481 . 13646) (
|
||||
SELECTMESSAGETODISPLAY 13648 . 16016) (MESSAGEDISPLAYER 16018 . 23570) (LA.COPY.MESSAGE.TEXT 23572 .
|
||||
24326) (\LAFITE.CLOSE.DISPLAYWINDOWS 24328 . 25922) (\LAFITE.CLOSE.DISPLAYER 25924 . 27566)) (27569
|
||||
36161 (\LAFITE.UNHIDE.HEADERS 27579 . 28669) (\LAFITE.HIDE.HEADERS 28671 . 29324) (
|
||||
\LAFITE.REHIDE.HEADERS 29326 . 30362) (LAFITE.EAT.UNDESIRABLE.FIELD 30364 . 31123) (LAFITE.EAT.GVGV
|
||||
31125 . 32286) (\LAFITE.HARDCOPY.FROM.DISPLAY 32288 . 35807) (LAFITE.HARDCOPY.TAB.WIDTH 35809 . 36159)
|
||||
) (36162 44530 (\LAFITE.SET.LOOKS.FROM.MENU 36172 . 36349) (\LAFITE.SET.DEFAULT.LOOKS 36351 . 36542) (
|
||||
\LAFITE.SET.FIXED.LOOKS 36544 . 36736) (LAFITE.SET.LOOKS 36738 . 41179) (LAFITE.SET.TAB.LOOKS 41181 .
|
||||
41892) (LAFITE.SET.PARA.SEPARATION 41894 . 42102) (LAFITE.SET.LOWER.CASE 42104 . 42955) (
|
||||
LAFITE.SUBSTITUTE.VP.EOL 42957 . 44528)) (46447 54775 (LAFITE.DELETE.MESSAGES 46457 . 47507) (
|
||||
\LAFITE.DELETE 47509 . 48696) (DISPLAYAFTERDELETE 48698 . 53424) (\LAFITE.SELECT.NEXT 53426 . 54064) (
|
||||
\LAFITE.UNDELETE 54066 . 54773)) (54797 69292 (LAFITE.MOVE.MESSAGES 54807 . 55454) (\COERCE.TO.MSGLST
|
||||
55456 . 56214) (\LAFITE.MOVETO 56216 . 60160) (\LAFITE.COPYTO 60162 . 60578) (\LAFITE.MOVETO.PROC
|
||||
60580 . 61850) (\LAFITE.MOVE.MESSAGES.INTERNAL 61852 . 69290)) (69318 77870 (\LAFITE.ENABLE.MOVE.MENU
|
||||
69328 . 70370) (\LAFITE.ADD.TO.MOVE.MENU 70372 . 71388) (\LAFITE.UPDATE.MOVE.MENU 71390 . 76030) (
|
||||
\LAFITE.RESTORE.MOVE.MENU 76032 . 76708) (\LAFITE.HANDLE.AUTO.MOVE 76710 . 77868)) (78726 96210 (
|
||||
\LAFITE.UPDATE 78736 . 84369) (\LAFITE.EXPUNGE.PROC 84371 . 85176) (\LAFITE.UPDATE.PROC 85178 . 86261)
|
||||
(\LAFITE.HARDCOPYONLY.PROC 86263 . 86705) (LAB.CHOOSE.UPDATE.MENU 86707 . 87488) (
|
||||
LAB.CREATE.UPDATE.MENU 87490 . 89389) (LAB.UPDATE.NEEDED? 89391 . 90961) (\LAFITE.START.UPDATE 90963
|
||||
. 91995) (LAB.START.COMMAND 91997 . 92847) (\LAFITE.FINISH.UPDATE 92849 . 95102) (
|
||||
\LAFITE.CLOSE.OTHER.FOLDERS 95104 . 96208)) (96211 131005 (LAB.FLUSHWINDOW 96221 . 97900) (
|
||||
LAB.APPENDMESSAGES 97902 . 101064) (\LAFITE.COMPACT.FOLDER 101066 . 105230) (\LAFITE.COMPACT.FOLDER1
|
||||
105232 . 121271) (\LAFITE.COMPACT.FOLDER2 121273 . 125987) (\LAFITE.COMPACT.EXTRA 125989 . 128304) (
|
||||
\LAFITE.INVALIDATE.TOC 128306 . 128999) (\LAFITE.RENAMEFILE 129001 . 129471) (SMART-RENAMEFILEP 129473
|
||||
. 130033) (LA.OPENTEMPFILE 130035 . 131003)) (131006 144348 (\LAFITE.UPDATE.FOLDER 131016 . 132993) (
|
||||
\LAFITE.UPDATE.CONTENTS 132995 . 133712) (\LAFITE.UPDATE.CONTENTS1 133714 . 138568) (WRITETOCENTRY
|
||||
138570 . 141688) (WRITETOCMARKBYTES 141690 . 141932) (WRITEFOLDERMARKBYTES 141934 . 144346)) (144374
|
||||
163349 (LAFITE.HARDCOPY.MESSAGES 144384 . 144844) (\LAFITE.HARDCOPY 144846 . 145181) (
|
||||
\LAFITE.HARDCOPY.PROC 145183 . 148661) (\LAFITE.HARDCOPY.HEADERS 148663 . 153992) (
|
||||
\LAFITE.MARK.HARDCOPIED 153994 . 155704) (\LAFITE.TRANSMIT.HARDCOPY 155706 . 157296) (
|
||||
\LAFITE.HARDCOPY.BODIES 157298 . 158540) (\LAFITE.APPEND.MESSAGE.BODY 158542 . 160650) (
|
||||
\LAFITE.DO.PENDING.HARDCOPY 160652 . 161727) (\LAFITE.CANCEL.HARDCOPY 161729 . 162445) (
|
||||
\LAFITE.CLEAR.HARDCOPY.STATE 162447 . 163347)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,16 +1,18 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "22-Jan-87 01:34:36" {ERIS}<LISPUSERS>LISPCORE>LAFITE-INDENT.;1 25845
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
previous date%: "21-Jan-87 16:06:01" {ERIS}<LISPUSERS>KOTO>LAFITE-INDENT.;5)
|
||||
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
|
||||
TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
|
||||
|
||||
:PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
|
||||
|
||||
(RPAQQ LAFITE-INDENTCOMS
|
||||
(RPAQQ LAFITE-INDENTCOMS
|
||||
[(* * LAFITE-INDENT defines a function that will indent the current selection.)
|
||||
(FNS TEDIT-INDENT-ADD-INDENTATION TEDIT-INDENT-BREAK-LINE TEDIT-INDENT-BREAK-LONG-LINES
|
||||
TEDIT-INDENT-FIND-BREAKPOINT TEDIT-INDENT-REPLACE-SELECTION TEDIT-INDENT-SELECTION
|
||||
@@ -31,12 +33,14 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(SUBITEMS (Indent 'TEDIT-INDENT-SELECTION
|
||||
"Indent the current selection"
|
||||
)
|
||||
("Indent & keep lines" '
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
("Indent & keep lines"
|
||||
'
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
|
||||
"Indent the current selection, keeping existing line breaks"
|
||||
)
|
||||
("Set indent" '
|
||||
TEDIT-INDENT-SET-INDENT
|
||||
("Set indent"
|
||||
'TEDIT-INDENT-SET-INDENT
|
||||
"Set the indent string to a new value"
|
||||
)
|
||||
(Unindent 'TEDIT-REMOVE-INDENT
|
||||
@@ -45,12 +49,14 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
("Open line" 'TEDIT-OPEN-LINE
|
||||
"Open a blank line at the current position"
|
||||
)
|
||||
("Insert <RETURN>s" '
|
||||
TEDIT-MAKE-LINES-EXPLICIT
|
||||
("Insert <RETURN>s"
|
||||
'TEDIT-MAKE-LINES-EXPLICIT
|
||||
"Insert real <RETURN>s at the end of each line in the current selection"
|
||||
)
|
||||
("Break long lines" '
|
||||
TEDIT-INDENT-BREAK-LONG-LINES
|
||||
("Break long lines"
|
||||
'
|
||||
TEDIT-INDENT-BREAK-LONG-LINES
|
||||
|
||||
"Break long lines by inserting explicit <RETURN>'s"
|
||||
])
|
||||
(* * LAFITE-INDENT defines a function that will indent the current selection.)
|
||||
@@ -127,14 +133,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
max-length max-length])
|
||||
|
||||
(TEDIT-INDENT-BREAK-LONG-LINES
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
|
||||
|
||||
(* * Break the current selection into explicit lines, each having no more than
|
||||
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||
the current selection are removed. -
|
||||
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||
forwarded document, but can be used in any TEdit document)
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:03")
|
||||
|
||||
(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -142,11 +144,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
||||
*eol-string*)
|
||||
@@ -181,15 +185,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
'RIGHT])
|
||||
|
||||
(TEDIT-INDENT-SELECTION
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
|
||||
|
||||
(* * Indent the current selection by prefacing each line with the value of
|
||||
*TEDIT-INDENT-STRING*, and inserting line breaks after each
|
||||
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||
the current selection are removed. -
|
||||
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||
forwarded document, but can be used in any TEdit document)
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:00")
|
||||
|
||||
(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -197,11 +196,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
||||
hanging-indent)
|
||||
@@ -231,18 +232,19 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
||||
|
||||
(TEDIT-INDENT-SET-INDENT
|
||||
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
|
||||
|
||||
(* * Prompt the user for a new indentation string)
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
|
||||
(* smL "12-Sep-86 17:09")
|
||||
|
||||
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
|
||||
(* ;;; "Prompt the user for a new indentation string")
|
||||
|
||||
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
|
||||
(pwindow (if window
|
||||
then (GETPROMPTWINDOW (if (LISTP window)
|
||||
then (CAR window)
|
||||
else window))
|
||||
else PROMPTWINDOW)))
|
||||
(CLEARW pwindow)
|
||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||
pwindow NIL NIL (LIST (CHARCODE EOL])
|
||||
|
||||
(TEDIT-INDENT-STRIP-INDENTATION
|
||||
@@ -267,36 +269,34 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
else string])
|
||||
|
||||
(TEDIT-MAKE-LINES-EXPLICIT
|
||||
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* * Take the current selection and replace all TEdit end-of-lines with
|
||||
explicit line breaks. -
|
||||
This is intended to be used in Lafite, where it is sometimes nice to know that
|
||||
anyone receiving the msg will see the same line breaks that you see.
|
||||
see, but can be used in any TEdit document)
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
|
||||
(* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks. --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see. see, but can be used in any TEdit document")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
|
||||
[last-line _ (CAR (LAST (fetch LN of selection]
|
||||
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
|
||||
(EQ this-line last-line)) collect (fetch CHARLIM
|
||||
of this-line))
|
||||
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
|
||||
[last-line _ (CAR (LAST (GETSEL selection LN]
|
||||
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
|
||||
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
|
||||
) do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
|
||||
|
||||
(TEDIT-OPEN-LINE
|
||||
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
|
||||
|
||||
(* * Open a new line at the current position.)
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
|
||||
(* smL "17-Sep-86 11:13")
|
||||
|
||||
(* ;;; "Open a new line at the current position.")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string*
|
||||
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1
|
||||
of (CAR (fetch L1 of selection]
|
||||
" ")))
|
||||
(if (ZEROP (fetch DCH of selection))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1))
|
||||
" ")))
|
||||
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
|
||||
then (TEDIT.SETSEL text-stream selection])
|
||||
|
||||
(TEDIT-REMOVE-INDENT
|
||||
@@ -393,21 +393,27 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(RPAQ *eol-string* (CHARACTER (CHARCODE EOL)))
|
||||
|
||||
|
||||
[CONSTANTS (*eol-string* (CHARACTER (CHARCODE EOL]
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*)
|
||||
)
|
||||
|
||||
(OR (GETD 'TEDIT)
|
||||
(FILESLOAD TEDIT))
|
||||
|
||||
(TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU 'Indent)
|
||||
|
||||
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Indent 'TEDIT-INDENT-SELECTION
|
||||
"Indent the current selection"
|
||||
(SUBITEMS (Indent 'TEDIT-INDENT-SELECTION
|
||||
"Indent the current selection")
|
||||
("Indent & keep lines" '
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
("Indent & keep lines"
|
||||
'
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
|
||||
|
||||
"Indent the current selection, keeping existing line breaks"
|
||||
)
|
||||
("Set indent" 'TEDIT-INDENT-SET-INDENT
|
||||
@@ -418,21 +424,21 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
("Open line" 'TEDIT-OPEN-LINE
|
||||
"Open a blank line at the current position"
|
||||
)
|
||||
("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT
|
||||
("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT
|
||||
|
||||
"Insert real <RETURN>s at the end of each line in the current selection"
|
||||
)
|
||||
("Break long lines" '
|
||||
TEDIT-INDENT-BREAK-LONG-LINES
|
||||
("Break long lines"
|
||||
'TEDIT-INDENT-BREAK-LONG-LINES
|
||||
"Break long lines by inserting explicit <RETURN>'s"
|
||||
]
|
||||
(PUTPROPS LAFITE-INDENT COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3949 23354 (TEDIT-INDENT-ADD-INDENTATION 3959 . 6527) (TEDIT-INDENT-BREAK-LINE 6529 .
|
||||
8462) (TEDIT-INDENT-BREAK-LONG-LINES 8464 . 10231) (TEDIT-INDENT-FIND-BREAKPOINT 10233 . 11056) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11058 . 11615) (TEDIT-INDENT-SELECTION 11617 . 13518) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13520 . 13799) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 13801 .
|
||||
14530) (TEDIT-INDENT-SET-INDENT 14532 . 15306) (TEDIT-INDENT-STRIP-INDENTATION 15308 . 16528) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 16530 . 17735) (TEDIT-OPEN-LINE 17737 . 18493) (TEDIT-REMOVE-INDENT 18495 .
|
||||
19265) (\TEDIT-INDENT-COUNT-SPACES 19267 . 19868) (\TEDIT-INDENT-FIND-PARAGRAPH-END 19870 . 20841) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 20843 . 21641) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21643 . 23352)))))
|
||||
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
|
||||
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
|
||||
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
|
||||
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2 100561
|
||||
(FILECREATED "15-Feb-2025 13:05:38" {WMEDLEY}<library>lafite>LAFITE-SEND.;4 100003
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS LAFITE-SENDCOMS)
|
||||
:CHANGES-TO (FNS \SENDMSG.CHANGE.MODE)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-SENDCOMS)
|
||||
@@ -222,14 +222,14 @@
|
||||
(ERROR!])
|
||||
|
||||
(\SENDMSG.CHANGE.MODE
|
||||
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 5-Jan-90 18:06 by bvm")
|
||||
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 15-Feb-2025 13:05 by rmk")
|
||||
(* ; "Edited 5-Jan-90 18:06 by bvm")
|
||||
(LET*
|
||||
[(OLDMODE (TEXTPROP TEXTSTREAM 'LAFITEMODE))
|
||||
(OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS
|
||||
LAFITEMODE)
|
||||
of MODE)
|
||||
OLDMODE)
|
||||
(NLISTP (CDR MODE)))
|
||||
(OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS LAFITEMODE)
|
||||
of MODE)
|
||||
OLDMODE)
|
||||
(NLISTP (CDR MODE)))
|
||||
collect (fetch (LAFITEOPS LAFITEMODE) of MODE)))
|
||||
(NEWMODE (if (NULL OTHERMODES)
|
||||
then (\SENDMESSAGE.PROMPT WINDOW "There are no other modes")
|
||||
@@ -244,58 +244,51 @@
|
||||
N N2)
|
||||
(if (NULL NEWMODEDATA)
|
||||
then (\SENDMESSAGE.PROMPT WINDOW (CL:FORMAT NIL
|
||||
"Can't authenticate user in ~A mode"
|
||||
NEWMODE))
|
||||
else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA)
|
||||
)
|
||||
(END (TEDIT.FIND TEXTSTREAM "
|
||||
"Can't authenticate user in ~A mode"
|
||||
NEWMODE))
|
||||
else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA))
|
||||
(END (TEDIT.FIND TEXTSTREAM "
|
||||
|
||||
" 1))
|
||||
START N LEN NEW OLDSEL)
|
||||
(if END
|
||||
then (add END 1)) (* ;
|
||||
"Don't search past end of header. END now points at second cr.")
|
||||
[for FIELD in '("cc" "Reply-to")
|
||||
when [AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END
|
||||
))
|
||||
(PROGN (SETQ LEN (CADR N))
|
||||
(SETQ N (CAR N))
|
||||
(SETQ START
|
||||
(STRPOS OLDNAME
|
||||
(SETQ OLDSEL
|
||||
(TEDIT.SEL.AS.STRING TEXTSTREAM
|
||||
(create SELECTION
|
||||
CH# _ N
|
||||
DCH _ LEN)))
|
||||
NIL NIL NIL NIL UPPERCASEARRAY]
|
||||
do (* ; "Change field containing old user name to new. This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")
|
||||
(TEDIT.DELETE TEXTSTREAM N LEN)
|
||||
(TEDIT.INSERT TEXTSTREAM
|
||||
(SETQ NEW (CONCAT (OR (SUBSTRING OLDSEL 1 (SUB1 START)
|
||||
)
|
||||
"")
|
||||
(fetch (LAFITEMODEDATA
|
||||
FULLUSERNAME)
|
||||
of NEWMODEDATA)
|
||||
(OR (SUBSTRING OLDSEL
|
||||
(+ START (NCHARS OLDNAME))
|
||||
)
|
||||
"")))
|
||||
N)
|
||||
(AND END (add END (- (NCHARS NEW)
|
||||
LEN]
|
||||
(if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END))
|
||||
then (* ;
|
||||
"Leave the To field selected for address modification")
|
||||
(TEDIT.SETSEL TEXTSTREAM (CAR N)
|
||||
(CADR N)
|
||||
'RIGHT T))
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
|
||||
(if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
|
||||
TITLE))
|
||||
then (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
|
||||
NEWMODE ")")))
|
||||
(\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE]
|
||||
START N LEN NEW OLDSEL)
|
||||
(if END
|
||||
then (add END 1)) (* ;
|
||||
"Don't search past end of header. END now points at second cr.")
|
||||
[for FIELD in '("cc" "Reply-to")
|
||||
when [AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END))
|
||||
(PROGN (SETQ LEN (CADR N))
|
||||
(SETQ N (CAR N))
|
||||
(SETQ START (STRPOS OLDNAME (SETQ OLDSEL
|
||||
(TEDIT.SEL.AS.STRING
|
||||
TEXTSTREAM N LEN))
|
||||
NIL NIL NIL NIL UPPERCASEARRAY]
|
||||
do (* ; "Change field containing old user name to new. This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")
|
||||
(TEDIT.DELETE TEXTSTREAM N LEN)
|
||||
(TEDIT.INSERT TEXTSTREAM (SETQ NEW
|
||||
(CONCAT (OR (SUBSTRING OLDSEL 1
|
||||
(SUB1 START))
|
||||
"")
|
||||
(fetch (LAFITEMODEDATA FULLUSERNAME
|
||||
) of NEWMODEDATA)
|
||||
(OR (SUBSTRING OLDSEL
|
||||
(+ START (NCHARS OLDNAME
|
||||
)))
|
||||
"")))
|
||||
N)
|
||||
(AND END (add END (- (NCHARS NEW)
|
||||
LEN]
|
||||
(if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END))
|
||||
then (* ;
|
||||
"Leave the To field selected for address modification")
|
||||
(TEDIT.SETSEL TEXTSTREAM (CAR N)
|
||||
(CADR N)
|
||||
'RIGHT T))
|
||||
(TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
|
||||
(if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
|
||||
TITLE))
|
||||
then (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
|
||||
NEWMODE ")")))
|
||||
(\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE]
|
||||
|
||||
(* ;; "Exit with error so that the window is restored to previous state")
|
||||
|
||||
@@ -1761,29 +1754,29 @@ cc: ~A
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) (
|
||||
\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) (
|
||||
\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 .
|
||||
12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE
|
||||
18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) (
|
||||
\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 .
|
||||
28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) (
|
||||
\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU
|
||||
41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) (
|
||||
\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 .
|
||||
47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508
|
||||
. 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799
|
||||
(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) (
|
||||
\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) (
|
||||
\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797))
|
||||
(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) (
|
||||
MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 .
|
||||
72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE
|
||||
78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) (
|
||||
MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 .
|
||||
87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) (
|
||||
MAKEFORWARDFORM 89694 . 93477)))))
|
||||
(FILEMAP (NIL (5218 27633 (DOLAFITESENDINGCOMMAND 5228 . 5718) (\SENDMESSAGE.INITIATE 5720 . 7659) (
|
||||
\SENDMSG.DELIVER 7661 . 8269) (\SENDMSG.EXIT.TEDIT 8271 . 8642) (\SENDMSG.SAVE.FORM 8644 . 10631) (
|
||||
\LAFITE.HEADER.EOF 10633 . 10926) (\LAFITE.INSERT.REPLYTO 10928 . 11536) (\SENDMSG.REPLYTO 11538 .
|
||||
12097) (\SENDMSG.CHANGE.MODE 12099 . 17113) (\SENDMSG.FIND.FIELD 17115 . 17625) (\SENDMESSAGE.PARSE
|
||||
17627 . 18423) (\LAFITE.PREPARE.SEND 18425 . 21258) (\LAFITE.PREPARE.ERROR 21260 . 22442) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 22444 . 25085) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25087 . 26012) (
|
||||
\SENDMESSAGE.MENUPROMPT 26014 . 26877) (\SENDMESSAGE.PROMPT 26879 . 27415) (\SENDMESSAGEFAIL 27417 .
|
||||
27631)) (27634 52296 (\SENDMESSAGE 27644 . 28996) (\SENDMESSAGE.RESTARTABLE 28998 . 34199) (
|
||||
\SENDMESSAGE.CLEANUP 34201 . 34417) (\SENDMESSAGE.MAKEWINDOW 34419 . 40592) (MAKELAFITEDELIVERMENU
|
||||
40594 . 40901) (\LAFITE.CLOSEMSG? 40903 . 41853) (\LAFITE.AFTER.DELIVER 41855 . 45174) (
|
||||
\LAFITE.UNSENT.ICON 45176 . 45486) (\LAFITE.FETCH.SUBJECT 45488 . 46288) (LAFITE.SENDMESSAGE 46290 .
|
||||
47183) (\SENDMESSAGE0 47185 . 50049) (LA.ASSURE.PROMPT.WINDOW 50051 . 50948) (\LAFITE.SEND.FAIL 50950
|
||||
. 51421) (\LAFITE.INVALID.RECIPIENTS 51423 . 51881) (\SENDMESSAGE.ABORT 51883 . 52294)) (52328 62241
|
||||
(\OUTBOX.CREATE 52338 . 53801) (\OUTBOX.RESET 53803 . 54296) (\OUTBOX.CLOSEFN 54298 . 54438) (
|
||||
\OUTBOX.REPAINTFN 54440 . 55103) (\OUTBOX.RESHAPEFN 55105 . 56388) (\OUTBOX.SHADEITEM 56390 . 57063) (
|
||||
\OUTBOX.BUTTONFN 57065 . 59913) (\OUTBOX.DISPLAYLINE 59915 . 60409) (\OUTBOX.ADD.ITEM 60411 . 62239))
|
||||
(62537 78945 (\LAFITE.MESSAGEFORM 62547 . 66890) (MAKELAFITESUPPORTFORM 66892 . 67081) (
|
||||
MAKELISPSUPPORTFORM 67083 . 67249) (MAKEXXXSUPPORTFORM 67251 . 71300) (MAKENEWMESSAGEFORM 71302 .
|
||||
72258) (MAKELAFITEPRIVATEFORMSITEMS 72260 . 72688) (\LAFITE.UNCACHE.MESSAGEFORM 72690 . 73143) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73145 . 73746) (\LAFITE.SELECT.FORM 73748 . 74103) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74105 . 75249) (\LAFITE.READ.FORM 75251 . 77988) (\LAFITE.FIND.TEMPLATE
|
||||
77990 . 78943)) (78969 86700 (\LAFITE.ANSWER 78979 . 79384) (\LAFITE.ANSWER.PROC 79386 . 81280) (
|
||||
MAKEANSWERFORM 81282 . 83812) (LA.PRINT.COMMA.LIST 83814 . 84300) (LAFITE.FILL.IN.ANSWER.FORM 84302 .
|
||||
86698)) (86725 92921 (\LAFITE.FORWARD 86735 . 87143) (\LAFITE.FORWARD.PROC 87145 . 89134) (
|
||||
MAKEFORWARDFORM 89136 . 92919)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2 6592
|
||||
(FILECREATED "15-Feb-2025 14:03:21" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;4 6618
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS LAFITE-TEDITCOMS)
|
||||
:CHANGES-TO (FNS TEDIT.ASSURE.NO.BACKING.FILE)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
|
||||
:PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-TEDITCOMS)
|
||||
@@ -74,7 +74,8 @@
|
||||
(TEXTPROP TEXTSTREAM '\WINDOW NIL])
|
||||
|
||||
(TEDIT.ASSURE.NO.BACKING.FILE
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 13-Jan-2024 18:08 by rmk")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 14:03 by rmk")
|
||||
(* ; "Edited 13-Jan-2024 18:08 by rmk")
|
||||
(* ; "Edited 18-Jun-2023 09:31 by rmk")
|
||||
(* ; "Edited 29-Oct-2022 22:34 by rmk")
|
||||
(* ; "Edited 20-May-92 11:25 by rmk:")
|
||||
@@ -82,18 +83,17 @@
|
||||
(* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session. Essentially eliminates the file-system backing store.")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(OFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
(OFILE (GETTEXTPROP TEXTSTREAM 'FILESTREAM))
|
||||
NEWFILE)
|
||||
(CL:WHEN [AND (TYPE? STREAM OFILE)
|
||||
(NEQ 'NODIRCORE (FETCH (FDEV DEVICENAME) OF (FETCH (STREAM DEVICE)
|
||||
OF (TRUEFILENAME OFILE]
|
||||
(CL:WHEN [AND OFILE (NEQ 'NODIRCORE (FILENAMEFIELD (TRUEFILENAME OFILE)
|
||||
'HOST]
|
||||
(SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
|
||||
|
||||
(* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE. But the file PCONTENTS do not yet point to the new stream. ")
|
||||
|
||||
(CLOSEF? OFILE)
|
||||
(\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T))
|
||||
(FSETTOBJ TEXTOBJ TXTFILE NIL)
|
||||
(PUTTEXTPROP TEXTOBJ 'TXTFILE NIL)
|
||||
(PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE)
|
||||
TEXTSTREAM)])
|
||||
|
||||
@@ -118,6 +118,6 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) (
|
||||
TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359)))))
|
||||
(FILEMAP (NIL (998 6387 (LA.ADJUST.FORMATTING 1008 . 4054) (LA.DETACH.TEDIT 4056 . 4422) (
|
||||
TEDIT.ASSURE.NO.BACKING.FILE 4424 . 6105) (LA.WINDOW.FROM.TEXTSTREAM 6107 . 6385)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@@ -1,98 +1,209 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9 10946
|
||||
(FILECREATED "28-Mar-2025 10:13:36" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;21 15982
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
|
||||
:PREVIOUS-DATE "23-Mar-2025 17:09:00" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;20)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(RPAQQ TEDIT-ABBREVCOMS [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE])
|
||||
(RPAQQ TEDIT-ABBREVCOMS
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE])
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 31-Oct-2024 17:50 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 17-May-2023 13:31 by rmk")
|
||||
(* ; "Edited 8-Sep-2022 23:53 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 30-May-91 19:27 by jds")
|
||||
(* ; "Expand an abbvreviation")
|
||||
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
|
||||
SEL CH# CH OLDLOOKS EXPANSION)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
[COND
|
||||
((ZEROP (GETSEL SEL DCH)) (* ;
|
||||
"Point Selection, so use the character to the left")
|
||||
(CL:WHEN (ZEROP CH#) (* ;
|
||||
"If we're off the front of the document, don't bother trying.")
|
||||
(RETURN))
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)
|
||||
CH#)
|
||||
[SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM]
|
||||
(TEDIT.SETSEL TSTREAM CH# 1 'RIGHT))
|
||||
(T (* ;
|
||||
"We have a selection that isn't just a caret. Use it.")
|
||||
(SETQ CH (TEDIT.SEL.AS.STRING TSTREAM]
|
||||
(SETQ EXPANSION (\TEDIT.TRY.ABBREV CH TSTREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")
|
||||
(CL:WHEN EXPANSION (* ;
|
||||
"It exists, so insert it where the abbrev used to be")
|
||||
(SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
|
||||
(TEDIT.DELETE TEXTOBJ SEL) (* ;
|
||||
"First, delete the thing being expanded.")
|
||||
(TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))])
|
||||
(LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL))
|
||||
CAND EXPANSION)
|
||||
|
||||
(* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.")
|
||||
|
||||
(* ;; "Try literal match first, then fiddle the case.")
|
||||
|
||||
(* ;; "If we don't find it in abbrevs, try for a character code.")
|
||||
|
||||
[SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(CAR C)
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(U-CASE (CAR C))
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(L-CASE (CAR C))
|
||||
TSTREAM]
|
||||
(if EXPANSION
|
||||
then (\TEDIT.UPDATE.SEL SEL (CADR CAND)
|
||||
(CADDR CAND)
|
||||
'RIGHT
|
||||
'NORMAL) (* ; "Set the target")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||
(PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
|
||||
TEXTOBJ)))
|
||||
TEXTOBJ SEL)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
|
||||
(\TEDIT.ABBREV.PARSE
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 28-Mar-2025 10:11 by rmk")
|
||||
(* ; "Edited 23-Mar-2025 17:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 22:21 by rmk")
|
||||
|
||||
(* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).")
|
||||
|
||||
(* ;;
|
||||
"It first backs up over any spaces to find the anchor position. The candidates then include")
|
||||
|
||||
(* ;; " The immediately preceding singleton character, if a point selection")
|
||||
|
||||
(* ;; " The remaining (after backing up) characters of the selection.")
|
||||
|
||||
(* ;; " The word that contains the caret (backwards and forwards)")
|
||||
|
||||
(* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).")
|
||||
|
||||
(* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)")
|
||||
|
||||
(* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.")
|
||||
|
||||
(* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.")
|
||||
|
||||
(PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
FIRST# LAST# LEN CANDIDATES KEY NSPACES)
|
||||
|
||||
(* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.")
|
||||
|
||||
(* ;; " The character at CH#, if it is a point selection")
|
||||
|
||||
(* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.")
|
||||
|
||||
(* ;; "Back up over spaces")
|
||||
|
||||
(SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM I)) sum 1))
|
||||
(add PT# (IMINUS NSPACES))
|
||||
(CL:WHEN (ZEROP PT#) (* ; "Beginning of document")
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..")
|
||||
|
||||
(push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#))
|
||||
PT# 1))
|
||||
(SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH)
|
||||
NSPACES))) (* ; "Last singleton predecessor")
|
||||
(CL:WHEN (IGEQ LEN 2) (* ; "At least one more character")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#)
|
||||
LEN)
|
||||
(FGETSEL SEL CH#)
|
||||
LEN)))
|
||||
(SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN)))
|
||||
(SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN))) (* ; "Extend if a ,")
|
||||
[for C KEY END in CANDIDATES
|
||||
do
|
||||
(* ;; "Comma for XCCS character names, - and / - for internal punctuation (3/4 EM-DASH). Adjacent character must be text")
|
||||
|
||||
(if [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C)
|
||||
2]
|
||||
then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C)
|
||||
2)))
|
||||
(* ; "Comma before, maybe a charname")
|
||||
(SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C)
|
||||
END))
|
||||
(CAR C)))
|
||||
(push CANDIDATES (LIST KEY END (NCHARS KEY)))
|
||||
elseif [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C)
|
||||
(CADDR C]
|
||||
then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(* ; "Comma after")
|
||||
[SETQ KEY (CONCAT (CAR C)
|
||||
(TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C))
|
||||
(ADD1 (IDIFFERENCE END (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(push CANDIDATES (LIST KEY (CADR C)
|
||||
(NCHARS KEY] (* ;
|
||||
"If preceded by \, include it optionally in the key, always include it in the replacement")
|
||||
(for C in CANDIDATES when [EQ (CHARCODE \)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C]
|
||||
do (* ; "Match and replace \KEY")
|
||||
[push CANDIDATES (LIST (CONCAT "\" (CAR C))
|
||||
(SUB1 (CADR C))
|
||||
(ADD1 (CADDR C]
|
||||
(change (CADR C)
|
||||
(SUB1 DATUM)) (* ; "Match KEY but also replace the \")
|
||||
(change (CADDR C)
|
||||
(ADD1 DATUM)))
|
||||
[SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2)
|
||||
(IGEQ (CADDR C1)
|
||||
(CADDR C2] (* ; "Look for longest first")
|
||||
(RETURN CANDIDATES])
|
||||
|
||||
(\TEDIT.EXPAND.DATE
|
||||
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
|
||||
@@ -109,100 +220,92 @@
|
||||
" " DAY ", " YEAR])
|
||||
|
||||
(\TEDIT.TRY.ABBREV
|
||||
[LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
[LAMBDA (KEY TSTREAM) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;;
|
||||
"Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.")
|
||||
(* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ")
|
||||
|
||||
(* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.")
|
||||
(LET ((ABBREV (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(if (NULL ABBREV)
|
||||
then (CL:WHEN (CHARCODE.DECODE KEY T)
|
||||
(CHARACTER (CHARCODE.DECODE KEY T)))
|
||||
elseif (STRINGP (CDR ABBREV))
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(PROG (SEL CH# (CH NIL)
|
||||
EXPANSION)
|
||||
(SETQ EXPANSION (OR (SASSOC ABBREV TEDIT.ABBREVS)
|
||||
(SASSOC (U-CASE ABBREV)
|
||||
TEDIT.ABBREVS)))
|
||||
(LET ((CH (CHARCODE.DECODE (CDR ABBREV)
|
||||
T)))
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
(CDR ABBREV)))
|
||||
elseif (SMALLP (CDR ABBREV))
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(* Find the abbreviation's expansion --first try it as-is, then try the
|
||||
upper-case version to be safe.)
|
||||
|
||||
(RETURN (COND
|
||||
(EXPANSION (* There's an expansion.
|
||||
Turn it into an insertable string.)
|
||||
(COND
|
||||
[(STRINGP (CDR EXPANSION))
|
||||
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(COND
|
||||
((SETQ CH (CHARCODE.DECODE (CDR EXPANSION)
|
||||
T))
|
||||
(CHARACTER CH))
|
||||
(T (CDR EXPANSION]
|
||||
((SMALLP (CDR EXPANSION))
|
||||
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(CHARACTER (CDR EXPANSION)))
|
||||
((AND (LITATOM (CDR EXPANSION))
|
||||
(GETD (CDR EXPANSION))) (* It's a function to be called.)
|
||||
(APPLY* (CDR EXPANSION)
|
||||
STREAM CH))
|
||||
(T (* Anything else is a form to EVAL.)
|
||||
(EVAL (CDR EXPANSION])
|
||||
(CHARACTER (CDR ABBREV))
|
||||
elseif (AND (LITATOM (CDR ABBREV))
|
||||
(GETD (CDR ABBREV)))
|
||||
then (* ; "It's a function to be called.")
|
||||
(APPLY* (CDR ABBREV)
|
||||
TSTREAM
|
||||
(CAR ABBREV))
|
||||
else (* ; "Anything else is a form to EVAL.")
|
||||
(EVAL (CDR ABBREV])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(RPAQ? TEDIT.ABBREVS
|
||||
'(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
("m" . "357,45")
|
||||
("T" . "357,57")
|
||||
("d" . "357,60")
|
||||
("D" . "357,61")
|
||||
("s" . "0,247")
|
||||
("'" . "0,271")
|
||||
("`" . "0,251")
|
||||
("%"" . "0,252")
|
||||
("~" . "0,272")
|
||||
("1/4" . "0,274")
|
||||
("1/2" . "0,275")
|
||||
("3/4" . "0,276")
|
||||
("1/3" . "357,375")
|
||||
("2/3" . "357,376")
|
||||
("c" . "0,323")
|
||||
("c/o" . "357,100")
|
||||
("%%" . "357,100")
|
||||
("->" . "0,256")
|
||||
("ra" . "0,256")
|
||||
("|" . "0,257")
|
||||
("da" . "0,257")
|
||||
("^" . "0,255")
|
||||
("ua" . "0,255")
|
||||
("<-" . "0,254")
|
||||
("la" . "0,254")
|
||||
("_" . "0,254")
|
||||
("L" . "0,243")
|
||||
("o" . "0,260")
|
||||
("Y" . "0,245")
|
||||
("+" . "0,261")
|
||||
("x" . "0,264")
|
||||
("/" . "0,270")
|
||||
("=" . "357,121")
|
||||
("p" . "0,266")
|
||||
("r" . "0,322")
|
||||
("t" . "0,324")
|
||||
("tm" . "0,324")
|
||||
("box" . "42,42")
|
||||
("cbox" . "42,61")
|
||||
("-" . "357,43")
|
||||
("=" . "357,42")
|
||||
(" " . "357,41")
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
|
||||
\TEDIT.TRY.ABBREV 6831 . 8977)))))
|
||||
(FILEMAP (NIL (2933 14638 (\TEDIT.ABBREV.EXPAND 2943 . 5054) (\TEDIT.ABBREV.PARSE 5056 . 12340) (
|
||||
\TEDIT.EXPAND.DATE 12342 . 12975) (\TEDIT.TRY.ABBREV 12977 . 14636)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Jan-2025 13:03:46" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;213 124294
|
||||
(FILECREATED "24-Mar-2025 09:26:13" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;223 124611
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MB.BUTTONEVENTINFN MB.CREATE MB.GET MB.FIELD.CREATE MB.FIELD.PREFIXCREATE)
|
||||
:CHANGES-TO (FNS MB.FIELD.INSURETYPE MB.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE " 9-Jan-2025 16:52:13" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;208)
|
||||
:PREVIOUS-DATE "14-Mar-2025 15:29:51" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;219)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||
@@ -19,11 +19,11 @@
|
||||
(COMS (* ;
|
||||
"Generic functions for the various types of buttons.")
|
||||
(RECORDS MBARG)
|
||||
(FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDITMENU.STREAM TEDIT.BACKTOMAIN))
|
||||
(FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDIT.BACKTOMAIN))
|
||||
[COMS (* ; "Simple Menu Button support")
|
||||
(FNS MB.BUTTONEVENTINFN MB.DISPLAYFN MB.SETIMAGE MB.SIZEFN MB.WHENOPERATEDONFN
|
||||
MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MB.CREATE MB.CHANGENAME MB.INIT
|
||||
MB.TRACK.UNTIL MB.DON'T)
|
||||
MB.TRACK.UNTIL MB.DON'T MB.SPEC.REMAINDER)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.INIT]
|
||||
[COMS (* ; "3STATE")
|
||||
|
||||
@@ -288,17 +288,6 @@
|
||||
ARGENDPC _ ENDPC
|
||||
ARGIDPC _ IDPC])
|
||||
|
||||
(TEDITMENU.STREAM
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 29-Sep-2024 15:29 by rmk")
|
||||
(* ; "Edited 28-Aug-2024 15:48 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 09:53 by rmk")
|
||||
(* jds "13-Aug-84 14:10")
|
||||
|
||||
(* ;; "returns the textstream of the teditmenu attached to this stream if any")
|
||||
|
||||
(for W in (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)) when (TEDITMENUP W "TEdit Menu")
|
||||
do (RETURN (TEXTSTREAM W])
|
||||
|
||||
(TEDIT.BACKTOMAIN
|
||||
[LAMBDA (MENUSTREAM) (* ; "Edited 20-Oct-2024 10:02 by rmk")
|
||||
(* ; "Edited 25-Aug-2024 09:17 by rmk")
|
||||
@@ -319,6 +308,7 @@
|
||||
|
||||
(MB.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON)
|
||||
(* ; "Edited 22-Mar-2025 14:00 by rmk")
|
||||
(* ; "Edited 12-Jan-2025 13:03 by rmk")
|
||||
(* ; "Edited 28-Dec-2024 20:21 by rmk")
|
||||
(* ; "Edited 22-Aug-2024 16:26 by rmk")
|
||||
@@ -329,7 +319,6 @@
|
||||
|
||||
(* ;; "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)
|
||||
@@ -633,6 +622,17 @@
|
||||
(* ; "Edited 7-Dec-2024 08:58 by rmk")
|
||||
(CL:UNLESS (IMAGEOBJPROP OBJ 'DELETABLE)
|
||||
'DON'T])
|
||||
|
||||
(MB.SPEC.REMAINDER
|
||||
[LAMBDA (SPEC IGNORE OBJ) (* ; "Edited 16-Feb-2025 13:07 by rmk")
|
||||
|
||||
(* ;; "Reduces SPEC to properties that not to be IGNORED because they have been dealt with separately. If OBJ, those properties are installed as IMAGEOBJPROP's.")
|
||||
|
||||
(for S in SPEC unless (MEMB (CAR S)
|
||||
IGNORE) collect (CL:WHEN OBJ
|
||||
(IMAGEOBJPROP OBJ (CAR S)
|
||||
(CADR S)))
|
||||
S])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -816,7 +816,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.NWAY.CREATE
|
||||
[LAMBDA (SPEC) (* ; "Edited 9-Jan-2025 11:38 by rmk")
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Feb-2025 12:08 by rmk")
|
||||
(* ; "Edited 9-Jan-2025 11:38 by rmk")
|
||||
(* ; "Edited 4-Jan-2025 21:39 by rmk")
|
||||
(* ; "Edited 20-Dec-2024 22:17 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 00:26 by rmk")
|
||||
@@ -847,7 +848,6 @@
|
||||
elseif (STRINGP IDENTIFIER)
|
||||
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
|
||||
else (\ILLEGAL.ARG IDENTIFIER))
|
||||
(SETQ IDENTIFIER IDENTIFIER)
|
||||
(SETQ SPACING (STRINGWIDTH " " FONT))
|
||||
[SETQ HEIGHT (IPLUS 2 (FONTPROP FONT 'HEIGHT]
|
||||
(CL:UNLESS (LISTP BUTTONS)
|
||||
@@ -1465,7 +1465,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MB.FIELD.CREATE
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 11-Jan-2025 09:59 by rmk")
|
||||
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Feb-2025 15:01 by rmk")
|
||||
(* ; "Edited 11-Jan-2025 09:59 by rmk")
|
||||
(* ; "Edited 9-Jan-2025 16:52 by rmk")
|
||||
(* ; "Edited 5-Jan-2025 12:09 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 13:33 by rmk")
|
||||
@@ -1508,9 +1509,6 @@
|
||||
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
|
||||
else (\ILLEGAL.ARG IDENTIFIER))
|
||||
(push SPEC (LIST 'IDENTIFIER IDENTIFIER))
|
||||
(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")
|
||||
|
||||
@@ -1525,15 +1523,17 @@
|
||||
|
||||
(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)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -1885,7 +1885,8 @@
|
||||
XKERN _ 0])
|
||||
|
||||
(MB.FIELD.INSURETYPE
|
||||
[LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 4-Dec-2024 20:09 by rmk")
|
||||
[LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 24-Mar-2025 09:26 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 20:09 by rmk")
|
||||
(* ; "Edited 8-Nov-2024 08:37 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 21:52 by rmk")
|
||||
(* ; "Edited 31-Aug-2024 12:46 by rmk")
|
||||
@@ -1906,6 +1907,8 @@
|
||||
((TEXT STRING) (* ;
|
||||
"String should be a string, not NIL atom")
|
||||
(SETQ VAL (OR STR '**EMPTY**)))
|
||||
(TRIMMEDSTRING (CL:UNLESS (STREQUAL "" TRIMMED)
|
||||
(SETQ VAL TRIMMED)))
|
||||
((NUMBER PICAS POSITIVENUMBER SIGNEDNUMBER CARDINAL)
|
||||
(SETQ TRIMMED (MKATOM TRIMMED))
|
||||
(if (OR (EQ 0 (NCHARS TRIMMED))
|
||||
@@ -1958,25 +1961,25 @@
|
||||
(MB.FIELD.INIT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3287 19809 (MB.ADD 3297 . 9726) (MB.DELETE 9728 . 10102) (MB.GET 10104 . 16874) (
|
||||
MB.GET.MBARG 16876 . 18545) (TEDITMENU.STREAM 18547 . 19214) (TEDIT.BACKTOMAIN 19216 . 19807)) (19853
|
||||
39094 (MB.BUTTONEVENTINFN 19863 . 21357) (MB.DISPLAYFN 21359 . 23418) (MB.SETIMAGE 23420 . 24588) (
|
||||
MB.SIZEFN 24590 . 26138) (MB.WHENOPERATEDONFN 26140 . 28089) (MB.COPYFN 28091 . 28549) (MB.GETFN 28551
|
||||
. 29512) (MB.PUTFN 29514 . 30614) (MB.SHOWSELFN 30616 . 32125) (MB.CREATE 32127 . 36150) (
|
||||
MB.CHANGENAME 36152 . 36634) (MB.INIT 36636 . 38097) (MB.TRACK.UNTIL 38099 . 38794) (MB.DON'T 38796 .
|
||||
39092)) (39256 49246 (MB.3STATE.CREATE 39266 . 40130) (MB.3STATE.DISPLAYFN 40132 . 41118) (
|
||||
MB.3STATE.SHOWSELFN 41120 . 43431) (MB.3STATE.INIT 43433 . 44844) (MB.3STATE.SETSTATEFN 44846 . 45504)
|
||||
(MB.3STATE.BUTTONEVENTINFN 45506 . 49244)) (49401 79998 (MB.NWAY.CREATE 49411 . 55382) (
|
||||
MB.NWAY.DISPLAYFN 55384 . 56247) (MB.NWAY.WHENOPERATEDONFN 56249 . 58439) (MB.NWAY.SIZEFN 58441 .
|
||||
62377) (MB.NWAY.SELECT 62379 . 65949) (MB.NWAY.BUTTONEVENTINFN 65951 . 69163) (MB.NWAY.NEWMENUBUTTON
|
||||
69165 . 69877) (MB.NWAY.COPYFN 69879 . 70846) (MB.NWAY.INIT 70848 . 72339) (MB.NWAY.ARRANGEBUTTONS
|
||||
72341 . 74312) (MB.NWAY.ADDITEM 74314 . 78176) (MB.NWAY.FINDSUBOBJ 78178 . 78692) (MB.NWAY.SETSTATEFN
|
||||
78694 . 79996)) (80077 91964 (MB.TOGGLE.CREATE 80087 . 81082) (MB.TOGGLE.DISPLAYFN 81084 . 82567) (
|
||||
MB.TOGGLE.INIT 82569 . 84368) (MB.SET.TOGGLE 84370 . 85571) (MB.TOGGLE.SETSTATEFN 85573 . 86413) (
|
||||
MB.TOGGLE.BUTTONEVENTINFN 86415 . 90619) (MB.TOGGLE.WHENOPERATEDONFN 90621 . 91962)) (92045 124215 (
|
||||
MB.FIELD.CREATE 92055 . 97492) (MB.FIELD.DISPLAYFN 97494 . 98285) (MB.FIELD.IMAGEBOXFN 98287 . 99769)
|
||||
(MB.FIELD.PREFIXCREATE 99771 . 103707) (MB.FIELD.SUFFIXCREATE 103709 . 105369) (MB.FIELD.INIT 105371
|
||||
. 107138) (MB.FIELD.WHENOPERATEDONFN 107140 . 108411) (MB.FIELD.GETSTATEFN 108413 . 112347) (
|
||||
MB.FIELD.SETSTATEFN 112349 . 117044) (MB.FIELD.BUTTONEVENTINFN 117046 . 119351) (MB.FIELD.SIZEFN
|
||||
119353 . 119593) (MB.FIELD.INSURETYPE 119595 . 124213)))))
|
||||
(FILEMAP (NIL (3253 19106 (MB.ADD 3263 . 9692) (MB.DELETE 9694 . 10068) (MB.GET 10070 . 16840) (
|
||||
MB.GET.MBARG 16842 . 18511) (TEDIT.BACKTOMAIN 18513 . 19104)) (19150 39086 (MB.BUTTONEVENTINFN 19160
|
||||
. 20728) (MB.DISPLAYFN 20730 . 22789) (MB.SETIMAGE 22791 . 23959) (MB.SIZEFN 23961 . 25509) (
|
||||
MB.WHENOPERATEDONFN 25511 . 27460) (MB.COPYFN 27462 . 27920) (MB.GETFN 27922 . 28883) (MB.PUTFN 28885
|
||||
. 29985) (MB.SHOWSELFN 29987 . 31496) (MB.CREATE 31498 . 35521) (MB.CHANGENAME 35523 . 36005) (
|
||||
MB.INIT 36007 . 37468) (MB.TRACK.UNTIL 37470 . 38165) (MB.DON'T 38167 . 38463) (MB.SPEC.REMAINDER
|
||||
38465 . 39084)) (39248 49238 (MB.3STATE.CREATE 39258 . 40122) (MB.3STATE.DISPLAYFN 40124 . 41110) (
|
||||
MB.3STATE.SHOWSELFN 41112 . 43423) (MB.3STATE.INIT 43425 . 44836) (MB.3STATE.SETSTATEFN 44838 . 45496)
|
||||
(MB.3STATE.BUTTONEVENTINFN 45498 . 49236)) (49393 80061 (MB.NWAY.CREATE 49403 . 55445) (
|
||||
MB.NWAY.DISPLAYFN 55447 . 56310) (MB.NWAY.WHENOPERATEDONFN 56312 . 58502) (MB.NWAY.SIZEFN 58504 .
|
||||
62440) (MB.NWAY.SELECT 62442 . 66012) (MB.NWAY.BUTTONEVENTINFN 66014 . 69226) (MB.NWAY.NEWMENUBUTTON
|
||||
69228 . 69940) (MB.NWAY.COPYFN 69942 . 70909) (MB.NWAY.INIT 70911 . 72402) (MB.NWAY.ARRANGEBUTTONS
|
||||
72404 . 74375) (MB.NWAY.ADDITEM 74377 . 78239) (MB.NWAY.FINDSUBOBJ 78241 . 78755) (MB.NWAY.SETSTATEFN
|
||||
78757 . 80059)) (80140 92027 (MB.TOGGLE.CREATE 80150 . 81145) (MB.TOGGLE.DISPLAYFN 81147 . 82630) (
|
||||
MB.TOGGLE.INIT 82632 . 84431) (MB.SET.TOGGLE 84433 . 85634) (MB.TOGGLE.SETSTATEFN 85636 . 86476) (
|
||||
MB.TOGGLE.BUTTONEVENTINFN 86478 . 90682) (MB.TOGGLE.WHENOPERATEDONFN 90684 . 92025)) (92108 124532 (
|
||||
MB.FIELD.CREATE 92118 . 97569) (MB.FIELD.DISPLAYFN 97571 . 98362) (MB.FIELD.IMAGEBOXFN 98364 . 99846)
|
||||
(MB.FIELD.PREFIXCREATE 99848 . 103784) (MB.FIELD.SUFFIXCREATE 103786 . 105446) (MB.FIELD.INIT 105448
|
||||
. 107215) (MB.FIELD.WHENOPERATEDONFN 107217 . 108488) (MB.FIELD.GETSTATEFN 108490 . 112424) (
|
||||
MB.FIELD.SETSTATEFN 112426 . 117121) (MB.FIELD.BUTTONEVENTINFN 117123 . 119428) (MB.FIELD.SIZEFN
|
||||
119430 . 119670) (MB.FIELD.INSURETYPE 119672 . 124530)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16 12363
|
||||
(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17 12449
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
|
||||
|
||||
:PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
|
||||
:PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-CHATCOMS)
|
||||
@@ -70,7 +70,8 @@
|
||||
(replace (CHAT.STATE HELD) of STATE with NIL])
|
||||
|
||||
(TEDITCHAT.CHARFN
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 11-Mar-2025 15:40 by rmk")
|
||||
(* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
(* ; "Edited 2-May-2024 18:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2023 23:57 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 20:08 by rmk")
|
||||
@@ -79,7 +80,7 @@
|
||||
(TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM))
|
||||
(LF NIL)
|
||||
(BOUT TSTREAM CH])
|
||||
)
|
||||
@@ -213,6 +214,6 @@
|
||||
CHATDECLS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
|
||||
(FILEMAP (NIL (886 4630 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4628)) (4677 11561 (TEDIT.DISPLAYTEXT 4687 . 11559)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,165 +1,31 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133 49278
|
||||
(FILECREATED "23-Mar-2025 15:27:20" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;163 19331
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
|
||||
:CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION? \TEDIT.COMMAND.LOOP)
|
||||
(VARS TEDIT-COMMANDCOMS)
|
||||
|
||||
:PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
|
||||
:PREVIOUS-DATE "16-Mar-2025 14:20:07" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;160)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
|
||||
|
||||
(RPAQQ TEDIT-COMMANDCOMS
|
||||
[[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(CONSTANTS (MSPACE 153)
|
||||
(NSPACE 152)
|
||||
(THINSPACE 159)
|
||||
(FIGSPACE 154))
|
||||
(EXPORT (CONSTANTS (NONE.TTC 0)
|
||||
(CHARDELETE.TTC 1)
|
||||
(WORDDELETE.TTC 2)
|
||||
(DELETE.TTC 3)
|
||||
(FUNCTIONCALL.TTC 4)
|
||||
(REDO.TTC 5)
|
||||
(UNDO.TTC 6)
|
||||
(CMD.TTC 7)
|
||||
(NEXT.TTC 8)
|
||||
(EXPAND.TTC 9)
|
||||
(CHARDELETE.FORWARD.TTC 10)
|
||||
(WORDDELETE.FORWARD.TTC 11)
|
||||
(PUNCT.TTC 20)
|
||||
(TEXT.TTC 21)
|
||||
(WHITESPACE.TTC 22))
|
||||
(MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK)
|
||||
(RECORDS TEDITTERMCODE)
|
||||
|
||||
(* ;; "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character (RMK: THESE DON'T SEEM TO BE USED)")
|
||||
|
||||
(CONSTANTS (NOTBEFORE.LB 1)
|
||||
(* ;
|
||||
"Must not break before this character (e.g. Japanese right-paren)")
|
||||
(NOTAFTER.LB 2)
|
||||
(* ;
|
||||
"Must not break after this character (e.g. Japanese open-quote)")
|
||||
(BEFORE.LB 4)
|
||||
(* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)")
|
||||
(AFTER.LB 8)
|
||||
(* ;
|
||||
"OK to break after this char, if it's OK to break before the next one (true of most white space)")
|
||||
(DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)")
|
||||
(NEWCHAR-IF-SPLIT.LB 32)
|
||||
(* ; "Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found.")
|
||||
]
|
||||
(FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.LOOP
|
||||
\TEDIT.COMMAND.RESET.SETUP)
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK)))
|
||||
(FNS \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.FUNCTION?)
|
||||
(FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.RESET.SETUP)
|
||||
[INITVARS (TEDIT.INTERRUPTS '((2 BREAK)
|
||||
(5 ERROR)
|
||||
(7 HELP)
|
||||
(20 CONTROL-T]
|
||||
(VARS (|| NIL))
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)
|
||||
(COMS (* ; "Read-table Utilities")
|
||||
(FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX
|
||||
TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET
|
||||
TEDIT.ATOMBOUND.READTABLE)
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE))
|
||||
(TEDIT.WORDBOUND.READTABLE (
|
||||
\TEDIT.WORDBOUND.READTABLE
|
||||
]
|
||||
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE))
|
||||
[COMS (* ; "Wheelscroll")
|
||||
(FILES (SYSLOAD FROM LISPUSERS)
|
||||
WHEELSCROLL)
|
||||
(FNS \TEDIT.WHEELSCROLL)
|
||||
(GLOBALVARS WHEELSCROLLCHARCODES)
|
||||
(VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL]
|
||||
(COMS (* ; "Clipboard")
|
||||
(FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL
|
||||
)
|
||||
[DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY (CONSTANTS (CLIPBOARDCODES
|
||||
(CHARCODE (meta,C meta,X meta,c
|
||||
meta,X]
|
||||
(P (\TEDIT.CLIPBOARD])
|
||||
(* ; "Why?")
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SCRATCHLEN 64)
|
||||
|
||||
|
||||
(CONSTANTS (\SCRATCHLEN 64))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ MSPACE 153)
|
||||
|
||||
(RPAQQ NSPACE 152)
|
||||
|
||||
(RPAQQ THINSPACE 159)
|
||||
|
||||
(RPAQQ FIGSPACE 154)
|
||||
|
||||
|
||||
(CONSTANTS (MSPACE 153)
|
||||
(NSPACE 152)
|
||||
(THINSPACE 159)
|
||||
(FIGSPACE 154))
|
||||
)
|
||||
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ NONE.TTC 0)
|
||||
|
||||
(RPAQQ CHARDELETE.TTC 1)
|
||||
|
||||
(RPAQQ WORDDELETE.TTC 2)
|
||||
|
||||
(RPAQQ DELETE.TTC 3)
|
||||
|
||||
(RPAQQ FUNCTIONCALL.TTC 4)
|
||||
|
||||
(RPAQQ REDO.TTC 5)
|
||||
|
||||
(RPAQQ UNDO.TTC 6)
|
||||
|
||||
(RPAQQ CMD.TTC 7)
|
||||
|
||||
(RPAQQ NEXT.TTC 8)
|
||||
|
||||
(RPAQQ EXPAND.TTC 9)
|
||||
|
||||
(RPAQQ CHARDELETE.FORWARD.TTC 10)
|
||||
|
||||
(RPAQQ WORDDELETE.FORWARD.TTC 11)
|
||||
|
||||
(RPAQQ PUNCT.TTC 20)
|
||||
|
||||
(RPAQQ TEXT.TTC 21)
|
||||
|
||||
(RPAQQ WHITESPACE.TTC 22)
|
||||
|
||||
|
||||
(CONSTANTS (NONE.TTC 0)
|
||||
(CHARDELETE.TTC 1)
|
||||
(WORDDELETE.TTC 2)
|
||||
(DELETE.TTC 3)
|
||||
(FUNCTIONCALL.TTC 4)
|
||||
(REDO.TTC 5)
|
||||
(UNDO.TTC 6)
|
||||
(CMD.TTC 7)
|
||||
(NEXT.TTC 8)
|
||||
(EXPAND.TTC 9)
|
||||
(CHARDELETE.FORWARD.TTC 10)
|
||||
(WORDDELETE.FORWARD.TTC 11)
|
||||
(PUNCT.TTC 20)
|
||||
(TEXT.TTC 21)
|
||||
(WHITESPACE.TTC 22))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON
|
||||
|
||||
(* ;; "Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called.")
|
||||
@@ -183,39 +49,118 @@
|
||||
(T (KWOTE I]
|
||||
(T (CONS COMMENTFLG ARGS])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224))
|
||||
(TTDECODE (LOGAND DATUM 31))))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ NOTBEFORE.LB 1)
|
||||
|
||||
(RPAQQ NOTAFTER.LB 2)
|
||||
|
||||
(RPAQQ BEFORE.LB 4)
|
||||
|
||||
(RPAQQ AFTER.LB 8)
|
||||
|
||||
(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
|
||||
(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
|
||||
|
||||
|
||||
(CONSTANTS (NOTBEFORE.LB 1)
|
||||
(NOTAFTER.LB 2)
|
||||
(BEFORE.LB 4)
|
||||
(AFTER.LB 8)
|
||||
(DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(NEWCHAR-IF-SPLIT.LB 32))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.COMMAND.LOOP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 23-Mar-2025 09:56 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 14:19 by rmk")
|
||||
(* ; "Edited 17-Feb-2025 12:05 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 10:01 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:51 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 22:34 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:26 by rmk")
|
||||
(* ; "Edited 18-Aug-2024 23:05 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 08:46 by rmk")
|
||||
(* ; "Edited 13-Jul-2024 23:13 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 00:39 by rmk")
|
||||
(* ; "Edited 9-Jul-2024 18:02 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 16:24 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 12:31 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:08 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:58 by rmk")
|
||||
(* ; "Edited 7-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
||||
(* ; "Edited 24-Feb-2024 15:33 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 09:50 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:40 by rmk")
|
||||
(* ; "Edited 30-May-91 19:33 by jds")
|
||||
|
||||
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
|
||||
|
||||
(DECLARE (SPECVARS TEXTSTREAM))
|
||||
(LET
|
||||
[(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
|
||||
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
|
||||
(* ; "Add the process to our panes")
|
||||
(until (TTY.PROCESSP) do (* ;
|
||||
"Wait until we really have the TTY before proceeding.")
|
||||
(DISMISS 250))
|
||||
(RESETLST
|
||||
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ)
|
||||
T))
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do (ERSETQ (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
|
||||
(while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ)
|
||||
(* ;
|
||||
"Flash caret while other operation completes")
|
||||
(BLOCK))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
|
||||
"Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T)
|
||||
(* ;
|
||||
"Before starting to work, note that we're doing something.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;;
|
||||
"Handle user type-in. CHARCODE is special so functions can see it.")
|
||||
|
||||
[bind CHARCODE TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ
|
||||
LOOPFN))
|
||||
(ERSETQ (APPLY* FN TSTREAM)))
|
||||
while (\SYSBUFP) do (SETQ CHARCODE (\GETKEY))
|
||||
(CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
|
||||
(* ;
|
||||
"The user can control each character typed.")
|
||||
(SETQ TCH (APPLY* FN TSTREAM CHARCODE))
|
||||
|
||||
(* ;;
|
||||
"Ignore input if TCH=NIL, continue if T, otherwise substitute.")
|
||||
|
||||
(CL:UNLESS (EQ TCH T)
|
||||
(SETQ CHARCODE TCH)))
|
||||
(CL:WHEN CHARCODE
|
||||
(OR (\TEDIT.COMMAND.FUNCTION? TSTREAM
|
||||
CHARCODE)
|
||||
(\TEDIT.INSERT CHARCODE (TEXTSEL
|
||||
TEXTOBJ)
|
||||
TSTREAM NIL T)))])
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
|
||||
|
||||
(\TEDIT.COMMAND.FUNCTION?
|
||||
[LAMBDA (TSTREAM CHARCODE) (* ; "Edited 23-Mar-2025 15:27 by rmk")
|
||||
(DECLARE (SPECVARS TSTREAM CHARCODE))
|
||||
|
||||
(* ;; "If CHARCODE is a function in TSTREAM's read table, execute the function.")
|
||||
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
FN)
|
||||
(DECLARE (SPECVARS TEXTOBJ))
|
||||
(CL:WHEN [AND (EQ (\TEDIT.TTC FUNCTIONCALL)
|
||||
(\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CHARCODE))
|
||||
(SETQ FN (CAR (fetch MACROFN of (GETHASH CHARCODE (fetch READMACRODEFS
|
||||
of (FGETTOBJ TEXTOBJ
|
||||
TXTRTBL]
|
||||
(if (AND (LISTP FN)
|
||||
(NOT (FNTYP FN)))
|
||||
then
|
||||
(* ;; "A form but not a LAMBDA. TSTREAM, TEXTOBJ, and CHARCODE are specvars")
|
||||
|
||||
(EVAL FN)
|
||||
else (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ)))
|
||||
T)])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.INTERRUPT.SETUP
|
||||
[LAMBDA (PROC FORCEOFF) (* ; "Edited 27-Mar-2024 15:27 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:45 by rmk")
|
||||
@@ -254,133 +199,6 @@
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.COMMAND.LOOP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Nov-2024 10:01 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:51 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 22:34 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 23:26 by rmk")
|
||||
(* ; "Edited 18-Aug-2024 23:05 by rmk")
|
||||
(* ; "Edited 2-Aug-2024 08:46 by rmk")
|
||||
(* ; "Edited 13-Jul-2024 23:13 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 00:39 by rmk")
|
||||
(* ; "Edited 9-Jul-2024 18:02 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 16:24 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 12:31 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 00:08 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:58 by rmk")
|
||||
(* ; "Edited 7-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
||||
(* ; "Edited 24-Feb-2024 15:33 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 09:50 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:40 by rmk")
|
||||
(* ; "Edited 30-May-91 19:33 by jds")
|
||||
|
||||
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
|
||||
|
||||
(LET
|
||||
[(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
|
||||
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
|
||||
(* ; "Add the process to our panes")
|
||||
(until (TTY.PROCESSP) do (* ;
|
||||
"Wait until we really have the TTY before proceeding.")
|
||||
(DISMISS 250))
|
||||
(RESETLST
|
||||
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ)
|
||||
T))
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(ERSETQ
|
||||
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
do
|
||||
(\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
|
||||
(while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ)
|
||||
(* ;
|
||||
"Flash caret while other operation completes")
|
||||
(BLOCK))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
|
||||
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
|
||||
"Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;
|
||||
"Before starting to work, note that we're doing something.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Handle user type-in")
|
||||
|
||||
[bind CH TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN))
|
||||
(ERSETQ (APPLY* FN TSTREAM))) while (\SYSBUFP)
|
||||
do (SETQ CH (\GETKEY))
|
||||
(CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
|
||||
(* ;
|
||||
"Give the OEM user control for each character typed.")
|
||||
(SETQ TCH (APPLY* FN TSTREAM CH))
|
||||
|
||||
(* ;;
|
||||
"And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
|
||||
|
||||
(OR (EQ TCH T)
|
||||
(SETQ CH TCH)))
|
||||
(SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
CH))
|
||||
(CHARDELETE.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM))
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
(\TEDIT.CHARDELETE TSTREAM T))
|
||||
(WORDDELETE.TTC
|
||||
(\TEDIT.WORDDELETE TSTREAM))
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
(\TEDIT.WORDDELETE.FORWARD TSTREAM))
|
||||
(DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
|
||||
(UNDO.TTC (* ;
|
||||
"Take off the BPD, the undoing and put it back on.")
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.UNDO TSTREAM))
|
||||
(REDO.TTC (* ;
|
||||
"He hit the REDO key, so go REDO something")
|
||||
(TEDIT.REDO TSTREAM)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ))
|
||||
(FUNCTIONCALL.TTC (* ;
|
||||
"This is a special character -- it calls a function")
|
||||
(CL:WHEN [SETQ FN (CAR (fetch MACROFN
|
||||
of (GETHASH CH (fetch READMACRODEFS
|
||||
of (FGETTOBJ TEXTOBJ
|
||||
TXTRTBL]
|
||||
(* ;
|
||||
"There IS a command function to be called.")
|
||||
(APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))
|
||||
(* ; "do it")
|
||||
(* ;
|
||||
"After a user function (that is not wheelscroll) no more blue-pending-delete")
|
||||
|
||||
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
|
||||
|
||||
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
|
||||
(MEMB CH CLIPBOARDCODES))
|
||||
(* ;
|
||||
"The FNs handled the selection. should preserve the highlighting")
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL NIL T TEXTOBJ))))
|
||||
(NEXT.TTC (* ;
|
||||
"Move to the next blank to fill in, delimited by >>...<<")
|
||||
(TEDIT.NEXT TSTREAM))
|
||||
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
|
||||
(\TEDIT.ABBREV.EXPAND TSTREAM))
|
||||
(SELECTC (AND CH (fetch TERMCLASS of (\SYNCODE (OR (FGETTOBJ TEXTOBJ
|
||||
TXTTERMSA)
|
||||
\PRIMTERMSA)
|
||||
CH)))
|
||||
(CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM))
|
||||
(WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM))
|
||||
(LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ))
|
||||
(CL:WHEN CH (* ;
|
||||
"Any other key: insert the character.")
|
||||
(\TEDIT.INSERT CH (TEXTSEL TEXTOBJ)
|
||||
TSTREAM NIL T))])
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
|
||||
|
||||
(\TEDIT.COMMAND.RESET.SETUP
|
||||
[LAMBDA (ARGS STARTING) (* ; "Edited 29-Jun-2024 00:10 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 18:54 by rmk")
|
||||
@@ -478,445 +296,17 @@
|
||||
(20 CONTROL-T)))
|
||||
|
||||
(RPAQQ || NIL)
|
||||
|
||||
|
||||
|
||||
(* ; "Why?")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS || TEDIT.INTERRUPTS)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "Read-table Utilities")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.READTABLE
|
||||
[LAMBDA NIL (* ; "Edited 24-Dec-2023 09:54 by rmk")
|
||||
(* ; "Edited 20-Apr-2018 07:59 by rmk:")
|
||||
(* jds "12-Sep-86 13:48")
|
||||
|
||||
(* ;; "Create a TEdit read-table, to control which characters have what functions and call which commands.")
|
||||
|
||||
(LET [(RTBL (create READTABLEP
|
||||
READMACRODEFS _ (HASHARRAY 50]
|
||||
|
||||
(* ;; "CHARDELETE.FORWARD replaces WORDDELETE on ^W")
|
||||
|
||||
(for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL
|
||||
in (CONSTANT (LIST CHARDELETE.TTC CHARDELETE.TTC CHARDELETE.FORWARD.TTC DELETE.TTC
|
||||
UNDO.TTC NEXT.TTC CMD.TTC REDO.TTC))
|
||||
do (* ;
|
||||
"Set up the default syntax classes for command characters")
|
||||
(\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH CL))
|
||||
(for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND)
|
||||
do (* ;
|
||||
"Set up the default function-calling characters (^X to expand abbrevs for now)")
|
||||
(TEDIT.SETFUNCTION CH FN RTBL))
|
||||
(TEDIT.SETFUNCTION (CHARCODE ^O)
|
||||
(FUNCTION GET.OBJ.FROM.USER)
|
||||
RTBL) (* ; "And for image object capture")
|
||||
RTBL])
|
||||
|
||||
(\TEDIT.WORDBOUND.READTABLE
|
||||
[LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds")
|
||||
|
||||
(* ;; "Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of the adjacent characters is different")
|
||||
|
||||
(PROG [(RTBL (create READTABLEP
|
||||
READMACRODEFS _ (HARRAY 50]
|
||||
(for CH from 0 to 255 do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH PUNCT.TTC))
|
||||
|
||||
(* ;; "By default, every character except those noted below is a punctuation character")
|
||||
|
||||
(for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(* ; "Upper case alpha")
|
||||
(for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(* ; "Lower case alpha")
|
||||
(for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(* ; "And digits are text characters")
|
||||
|
||||
(* ;; "European chars and accents are text characters:")
|
||||
|
||||
(for CH from (CHARCODE "361,41") to (CHARCODE "361,376")
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(for CH from (CHARCODE "0,301") to (CHARCODE "0,317")
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(for CH from (CHARCODE "0,341") to (CHARCODE "0,376")
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH WHITESPACE.TTC))
|
||||
(* ; "And these are white space")
|
||||
(for CH in (LIST MSPACE NSPACE THINSPACE FIGSPACE)
|
||||
do (\SETSYNCODE (fetch READSA of RTBL)
|
||||
CH TEXT.TTC))
|
||||
(RETURN RTBL])
|
||||
|
||||
(TEDIT.GETSYNTAX
|
||||
[LAMBDA (CH TABLE) (* ; "Edited 24-Dec-2023 09:47 by rmk")
|
||||
(* ; "Edited 31-Mar-87 10:01 by jds")
|
||||
(* ;
|
||||
"Find TEdit's interpretation of a given character")
|
||||
(SELECTC (\SYNCODE [fetch READSA of (COND
|
||||
((type? TEXTOBJ TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
|
||||
TEDIT.READTABLE))
|
||||
((type? STREAM TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM
|
||||
TEXTOBJ)
|
||||
of TABLE))
|
||||
TEDIT.READTABLE))
|
||||
(T (OR TABLE TEDIT.READTABLE]
|
||||
(COND
|
||||
((LITATOM CH) (* ;
|
||||
"Symbols are converted to numeric charcodes")
|
||||
(APPLY* 'CHARCODE CH))
|
||||
((STRINGP CH) (* ; "As are string char-names")
|
||||
(APPLY* 'CHARCODE CH))
|
||||
(T CH)))
|
||||
(WORDDELETE.TTC
|
||||
'WORDDELETE)
|
||||
(WORDDELETE.FORWARD.TTC
|
||||
'WORDDELETE.FORWARD)
|
||||
(CHARDELETE.TTC
|
||||
'CHARDELETE)
|
||||
(CHARDELETE.FORWARD.TTC
|
||||
'CHARDELETE.FORWARD)
|
||||
(DELETE.TTC 'DELETE)
|
||||
(UNDO.TTC 'UNDO)
|
||||
(REDO.TTC 'REDO)
|
||||
(FUNCTIONCALL.TTC
|
||||
'FN)
|
||||
(CMD.TTC 'CMD)
|
||||
(NEXT.TTC 'NEXT)
|
||||
(EXPAND.TTC 'EXPAND)
|
||||
NIL])
|
||||
|
||||
(TEDIT.SETSYNTAX
|
||||
[LAMBDA (CHAR CLASS TABLE) (* ; "Edited 24-Dec-2023 09:17 by rmk")
|
||||
(* ; "Edited 31-Mar-87 10:00 by jds")
|
||||
(* ;
|
||||
"SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE")
|
||||
(PROG1 (TEDIT.GETSYNTAX (SETQ CHAR (COND
|
||||
((LITATOM CHAR)
|
||||
(APPLY* 'CHARCODE CHAR))
|
||||
((STRINGP CHAR)
|
||||
(APPLY* 'CHARCODE CHAR))
|
||||
(T CHAR)))
|
||||
TABLE)
|
||||
(\SETSYNCODE [fetch READSA of (COND
|
||||
((type? TEXTOBJ TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
|
||||
TEDIT.READTABLE))
|
||||
((type? STREAM TABLE)
|
||||
(* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of TABLE))
|
||||
TEDIT.READTABLE))
|
||||
(T (OR TABLE TEDIT.READTABLE]
|
||||
CHAR
|
||||
(SELECTQ CLASS
|
||||
(CHARDELETE CHARDELETE.TTC)
|
||||
(CHARDELETE.FORWARD
|
||||
CHARDELETE.FORWARD.TTC)
|
||||
(WORDDELETE WORDDELETE.TTC)
|
||||
(WORDDELETE.FORWARD
|
||||
WORDDELETE.FORWARD.TTC)
|
||||
((DELETE LINEDELETE)
|
||||
DELETE.TTC)
|
||||
(UNDO UNDO.TTC)
|
||||
(REDO REDO.TTC)
|
||||
(CMD CMD.TTC)
|
||||
(FN FUNCTIONCALL.TTC)
|
||||
(NEXT NEXT.TTC)
|
||||
(EXPAND EXPAND.TTC)
|
||||
NONE.TTC)))])
|
||||
|
||||
(TEDIT.GETFUNCTION
|
||||
[LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06")
|
||||
(* Gets the FN that is called when CH
|
||||
is hit inside TEDIT.)
|
||||
[SETQ TABLE (COND
|
||||
((type? TEXTOBJ TABLE)
|
||||
|
||||
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
|
||||
that edit session)
|
||||
|
||||
(fetch (TEXTOBJ TXTRTBL) of TABLE))
|
||||
((type? STREAM TABLE)
|
||||
|
||||
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
|
||||
that edit session)
|
||||
|
||||
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE)))
|
||||
(T (OR TABLE TEDIT.READTABLE]
|
||||
(SETQ CHARCODE (COND
|
||||
((LITATOM CHARCODE)
|
||||
(APPLY* 'CHARCODE CHARCODE))
|
||||
(T CHARCODE)))
|
||||
(AND TABLE (type? READTABLEP TABLE)
|
||||
(IEQP FUNCTIONCALL.TTC (\SYNCODE (fetch READSA of TABLE)
|
||||
CHARCODE))
|
||||
(fetch READMACRODEFS of TABLE)
|
||||
(CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of TABLE])
|
||||
|
||||
(TEDIT.SETFUNCTION
|
||||
[LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds")
|
||||
(* ;
|
||||
"Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.")
|
||||
(* ;
|
||||
"If FN is NIL, make the character be normal again.")
|
||||
[SETQ RTBL (COND
|
||||
((type? TEXTOBJ RTBL) (* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(fetch (TEXTOBJ TXTRTBL) of RTBL))
|
||||
((type? STREAM RTBL) (* ;
|
||||
"If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
|
||||
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of RTBL)))
|
||||
(T (OR RTBL TEDIT.READTABLE]
|
||||
(\SETSYNCODE (fetch READSA of RTBL)
|
||||
(SETQ CHARCODE (COND
|
||||
((LITATOM CHARCODE)
|
||||
(APPLY* 'CHARCODE CHARCODE))
|
||||
((STRINGP CHARCODE)
|
||||
(APPLY* 'CHARCODE CHARCODE))
|
||||
(T CHARCODE)))
|
||||
(COND
|
||||
(FN (* ;
|
||||
"He gave us a function to call. Set up the syntax so it IS called.")
|
||||
FUNCTIONCALL.TTC)
|
||||
(T (* ;
|
||||
"He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.")
|
||||
NONE.TTC))) (* ;
|
||||
"Mark the character as invoking a function")
|
||||
(OR (fetch READMACRODEFS of RTBL)
|
||||
(replace READMACRODEFS of RTBL with (HARRAY 50))) (* ;
|
||||
"Make sure there's a hash table to store the function in.")
|
||||
(PUTHASH CHARCODE (CREATE READMACRODEF
|
||||
MACROTYPE _ 'TEDIT
|
||||
MACROFN _ (LIST FN))
|
||||
(fetch READMACRODEFS of RTBL])
|
||||
|
||||
(TEDIT.WORDGET
|
||||
[LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24")
|
||||
(\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
|
||||
(COND
|
||||
((SMALLP CH))
|
||||
(T (CHCON1 CH])
|
||||
|
||||
(TEDIT.WORDSET
|
||||
[LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23")
|
||||
(* SETS TEDIT-STYLE SYNTAX BITS IN A
|
||||
TERMTABLE)
|
||||
(\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
|
||||
(COND
|
||||
((SMALLP CHARCODE))
|
||||
(T (CHCON1 CHARCODE)))
|
||||
(COND
|
||||
((FIXP CLASS))
|
||||
(T (SELECTQ CLASS
|
||||
(PUNCTUATION PUNCT.TTC)
|
||||
(WHITESPACE WHITESPACE.TTC)
|
||||
(TEXT TEXT.TTC)
|
||||
TEXT.TTC])
|
||||
|
||||
(TEDIT.ATOMBOUND.READTABLE
|
||||
[LAMBDA (READTABLE) (* ; "Edited 25-Dec-2023 13:10 by rmk")
|
||||
(* ; "Edited 5-Dec-2023 23:47 by rmk")
|
||||
|
||||
(* ;; "A wordbound table that approximates the unquoted OTHER characters of Lisp atoms as defined by READTABLE or the current readtable. This is specified as the BOUNDTABLE for Lisp source code edits. Not perfect, but not bad.")
|
||||
|
||||
(* ;; "Could cache this for common readtables (interlisp, commonlisp)")
|
||||
|
||||
(LET ((TABLE (\TEDIT.WORDBOUND.READTABLE))) (* ;
|
||||
"\TEDIT.WORDBOUND.READTABLE creates a new one each time.")
|
||||
(for CODE IN (GETSYNTAX 'OTHER (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE
|
||||
'TEXT TABLE))
|
||||
(for CODE IN (GETSYNTAX 'BREAK (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE
|
||||
'PUNCTUATION TABLE))
|
||||
(TEDIT.WORDSET (CHARCODE %:)
|
||||
'TEXT TABLE)
|
||||
TABLE])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE))
|
||||
|
||||
(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "Wheelscroll")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD FROM LISPUSERS)
|
||||
WHEELSCROLL)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.WHEELSCROLL
|
||||
[LAMBDA NIL (* ; "Edited 2-Oct-2023 23:23 by rmk")
|
||||
|
||||
(* ;; "TEDIT disables interrupts, so it has to deal with wheelscroll behaviors when the caret is in the Tedit window. Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")
|
||||
|
||||
(* ;; "This localizes the behavior inside Tedit, where we also suppress Tedit from thinking that somehow these characters change the selection highlighting.")
|
||||
|
||||
(for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
(AND WHEELSCROLLENABLED ,(CADR I]
|
||||
TEDIT.READTABLE)
|
||||
(CAR I])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS WHEELSCROLLCHARCODES)
|
||||
)
|
||||
|
||||
(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL))
|
||||
|
||||
|
||||
|
||||
(* ; "Clipboard")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.CLIPBOARD
|
||||
[LAMBDA NIL (* ; "Edited 21-Apr-2024 09:57 by rmk")
|
||||
(* ; "Edited 2-Oct-2023 23:23 by rmk")
|
||||
|
||||
(* ;; "TEDIT disables interrupts, so it has to deal with special interrupt behaviors when the caret is in the Tedit window. This localizes the behavior of WHEELSCROLL and CLIPBOARD inside Tedit.")
|
||||
|
||||
(* ;; "Clipboard paste")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,V")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Clipboard copy")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
|
||||
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,C")
|
||||
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Clipboard extract")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
|
||||
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
|
||||
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")
|
||||
|
||||
(for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
(AND WHEELSCROLLENABLED ,(CADR I]
|
||||
TEDIT.READTABLE)
|
||||
(CAR I])
|
||||
|
||||
(\TEDIT.COPYTOCLIPBOARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT) (* ; "Edited 21-Apr-2024 11:51 by rmk")
|
||||
(* ; "Edited 2-Apr-2024 17:01 by rmk")
|
||||
(* ; "Edited 18-Apr-2018 00:02 by rmk:")
|
||||
|
||||
(* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored). .")
|
||||
|
||||
(CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD))
|
||||
(SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS))
|
||||
T))
|
||||
(CL:WHEN TSTREAM
|
||||
(PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL))
|
||||
(CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))])
|
||||
|
||||
(\TEDIT.EXTRACTTOCLIPBOARD
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Apr-2024 09:20 by rmk")
|
||||
(\TEDIT.COPYTOCLIPBOARD TSTREAM TEXTOBJ SEL T])
|
||||
|
||||
(\TEDIT.WRITE.SEL
|
||||
[LAMBDA (TSTREAM STREAM) (* ; "Edited 21-Apr-2024 11:55 by rmk")
|
||||
|
||||
(* ;; "Writes the selected characters in TSTREAM to STREAM. ")
|
||||
|
||||
(* ;; "If there are no image objects, this is equivalent to (PRIN3 (TEDIT.SEL.AS.STRING ...)), but that would trip over image objects. Image objects could be skipped, or as here, represented as the OBJECTBYTE or described in some way.")
|
||||
|
||||
(* ;; "For Medley-to-Medley copy/paste we could also create a local tmp stream that shadows the system clipboard, and apply the PUTFN to that stream. Then copy/paste could be used to move image objects around with a single Medley or perhaps across Medley's (if the GETFN is available).")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SEL (FGETTOBJ TEXTOBJ SEL)))
|
||||
(CL:WHEN (IGREATERP (GETSEL SEL DCH)
|
||||
0)
|
||||
|
||||
(* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.")
|
||||
|
||||
(for I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE))
|
||||
(NOBJECTS _ 0) from (GETSEL SEL CH#) to (SUB1 (GETSEL SEL CHLIM))
|
||||
while (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I))
|
||||
do (if (CHARCODEP CODE)
|
||||
then (PRINTCCODE CODE STREAM)
|
||||
elseif (IMAGEOBJP CODE)
|
||||
then (add NOBJECTS 1)
|
||||
(if OBJECTBYTE
|
||||
then (PRINTCCODE OBJECTBYTE STREAM)
|
||||
else (PRIN3 "{" STREAM)
|
||||
(PRIN4 (IMAGEOBJPROP CODE 'GETFN)
|
||||
STREAM)
|
||||
(CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN)
|
||||
(FUNCTION NILL))
|
||||
PRE CODE))
|
||||
(PRIN3 " : " STREAM)
|
||||
(PRIN4 PRE STREAM))
|
||||
(PRIN3 "}" STREAM))
|
||||
else (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE))
|
||||
finally (CL:WHEN (IGREATERP NOBJECTS 0)
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note: Selection contains " NOBJECTS
|
||||
" image object"
|
||||
(CL:IF (EQ NOBJECTS 1)
|
||||
""
|
||||
"s"))
|
||||
T))))])
|
||||
)
|
||||
(DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQ CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X)))
|
||||
|
||||
|
||||
[CONSTANTS (CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X]
|
||||
)
|
||||
)
|
||||
|
||||
(\TEDIT.CLIPBOARD)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8312 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
|
||||
\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP
|
||||
19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 .
|
||||
31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 .
|
||||
37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) (
|
||||
TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441
|
||||
49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) (
|
||||
\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019)))))
|
||||
(FILEMAP (NIL (2688 10242 (\TEDIT.COMMAND.LOOP 2698 . 9039) (\TEDIT.COMMAND.FUNCTION? 9041 . 10240)) (
|
||||
10243 19041 (\TEDIT.INTERRUPT.SETUP 10253 . 11900) (\TEDIT.MARKACTIVE 11902 . 12231) (
|
||||
\TEDIT.MARKINACTIVE 12233 . 12449) (\TEDIT.COMMAND.RESET.SETUP 12451 . 19039)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2025 15:03:01" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;595 159113
|
||||
(FILECREATED "28-Mar-2025 14:24:34" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;608 161966
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.PUT.UTF8.SPLITPIECES)
|
||||
:CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE)
|
||||
|
||||
:PREVIOUS-DATE " 7-Jan-2025 12:28:41" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;593)
|
||||
:PREVIOUS-DATE "26-Mar-2025 10:02:49" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;607)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -55,6 +55,7 @@
|
||||
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
|
||||
(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*)
|
||||
(FNS TEDITFROMLISPSOURCE SHELLSCRIPTP TEDITFROMSHELLSCRIPT)
|
||||
(INITVARS (TEDIT.SOURCE.LINELENGTH 110))
|
||||
(ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
|
||||
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT)))
|
||||
(INITVARS (* ;
|
||||
@@ -117,7 +118,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.GET
|
||||
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 26-Aug-2024 16:15 by rmk")
|
||||
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 14-Mar-2025 11:52 by rmk")
|
||||
(* ; "Edited 26-Aug-2024 16:15 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:13 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 16:30 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:31 by rmk")
|
||||
@@ -151,7 +153,7 @@
|
||||
[SETQ FILE (\TEDIT.MAKEFILENAME (OR FILE (TEDIT.GETINPUT TEXTOBJ "GET from: "
|
||||
(OR (GETTEXTPROP TEXTOBJ
|
||||
'LASTGETFILENAME)
|
||||
(\TEXTSTREAM.FILENAME TEXTOBJ]
|
||||
(\TEDIT.LIKELY.FILENAME TEXTOBJ]
|
||||
(CL:UNLESS FILE
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "No input file--aborted" T T)
|
||||
(RETURN))
|
||||
@@ -249,7 +251,8 @@
|
||||
(GDATE IDATE)))])
|
||||
|
||||
(TEDIT.INCLUDE
|
||||
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 25-Nov-2024 20:17 by rmk")
|
||||
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 8-Feb-2025 20:56 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 20:17 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:43 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 22:03 by rmk")
|
||||
@@ -364,7 +367,7 @@
|
||||
[SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL START END
|
||||
`(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TOOBJ TSEL)
|
||||
PARALOOKS
|
||||
,(GETTOBJ TOOBJ FMTSPEC)
|
||||
,(GETTOBJ TOOBJ DEFAULTPARALOOKS)
|
||||
PLAINTEXT
|
||||
,PLAINTEXT]
|
||||
|
||||
@@ -389,7 +392,9 @@
|
||||
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
|
||||
|
||||
(TEDIT.PUT
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 23-Dec-2024 23:02 by rmk")
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "Edited 14-Mar-2025 11:52 by rmk")
|
||||
(* ; "Edited 22-Feb-2025 15:56 by rmk")
|
||||
(* ; "Edited 23-Dec-2024 23:02 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:31 by rmk")
|
||||
(* ; "Edited 26-Jun-2024 15:46 by rmk")
|
||||
@@ -450,10 +455,11 @@
|
||||
(SETQ FORCENEW 'DETEMPLATE)))
|
||||
[SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Put to: "
|
||||
(CL:UNLESS FORCENEW
|
||||
(\TEXTSTREAM.FILENAME
|
||||
(
|
||||
\TEDIT.LIKELY.FILENAME
|
||||
TEXTOBJ UNFORMATTED?
|
||||
])
|
||||
(T (SETQ FILE (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED?)))
|
||||
(T (SETQ FILE (\TEDIT.LIKELY.FILENAME TEXTOBJ UNFORMATTED?)))
|
||||
NIL)
|
||||
(CL:UNLESS FILE (* ; "No file to put to.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "No output file--aborted" T T)
|
||||
@@ -479,9 +485,10 @@
|
||||
'(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS)
|
||||
'DON'T]
|
||||
(SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
|
||||
"..."))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T)
|
||||
(CL:UNLESS QUIET
|
||||
(SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM)
|
||||
"..."))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -508,8 +515,9 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T)
|
||||
(CL:UNLESS QUIET
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -572,7 +580,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.FOREIGN.FILE
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 8-Feb-2025 20:20 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:10 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
(* ; "Edited 22-Oct-2023 20:40 by rmk")
|
||||
(* ; "Edited 18-Sep-2023 16:40 by rmk")
|
||||
(* ; "Edited 10-Aug-2023 17:26 by rmk")
|
||||
@@ -606,15 +616,16 @@
|
||||
(SETQ FTEXTOBJ (TEXTOBJ FSTREAM))
|
||||
(\TEDIT.INSERTPIECES (\TEDIT.FIRSTPIECE FTEXTOBJ)
|
||||
NIL TTEXTOBJ)
|
||||
(FSETTOBJ TTEXTOBJ LASTPIECE (FGETTOBJ FTEXTOBJ LASTPIECE))
|
||||
(FSETTOBJ TTEXTOBJ SUFFIXPIECE (FGETTOBJ FTEXTOBJ SUFFIXPIECE))
|
||||
(* ; "Last piece have different looks")
|
||||
(FSETTOBJ TTEXTOBJ TXTPAGEFRAMES (FGETTOBJ FTEXTOBJ TXTPAGEFRAMES))
|
||||
(FSETTOBJ TTEXTOBJ FMTSPEC (FGETTOBJ FTEXTOBJ FMTSPEC))
|
||||
(FSETTOBJ TTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ FTEXTOBJ DEFAULTPARALOOKS))
|
||||
(FSETTOBJ TTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FTEXTOBJ DEFAULTCHARLOOKS)))
|
||||
TSTREAM)])
|
||||
|
||||
(\TEDIT.GET.UNFORMATTED.FILE
|
||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
(* ; "Edited 5-Feb-2024 09:26 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 09:42 by rmk")
|
||||
(* ; "Edited 29-Dec-2023 11:52 by rmk")
|
||||
@@ -633,7 +644,7 @@
|
||||
DEFAULTCHARLOOKS DEFAULTPARALOOKS PIECES)
|
||||
(PUTTEXTPROP TEXTOBJ 'CLEARGET T)
|
||||
(SETQ DEFAULTCHARLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ FMTSPEC))
|
||||
(SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(CL:WHEN (AND (EQ FORMAT :STRING)
|
||||
(\IOMODEP STREAM 'OUTPUT T))
|
||||
(SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
|
||||
@@ -675,7 +686,9 @@
|
||||
(\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.GET.FORMATTED.FILE
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 28-Oct-2024 17:48 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 28-Mar-2025 14:15 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:19 by rmk")
|
||||
(* ; "Edited 28-Oct-2024 17:48 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:25 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||
@@ -709,13 +722,14 @@
|
||||
(\TEDIT.GET.PCTB0 TEXT TSTREAM (CADR PCCOUNT)
|
||||
PCCOUNT START END))
|
||||
(\TEDIT.THELP "File format version incompatible with this version of TEdit."))
|
||||
(CL:WHEN (SETQ PC (PREVPIECE (\TEDIT.LASTPIECE TEXTOBJ)))
|
||||
(CL:WHEN (SETQ PC (\TEDIT.LASTPIECE TEXTOBJ))
|
||||
(FSETPC PC PPARALAST T))
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL)
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TSTREAM NIL)
|
||||
TEXTOBJ)])
|
||||
|
||||
(\TEDIT.FORMATTEDSTREAMP
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:17 by rmk")
|
||||
(* ; "Edited 15-Sep-2023 00:09 by rmk")
|
||||
(* ; "Edited 15-Aug-2023 17:35 by rmk")
|
||||
@@ -729,7 +743,7 @@
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(for PC (FORMATLEVEL _ 0)
|
||||
(DEFAULTCLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces (\TEDIT.FIRSTPIECE
|
||||
TEXTOBJ)
|
||||
do [COND
|
||||
@@ -890,7 +904,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PIECES3
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 30-Aug-2024 15:44 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:44 by rmk")
|
||||
(* ; "Edited 11-Jul-2024 13:20 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:37 by rmk")
|
||||
(* ; "Edited 7-Apr-2024 17:20 by rmk")
|
||||
@@ -914,7 +929,8 @@
|
||||
DEFAULTCHARLOOKS
|
||||
))
|
||||
(SETQ OLDPARALOOKS (FGETTOBJ TEXTOBJ
|
||||
FMTSPEC))
|
||||
DEFAULTPARALOOKS
|
||||
))
|
||||
(SETQ FIRSTPC (CREATE PIECE))
|
||||
(* ; "Throw away at the end")
|
||||
(SETQ PREVPC FIRSTPC)
|
||||
@@ -1530,7 +1546,9 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 22-Nov-2024 23:55 by rmk")
|
||||
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 19-Feb-2025 12:10 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:04 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 23:55 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:03 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:47 by rmk")
|
||||
@@ -1545,31 +1563,31 @@
|
||||
"Edited 2-Jul-93 21:31 by sybalskY:MV:ENVOS")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
(FILEPOS (GETFILEPTR FILE))
|
||||
(LOOKSLEN (\WIN FILE))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP "UNRECOGNIZED QUAD BYTE")))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1) (* ;
|
||||
"0/1 don't make sense, seemed to code default")
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -1583,41 +1601,42 @@
|
||||
(6 'DOTTEDCENTERED)
|
||||
(7 'DOTTEDDECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTHEADINGKEEP (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTKEEP (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTHEADINGKEEP (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTKEEP (\ARBIN FILE))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPARA FMT FMTBASETOBASE (\ARBIN FILE)))
|
||||
(FSETPLOOKS PARALOOKS FMTBASETOBASE (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPARA FMT FMTREVISED (\ARBIN FILE)))
|
||||
(FSETPLOOKS PARALOOKS FMTREVISED (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPARA FMT FMTCOLUMN (\ARBIN FILE)))
|
||||
(FSETPLOOKS PARALOOKS FMTCOLUMN (\ARBIN FILE)))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))))
|
||||
(CL:WHEN (ILESSP (GETFILEPTR FILE)
|
||||
(IPLUS FILEPOS LOOKSLEN)) (* ;
|
||||
"There is more PARALOOKS info in this piece -- we probably lost data.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T)
|
||||
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)))
|
||||
FMT])
|
||||
PARALOOKS])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1990,6 +2009,7 @@
|
||||
|
||||
(\TEDIT.PUT.PCTB.NEXTNEW
|
||||
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
|
||||
(* ; "Edited 26-Mar-2025 09:27 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 14-May-2024 18:54 by rmk")
|
||||
(* ; "Edited 13-May-2024 08:27 by rmk")
|
||||
@@ -2022,8 +2042,9 @@
|
||||
(THINSTRING.PTYPE
|
||||
THINFILE.PTYPE)
|
||||
((LIST FATSTRING.PTYPE FATFILE1.PTYPE)
|
||||
(* ;
|
||||
"PCHARSET is not relevant for FILEFILE2")
|
||||
(FSETPC NEXTNEW PBYTESPERCHAR 2)
|
||||
(FSETPC NEXTNEW PCHARSET \NORUNCODE)
|
||||
FATFILE2.PTYPE)
|
||||
(PTYPE PC))))
|
||||
(\TEDIT.THELP "EXTERNAL FORMAT NOT RECOGNIZED" EXTFORMAT))
|
||||
@@ -2340,7 +2361,8 @@
|
||||
(PUTHASH PL I PARAHASH])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS
|
||||
[LAMBDA (FONTFILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (FONTFILE LOOKS) (* ; "Edited 19-Feb-2025 12:11 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:29 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||
@@ -2355,23 +2377,23 @@
|
||||
DEFTAB TABS LEN)
|
||||
(\SMALLPOUT FONTFILE 0) (* ;
|
||||
"Reserve space to store the look length")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPARA LOOKS FMTTABS))
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FONTFILE (FGETPLOOKS LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPLOOKS LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPLOOKS LOOKS FMTTABS))
|
||||
|
||||
(* ;; "Indicate whether there are tab specs or a default tab setting to save")
|
||||
|
||||
(\BOUT FONTFILE (CL:IF (OR DEFTAB TABS)
|
||||
3
|
||||
2))
|
||||
(\BOUT FONTFILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(\BOUT FONTFILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
@@ -2398,23 +2420,23 @@
|
||||
6)
|
||||
(DOTTEDDECIMAL 7)
|
||||
(\TEDIT.THELP])
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
(\SMALLPOUT FONTFILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FONTFILE (FGETPARA LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FONTFILE (FGETPARA LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTSTYLE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTNEWPAGEAFTER))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTHEADINGKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTBASETOBASE))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTREVISED))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTCOLUMN))
|
||||
(\ARBOUT FONTFILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FONTFILE (FGETPLOOKS LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FONTFILE (FGETPLOOKS LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTSTYLE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTNEWPAGEAFTER))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTHEADINGKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTKEEP))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTBASETOBASE))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTREVISED))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTCOLUMN))
|
||||
(\ARBOUT FONTFILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
|
||||
|
||||
(* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)")
|
||||
|
||||
@@ -2448,7 +2470,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDITFROMLISPSOURCE
|
||||
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 17-Nov-2024 10:03 by rmk")
|
||||
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 26-Mar-2025 10:02 by rmk")
|
||||
(* ; "Edited 18-Feb-2025 23:34 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 10:03 by rmk")
|
||||
(* ; "Edited 25-Dec-2023 12:28 by rmk")
|
||||
(* ; "Edited 5-Dec-2023 23:46 by rmk")
|
||||
(* ; "Edited 26-Oct-2023 11:22 by rmk")
|
||||
@@ -2462,19 +2486,22 @@
|
||||
|
||||
(* ;; "USERTEMP is the reader environment returned by LISPSOURCEFILEP")
|
||||
|
||||
(DECLARE (USEDFREE TEDIT.SOURCE.LINELENGTH))
|
||||
(CL:UNLESS TSTREAM
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM)))
|
||||
|
||||
(* ;; "An empty window for TSTREAM may already be up on the screen. Since this conversion can take awhile, we tell the user what's going on")
|
||||
(* ;; "Estimate 110 characters per line in the default font?")
|
||||
|
||||
(TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
|
||||
(TEXTPROP TSTREAM 'BOUNDTABLE (TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
|
||||
of USERTEMP)))
|
||||
[PUTTEXTPROPS TSTREAM `(PARABREAKCHARS NIL OPENWIDTH ,(TIMES TEDIT.SOURCE.LINELENGTH
|
||||
(CHARWIDTH (CHARCODE SPACE)
|
||||
DEFAULTFONT))
|
||||
BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
|
||||
of USERTEMP]
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Fetching " (FULLNAME SOURCEFILE)
|
||||
" ...")
|
||||
T)
|
||||
(COPY.TEXT.TO.IMAGE SOURCEFILE TSTREAM)
|
||||
(TEXTPROP TSTREAM 'PARABREAKCHARS NIL)
|
||||
TSTREAM])
|
||||
|
||||
(SHELLSCRIPTP
|
||||
@@ -2497,33 +2524,35 @@
|
||||
TSTREAM])
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.SOURCE.LINELENGTH 110)
|
||||
|
||||
(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
|
||||
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT))
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5017 33942 (TEDIT.GET 5027 . 11036) (TEDIT.FORMATTEDFILEP 11038 . 12354) (
|
||||
TEDIT.FILEDATE 12356 . 13527) (TEDIT.INCLUDE 13529 . 21440) (TEDIT.RAW.INCLUDE 21442 . 22250) (
|
||||
TEDIT.PUT 22252 . 30107) (TEDIT.PUT.STREAM 30109 . 33940)) (33943 53140 (\TEDIT.GET.FOREIGN.FILE 33953
|
||||
. 37138) (\TEDIT.GET.UNFORMATTED.FILE 37140 . 41014) (\TEDIT.GET.FORMATTED.FILE 41016 . 43837) (
|
||||
\TEDIT.FORMATTEDSTREAMP 43839 . 46739) (\ARBIN 46741 . 47461) (\ATMIN 47463 . 48000) (\DWIN 48002 .
|
||||
48381) (\STRINGIN 48383 . 49091) (\TEDIT.GET.TRAILER 49093 . 51609) (\TEDIT.CACHEFILE 51611 . 53138))
|
||||
(53306 66856 (\TEDIT.GET.PIECES3 53316 . 63618) (\TEDIT.GET.IDATE3 63620 . 65015) (
|
||||
\TEDIT.MAKE.STRINGPIECE 65017 . 66854)) (66857 79232 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66867 . 72983)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 72985 . 79230)) (79254 85276 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79264 .
|
||||
85274)) (85299 93924 (\TEDIT.GET.CHARLOOKS.LIST 85309 . 86040) (\TEDIT.GET.SINGLE.CHARLOOKS 86042 .
|
||||
90736) (\TEDIT.GET.CHARLOOKS 90738 . 92068) (\TEDIT.GET.PARALOOKS.INDEX 92070 . 92614) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 92616 . 93922)) (93925 101093 (\TEDIT.GET.PARALOOKS.LIST 93935 . 94557) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 94559 . 101091)) (101094 104684 (\TEDIT.GET.OBJECT 101104 . 104682)) (
|
||||
104746 136623 (\TEDIT.PUT.PCTB 104756 . 114406) (\TEDIT.PUT.PCTB.PIECEDATA 114408 . 117606) (
|
||||
\TEDIT.PUT.TRAILER 117608 . 118375) (\TEDIT.PUT.PCTB.MERGEABLE 118377 . 121811) (
|
||||
\TEDIT.PUT.UTF8.SPLITPIECES 121813 . 126515) (\TEDIT.PUT.PCTB.NEXTNEW 126517 . 130784) (
|
||||
\TEDIT.INSERT.NEWPIECES 130786 . 134221) (\TEDIT.PUTRESET 134223 . 134465) (\ARBOUT 134467 . 135191) (
|
||||
\ATMOUT 135193 . 135798) (\DWOUT 135800 . 136079) (\STRINGOUT 136081 . 136621)) (136624 148699 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 136634 . 138306) (\TEDIT.PUT.SINGLE.CHARLOOKS 138308 . 144043) (
|
||||
\TEDIT.PUT.CHARLOOKS 144045 . 145270) (\TEDIT.PUT.CHARLOOKS1 145272 . 146323) (\TEDIT.PUT.OBJECT
|
||||
146325 . 148697)) (148700 156194 (\TEDIT.PUT.PARALOOKS.LIST 148710 . 149612) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 149614 . 155053) (\TEDIT.PUT.PARALOOKS 155055 . 156192)) (156289 158883 (
|
||||
TEDITFROMLISPSOURCE 156299 . 158132) (SHELLSCRIPTP 158134 . 158363) (TEDITFROMSHELLSCRIPT 158365 .
|
||||
158881)))))
|
||||
(FILEMAP (NIL (5064 34612 (TEDIT.GET 5074 . 11194) (TEDIT.FORMATTEDFILEP 11196 . 12512) (
|
||||
TEDIT.FILEDATE 12514 . 13685) (TEDIT.INCLUDE 13687 . 21716) (TEDIT.RAW.INCLUDE 21718 . 22526) (
|
||||
TEDIT.PUT 22528 . 30777) (TEDIT.PUT.STREAM 30779 . 34610)) (34613 54492 (\TEDIT.GET.FOREIGN.FILE 34623
|
||||
. 38048) (\TEDIT.GET.UNFORMATTED.FILE 38050 . 42042) (\TEDIT.GET.FORMATTED.FILE 42044 . 45071) (
|
||||
\TEDIT.FORMATTEDSTREAMP 45073 . 48091) (\ARBIN 48093 . 48813) (\ATMIN 48815 . 49352) (\DWIN 49354 .
|
||||
49733) (\STRINGIN 49735 . 50443) (\TEDIT.GET.TRAILER 50445 . 52961) (\TEDIT.CACHEFILE 52963 . 54490))
|
||||
(54658 68412 (\TEDIT.GET.PIECES3 54668 . 65174) (\TEDIT.GET.IDATE3 65176 . 66571) (
|
||||
\TEDIT.MAKE.STRINGPIECE 66573 . 68410)) (68413 80788 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 68423 . 74539)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 74541 . 80786)) (80810 86832 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80820 .
|
||||
86830)) (86855 95480 (\TEDIT.GET.CHARLOOKS.LIST 86865 . 87596) (\TEDIT.GET.SINGLE.CHARLOOKS 87598 .
|
||||
92292) (\TEDIT.GET.CHARLOOKS 92294 . 93624) (\TEDIT.GET.PARALOOKS.INDEX 93626 . 94170) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 94172 . 95478)) (95481 103138 (\TEDIT.GET.PARALOOKS.LIST 95491 . 96113) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 96115 . 103136)) (103139 106729 (\TEDIT.GET.OBJECT 103149 . 106727)) (
|
||||
106791 138872 (\TEDIT.PUT.PCTB 106801 . 116451) (\TEDIT.PUT.PCTB.PIECEDATA 116453 . 119651) (
|
||||
\TEDIT.PUT.TRAILER 119653 . 120420) (\TEDIT.PUT.PCTB.MERGEABLE 120422 . 123856) (
|
||||
\TEDIT.PUT.UTF8.SPLITPIECES 123858 . 128560) (\TEDIT.PUT.PCTB.NEXTNEW 128562 . 133033) (
|
||||
\TEDIT.INSERT.NEWPIECES 133035 . 136470) (\TEDIT.PUTRESET 136472 . 136714) (\ARBOUT 136716 . 137440) (
|
||||
\ATMOUT 137442 . 138047) (\DWOUT 138049 . 138328) (\STRINGOUT 138330 . 138870)) (138873 150948 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 138883 . 140555) (\TEDIT.PUT.SINGLE.CHARLOOKS 140557 . 146292) (
|
||||
\TEDIT.PUT.CHARLOOKS 146294 . 147519) (\TEDIT.PUT.CHARLOOKS1 147521 . 148572) (\TEDIT.PUT.OBJECT
|
||||
148574 . 150946)) (150949 158588 (\TEDIT.PUT.PARALOOKS.LIST 150959 . 151861) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 151863 . 157447) (\TEDIT.PUT.PARALOOKS 157449 . 158586)) (158683 161695 (
|
||||
TEDITFROMLISPSOURCE 158693 . 160944) (SHELLSCRIPTP 160946 . 161175) (TEDITFROMSHELLSCRIPT 161177 .
|
||||
161693)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134 36434
|
||||
(FILECREATED "28-Mar-2025 14:07:00" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;155 43772
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
|
||||
:CHANGES-TO (FNS TEDIT.NEXT)
|
||||
|
||||
:PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
|
||||
:PREVIOUS-DATE "19-Mar-2025 11:25:45" {WMEDLEY}<library>tedit>TEDIT-FIND.;153)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FINDCOMS)
|
||||
@@ -14,12 +14,15 @@
|
||||
(RPAQQ TEDIT-FINDCOMS (
|
||||
(* ;; "User entries")
|
||||
|
||||
(FNS TEDIT.FIND TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE TEDIT.NEXT)
|
||||
(FNS TEDIT.FIND TEDIT.FIND.SETSEL TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE
|
||||
TEDIT.NEXT)
|
||||
(FNS TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD)
|
||||
|
||||
(* ;; "Implementation")
|
||||
|
||||
(FNS \TEDIT.WCFIND \TEDIT.BASICFIND \TEDIT.WCFIND.BACKWARD
|
||||
\TEDIT.BASICFIND.BACKWARD \TEDIT.PARSE.SEARCHSTRING)))
|
||||
(FNS \TEDIT.FIND \TEDIT.FIND.BACKWARD \TEDIT.WCFIND \TEDIT.BASICFIND
|
||||
\TEDIT.WCFIND.BACKWARD \TEDIT.BASICFIND.BACKWARD
|
||||
\TEDIT.PARSE.SEARCHSTRING)))
|
||||
|
||||
|
||||
|
||||
@@ -28,80 +31,50 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.FIND
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 10-May-2024 21:55 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:47 by rmk")
|
||||
(* ; "Edited 19-Jun-2023 22:27 by rmk")
|
||||
(* ; "Edited 6-May-2018 17:34 by rmk:")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 14-Mar-2025 23:39 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 12:33 by rmk")
|
||||
|
||||
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.")
|
||||
(* ;; "This is the documented user interface that does the silly thing with the return value--caller must know whether WILCARD? was true or not.")
|
||||
|
||||
(* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")
|
||||
(LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? AGAIN START END)))
|
||||
(CL:WHEN RESULT
|
||||
(CL:IF WILDCARDS?
|
||||
RESULT
|
||||
(CAR RESULT)))])
|
||||
|
||||
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")
|
||||
(TEDIT.FIND.SETSEL
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 11-Mar-2025 15:29 by rmk")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
(* ;; "Sets the selection to the result of a successful FIND.")
|
||||
|
||||
(* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING")
|
||||
|
||||
[if (IMAGEOBJP TARGET)
|
||||
then (TEDIT.FIND.OBJECT TSTREAM TARGET START END)
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (CL:UNLESS END
|
||||
(SETQ END (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND TSTREAM TARGET START END))))])])
|
||||
(LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? NIL START END)))
|
||||
(CL:WHEN RESULT
|
||||
(TEDIT.SETSEL TSTREAM (CAR RESULT)
|
||||
(CADR RESULT)
|
||||
'RIGHT)
|
||||
(TEDIT.NORMALIZECARET TSTREAM))])
|
||||
|
||||
(TEDIT.FIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 19-May-2024 12:07 by rmk")
|
||||
(* ; "Edited 10-May-2024 22:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:43 by rmk")
|
||||
(* ; "Edited 12-Jul-2023 08:24 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 12:12 by rmk")
|
||||
(* ; "Edited 18-Jun-2023 23:43 by rmk")
|
||||
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 11-Mar-2025 15:06 by rmk")
|
||||
(* ; "Edited 30-May-91 19:17 by jds")
|
||||
|
||||
(* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.")
|
||||
(* ;; "This is a new function that preserves the silly interface of TEDIT.FIND--caller must know whether WILCARD? was true or not.")
|
||||
|
||||
(* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
[if (IMAGEOBJP TARGET)
|
||||
then (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN)
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;;
|
||||
"Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET T)
|
||||
START END)
|
||||
(CAR (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END))))])])
|
||||
(LET ((RESULT (\TEDIT.FIND.BACKWARD TARGET WILDCARDS? AGAIN START END)))
|
||||
(CL:WHEN RESULT
|
||||
(CL:IF WILDCARDS?
|
||||
RESULT
|
||||
(CAR RESULT)))])
|
||||
|
||||
(TEDIT.SUBSTITUTE
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM? NEWCHARLOOKS)(* ; "Edited 19-Mar-2025 11:20 by rmk")
|
||||
(* ; "Edited 15-Mar-2025 00:23 by rmk")
|
||||
(* ; "Edited 6-Mar-2025 20:17 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:49 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 09:20 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 00:24 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:46 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:49 by rmk")
|
||||
(* ; "Edited 18-May-2024 23:03 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:36 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:11 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:09 by rmk")
|
||||
(* ; "Edited 6-Jan-2024 11:09 by rmk")
|
||||
@@ -118,16 +91,15 @@
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(NREPLACEMENTS 0)
|
||||
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
|
||||
ACTIONSTRING)
|
||||
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# CONFIRMFLG SEL REPLACE-LEN ACTIONSTRING
|
||||
CHARLOOKS)
|
||||
|
||||
(* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string. If the search pattern is empty, bail out.")
|
||||
|
||||
[CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
'
|
||||
TEDIT.LAST.SUBSTITUTE.STRING
|
||||
]
|
||||
(CL:UNLESS SEARCHSTRING
|
||||
[SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
'TEDIT.LAST.SUBSTITUTE.STRING])
|
||||
(CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ
|
||||
"Replace string:"
|
||||
(GETTEXTPROP TEXTOBJ
|
||||
@@ -137,16 +109,17 @@
|
||||
]
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
|
||||
(RETURN))
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Substitute")
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(if (type? SELPIECES REPLACEMENT)
|
||||
elseif (OR (STRINGP REPLACEMENT)
|
||||
(LITATOM REPLACEMENT))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
|
||||
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
|
||||
else (RETURN NIL))
|
||||
|
||||
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
|
||||
|
||||
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
|
||||
(SETQ REPLACE-LEN (GETSPC REPLACEMENT SPLEN))
|
||||
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
|
||||
"delet"
|
||||
"substitut"))
|
||||
@@ -163,8 +136,7 @@
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
|
||||
"ing...")
|
||||
T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SETQ SEL (FGETTOBJ TEXTOBJ SEL))
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(* ; "Turn off any blue pending delete")
|
||||
|
||||
@@ -174,58 +146,67 @@
|
||||
[SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH))
|
||||
(GETTOBJ TEXTOBJ TEXTLEN)
|
||||
(IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))]
|
||||
|
||||
(* ;;
|
||||
"NOTE: SEARCHSTRING may contain wild cards, so the hits may be of different lengths.")
|
||||
|
||||
[if CONFIRMFLG
|
||||
then
|
||||
(* ;; "In this case the selection moves along, ending up at the last hit.")
|
||||
|
||||
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ
|
||||
SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
(bind HIT (LASTSEL _ (\TEDIT.COPYSEL SEL))
|
||||
while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL STARTCHAR#
|
||||
ENDCHAR#))
|
||||
do (* ;
|
||||
"Show each substitution site and ask for permission")
|
||||
(SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE)))
|
||||
'RIGHT T))
|
||||
(\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
|
||||
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR HIT)
|
||||
(CADR HIT)
|
||||
'RIGHT
|
||||
'PENDINGDEL)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ SEL)
|
||||
[SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
|
||||
"OK to replace? ['q' quits]" "Yes")
|
||||
1))
|
||||
(Q (RETURN))
|
||||
(Q (GO $$OUT))
|
||||
(Y (* ; "Do this one")
|
||||
(CL:UNLESS NEWCHARLOOKS
|
||||
(SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
|
||||
TEXTOBJ))))
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ)
|
||||
TEXTOBJ PENDING.SEL)
|
||||
TEXTOBJ SEL)
|
||||
(\TEDIT.COPYSEL SEL LASTSEL)
|
||||
(* ; "This may be where we end up")
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(* ; "Next start, compensate for end")
|
||||
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN
|
||||
(ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE])
|
||||
(add ENDCHAR# (IDIFFERENCE REPLACE-LEN (CADR HIT))))
|
||||
(PROGN
|
||||
(* ;;
|
||||
"Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
|
||||
|
||||
(\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SETQ STARTCHAR# (ADD1 (CAR HIT]
|
||||
finally (\TEDIT.COPYSEL LASTSEL SEL))
|
||||
else
|
||||
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
|
||||
|
||||
(bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
|
||||
(SAVESEL _ (\TEDIT.COPYSEL SEL))
|
||||
EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR#
|
||||
ENDCHAR# T))
|
||||
(bind FIRSTHIT HIT HITLAST HITDIFF CHARLOOKS (TOTALDIFF _ 0)
|
||||
EVENTS while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL
|
||||
STARTCHAR# ENDCHAR#))
|
||||
do (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
|
||||
(SETQ FIRSTHIT (CAR RANGE)))
|
||||
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
|
||||
(CAR RANGE]
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
|
||||
HITLEN
|
||||
(SETQ FIRSTHIT (CAR HIT)))
|
||||
(CL:UNLESS NEWCHARLOOKS
|
||||
(SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
|
||||
TEXTOBJ))))
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR HIT)
|
||||
(CADR HIT)
|
||||
'RIGHT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
|
||||
'COPY TEXTOBJ)
|
||||
'COPY TEXTOBJ NIL CHARLOOKS)
|
||||
TEXTOBJ SEL)
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(* ;
|
||||
@@ -233,16 +214,16 @@
|
||||
(add NREPLACEMENTS 1)
|
||||
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
|
||||
(SETQ HITLAST STARTCHAR#)
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
|
||||
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN (CADR HIT)))
|
||||
(add ENDCHAR# HITDIFF)
|
||||
(add TOTALDIFF HITDIFF)
|
||||
finally (CL:UNLESS (EQ NREPLACEMENTS 0)
|
||||
|
||||
(* ;;
|
||||
"At least one replacement, update the lines that have changed.")
|
||||
(* ;; "At least one replacement, update the lines that have changed. We have to calculate how many of the original characters have %"changed%" by adding the TOTALDIFF to the final position of the last character of the last hit. ")
|
||||
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
|
||||
(IDIFFERENCE (GETSEL SEL CHLIM)
|
||||
(IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM)
|
||||
TOTALDIFF)
|
||||
FIRSTHIT))
|
||||
|
||||
(* ;; "Not clear what the final selection should be, if there are multiple changes. The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)? Or just the selection of the last substitution?")
|
||||
@@ -251,6 +232,7 @@
|
||||
(\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
|
||||
)
|
||||
'RIGHT)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))]
|
||||
|
||||
(* ;; "Save the search & replacement strings to offer for next time:")
|
||||
@@ -269,7 +251,12 @@
|
||||
(RETURN NREPLACEMENTS))))])
|
||||
|
||||
(TEDIT.NEXT
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:40 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Mar-2025 14:06 by rmk")
|
||||
(* ; "Edited 14-Mar-2025 23:14 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 15:35 by rmk")
|
||||
(* ; "Edited 9-Mar-2025 11:31 by rmk")
|
||||
(* ; "Edited 15-Feb-2025 18:08 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:40 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:47 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:10 by rmk")
|
||||
@@ -278,57 +265,109 @@
|
||||
(* ; "Edited 14-Dec-2023 21:20 by rmk")
|
||||
(* ; "Edited 20-Jun-2023 00:05 by rmk")
|
||||
(* ; "Edited 3-May-2023 23:47 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:46 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:46 by rmk ")
|
||||
(* ; "Edited 30-May-91 20:57 by jds")
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
TARGET SEL OPTION FIELDSEL)
|
||||
(SETQ SEL (TEXTSEL TEXTOBJ))
|
||||
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))(* ;
|
||||
"find the first >>delimited<< field")
|
||||
(SETQ FIELDSEL (TEDIT.FIND TEXTOBJ "{*}" NIL NIL T))(* ;
|
||||
"find the first menu-type insertion field, usually delimited with {}")
|
||||
[SETQ OPTION (COND
|
||||
[(AND TARGET FIELDSEL) (* ; "take the first one")
|
||||
(COND
|
||||
((IGREATERP (CAR TARGET)
|
||||
(GETSEL FIELDSEL CH#)) (* ; "use the {} selection")
|
||||
'FIELD)
|
||||
(T 'TARGET]
|
||||
(TARGET 'TARGET)
|
||||
(FIELDSEL 'FIELD)
|
||||
(T 'NEITHER]
|
||||
(SELECTQ OPTION
|
||||
(TARGET (* ; "Found another fill-in")
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
|
||||
(* ;
|
||||
"Original comment: %"never pending a deletion%", but it is!")
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
|
||||
"Set up SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR TARGET)
|
||||
(IDIFFERENCE (ADD1 (CADR TARGET))
|
||||
(CAR TARGET))
|
||||
'RIGHT
|
||||
'PENDINGDEL)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally")
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window")
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
|
||||
(FIELD (* ;
|
||||
"Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")
|
||||
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
|
||||
"Set SELECTION to be the found text")
|
||||
(\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
|
||||
(GETSEL FIELDSEL DCH)
|
||||
'LEFT
|
||||
'PENDINGDEL) (* ; "And get it into the window")
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ))
|
||||
(NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
|
||||
(SETQ SEL NIL))
|
||||
(\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT"))
|
||||
(CL:WHEN SEL (* ;
|
||||
"There really IS a selection made here, so set up the charlooks for it properly.")
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))])
|
||||
|
||||
(* ;; "Finds/selects the next >>*<< or {*} or menu field after the current selection")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
CH CHNO DCH)
|
||||
|
||||
(* ;; "One pass, search in parallel")
|
||||
|
||||
(if [for old CHNO HIT from (FGETSEL SEL CHLIM) while (SETQ CH (\TEDIT.NTHCHARCODE TSTREAM
|
||||
CHNO))
|
||||
do (SELCHARQ CH
|
||||
(> (CL:WHEN (SETQ HIT (\TEDIT.FIND TEXTOBJ ">>*<<" T NIL CHNO))
|
||||
(SETQ CHNO (CAR HIT))
|
||||
(SETQ DCH (CADR HIT))
|
||||
(RETURN T)))
|
||||
({ (CL:WHEN (SETQ HIT (\TEDIT.FIND TEXTOBJ "{*}" T NIL CHNO))
|
||||
(SETQ CHNO (CAR HIT)) (* ; "Shouldn't include the { and }")
|
||||
(SETQ DCH (IDIFFERENCE (CADR HIT)
|
||||
2))
|
||||
(CL:UNLESS (EQ 0 DCH) (* ;
|
||||
"Right of {, if empty. to put it inside")
|
||||
(add CHNO 1))
|
||||
(RETURN T)))
|
||||
(CL:WHEN (AND (IMAGEOBJP CH)
|
||||
(IMAGEOBJPROP CH 'FIELDPREFIX))
|
||||
(* ; "Menu fields")
|
||||
(add CHNO 1)
|
||||
(RETURN (for ENDCHNO FCH from CHNO while (SETQ FCH (\TEDIT.NTHCHARCODE
|
||||
TSTREAM ENDCHNO))
|
||||
when (AND (IMAGEOBJP FCH)
|
||||
(IMAGEOBJPROP FCH 'FIELDSUFFIX))
|
||||
do (SETQ DCH (IDIFFERENCE ENDCHNO CHNO))
|
||||
(CL:WHEN (EQ 0 DCH)
|
||||
(* ; "RIGHT of prefix, if empty")
|
||||
(add CHNO -1))
|
||||
(RETURN T))))]
|
||||
then
|
||||
(* ;; "CHNO is the beginning of the located blank, DCH is its length")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL CHNO DCH 'RIGHT 'PENDINGDEL)
|
||||
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
else (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in" T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.FIND.OBJECT
|
||||
[LAMBDA (TSTREAM OBJ START END) (* ; "Edited 20-Oct-2024 12:07 by rmk")
|
||||
(* ; "Edited 10-May-2024 21:58 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 6-Nov-2022 11:12 by rmk")
|
||||
(* ; "Edited 3-May-93 12:52 by jds")
|
||||
|
||||
(* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END. We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN (IMAGEOBJP OBJ)
|
||||
[LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
|
||||
(CL:UNLESS END
|
||||
(SETQ END (FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN (AND (ILEQ START END)
|
||||
(SETQ START (\TEDIT.CHTOPC START TEXTOBJ)))
|
||||
(SETQ END (\TEDIT.CHTOPC END TEXTOBJ))
|
||||
(for PC inpieces START when (EQ OBJ (PCONTENTS PC))
|
||||
do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC END)))])])
|
||||
|
||||
(TEDIT.FIND.OBJECT.BACKWARD
|
||||
[LAMBDA (TSTREAM OBJ START END AGAIN) (* ; "Edited 10-May-2024 22:06 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 6-Nov-2022 11:12 by rmk")
|
||||
(* ; "Edited 3-May-93 12:52 by jds")
|
||||
|
||||
(* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END and is the occurrence closest to END. START defaults to 1, END defaults to current caret position (or one before, if AGAIN).")
|
||||
|
||||
(* ;; "If we were sure that a given object can appear only once in a document, we could just run the TEDIT.FIND.OBJECT with different defaults for START and END, but...")
|
||||
|
||||
(* ;; "We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN (IMAGEOBJP OBJ)
|
||||
[LET [(TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM]
|
||||
(SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;; "Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(SETQ START (\TEDIT.CHTOPC START TEXTOBJ))
|
||||
(SETQ END (\TEDIT.CHTOPC END TEXTOBJ))
|
||||
(for PC backpieces END when (EQ OBJ (PCONTENTS PC))
|
||||
do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC START)))])])
|
||||
)
|
||||
|
||||
|
||||
@@ -337,6 +376,95 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.FIND
|
||||
[LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END) (* ; "Edited 14-Mar-2025 18:42 by rmk")
|
||||
(* ; "Edited 11-Mar-2025 15:04 by rmk")
|
||||
(* ; "Edited 10-May-2024 21:55 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 23:47 by rmk")
|
||||
(* ; "Edited 19-Jun-2023 22:27 by rmk")
|
||||
(* ; "Edited 6-May-2018 17:34 by rmk:")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "This returns the hit's (CH# DCL) or NIL.")
|
||||
|
||||
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.")
|
||||
|
||||
(* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,")
|
||||
|
||||
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
|
||||
(* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING")
|
||||
|
||||
(CL:UNLESS END
|
||||
(SETQ END (TEXTLEN (GETTSTR TSTREAM TEXTOBJ))))
|
||||
(CL:UNLESS START
|
||||
(SETQ START (TEDIT.GETPOINT TSTREAM)))
|
||||
(CL:WHEN AGAIN (* ;
|
||||
"We aren't interested in the same hit")
|
||||
(add START 1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
[LET (RESULT)
|
||||
(if (IMAGEOBJP TARGET)
|
||||
then (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT TSTREAM TARGET START END))
|
||||
(LIST RESULT 1))
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (CL:WHEN (SETQ RESULT (CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING
|
||||
TARGET NIL)
|
||||
START END)
|
||||
(\TEDIT.BASICFIND TSTREAM TARGET START END)))
|
||||
|
||||
(* ;; "Switch from CHLAST to DCH")
|
||||
|
||||
[LIST (CAR RESULT)
|
||||
(ADD1 (IDIFFERENCE (CADR RESULT)
|
||||
(CAR RESULT])]))])
|
||||
|
||||
(\TEDIT.FIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END) (* ; "Edited 11-Mar-2025 15:07 by rmk")
|
||||
|
||||
(* ;; "This returns the hit's (CH# DCL) or NIL.")
|
||||
|
||||
(* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.")
|
||||
|
||||
(* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:WHEN TARGET
|
||||
[LET (RESULT)
|
||||
(if (IMAGEOBJP TARGET)
|
||||
then (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END
|
||||
AGAIN))
|
||||
(LIST RESULT 1))
|
||||
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
|
||||
then (SETQ START (IMAX 1 (OR START 1)))
|
||||
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
|
||||
(FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
TEXTLEN)))
|
||||
(CL:WHEN AGAIN
|
||||
|
||||
(* ;;
|
||||
"Assume that we aren't interested in another match at the current position.")
|
||||
|
||||
(ADD END -1))
|
||||
(CL:WHEN (ILEQ START END)
|
||||
(CL:WHEN (SETQ RESULT (CL:IF WILDCARDS?
|
||||
(\TEDIT.WCFIND.BACKWARD TSTREAM (
|
||||
\TEDIT.PARSE.SEARCHSTRING
|
||||
TARGET T)
|
||||
START END)
|
||||
(\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START
|
||||
END)))
|
||||
|
||||
(* ;; "Switch from CHLAST to DCH")
|
||||
|
||||
[LIST (CAR RESULT)
|
||||
(ADD1 (IDIFFERENCE (CADR RESULT)
|
||||
(CAR RESULT]))])])
|
||||
|
||||
(\TEDIT.WCFIND
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:04 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:00 by rmk")
|
||||
@@ -391,7 +519,8 @@
|
||||
then (RETURN NIL])])
|
||||
|
||||
(\TEDIT.BASICFIND
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 12:03 by rmk")
|
||||
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Feb-2025 12:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2024 12:03 by rmk")
|
||||
(* ; "Edited 22-Jun-2024 12:01 by rmk")
|
||||
(* ; "Edited 19-May-2024 23:18 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
@@ -421,7 +550,9 @@
|
||||
(BIN TSTREAM))
|
||||
(RETURN NIL))
|
||||
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
|
||||
(RETURN T))) do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
(RETURN T))) do (FSETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
LASTARROWX NIL)
|
||||
(RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
|
||||
|
||||
(\TEDIT.WCFIND.BACKWARD
|
||||
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:05 by rmk")
|
||||
@@ -557,8 +688,10 @@
|
||||
(DREVERSE $$VAL))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (784 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE
|
||||
5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND
|
||||
25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 33332 . 36409)))))
|
||||
(FILEMAP (NIL (961 20132 (TEDIT.FIND 971 . 1555) (TEDIT.FIND.SETSEL 1557 . 2022) (TEDIT.FIND.BACKWARD
|
||||
2024 . 2603) (TEDIT.SUBSTITUTE 2605 . 15424) (TEDIT.NEXT 15426 . 20130)) (20133 23562 (
|
||||
TEDIT.FIND.OBJECT 20143 . 21643) (TEDIT.FIND.OBJECT.BACKWARD 21645 . 23560)) (23595 43749 (\TEDIT.FIND
|
||||
23605 . 26541) (\TEDIT.FIND.BACKWARD 26543 . 29061) (\TEDIT.WCFIND 29063 . 32582) (\TEDIT.BASICFIND
|
||||
32584 . 34943) (\TEDIT.WCFIND.BACKWARD 34945 . 38409) (\TEDIT.BASICFIND.BACKWARD 38411 . 40668) (
|
||||
\TEDIT.PARSE.SEARCHSTRING 40670 . 43747)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164 32996
|
||||
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170 33842
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
\TEDIT.HCPYFMTSPEC)
|
||||
|
||||
:PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -133,7 +134,9 @@
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
|
||||
|
||||
(\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 13-Dec-2024 23:49 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:39 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:49 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 17:13 by rmk")
|
||||
(* ; "Edited 19-Apr-2024 09:09 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
@@ -267,16 +270,18 @@
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE
|
||||
LOOKSTARTX TX (FGETLD LINE YBASE)
|
||||
CLOOKS PRSTREAM))
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED)
|
||||
of (FGETLD LINE LFMTSPEC))
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED)
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ
|
||||
(FGETLD LINE LFMTSPEC)
|
||||
(FGETLD LINE LPARALOOKS)
|
||||
PRSTREAM LINE))])])
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 11:04 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 17:22 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:19 by rmk")
|
||||
@@ -284,20 +289,20 @@
|
||||
|
||||
(* ;; "Return setup LINE to skip a sequence of heading pieces STATE")
|
||||
|
||||
(SELECTQ (GETPARA FMTSPEC FMTPARATYPE)
|
||||
(SELECTQ (GETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
(PAGEHEADING
|
||||
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
|
||||
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM
|
||||
FORMATTINGSTATE)
|
||||
T)
|
||||
(EVEN (* ; "Skip an odd page.")
|
||||
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
T))
|
||||
(ODD (* ; "Skip an even page")
|
||||
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
@@ -343,7 +348,9 @@
|
||||
(MOVETO CURX CURY PRSTREAM])
|
||||
|
||||
(\TEDIT.HCPYFMTSPEC
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:36 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 21:03 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 15:14 by rmk")
|
||||
@@ -351,33 +358,34 @@
|
||||
(* ; "Edited 29-Sep-2022 23:32 by rmk")
|
||||
(* ; "Edited 30-May-91 21:18 by jds")
|
||||
|
||||
(* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
(* ;; "Given a display-type PARALOOKS, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
|
||||
(LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
|
||||
(create FMTSPEC using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPARA DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
(create PARALOOKS using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPLOOKS DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT FMTDEFAULTTAB
|
||||
))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPLOOKS DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
|
||||
(\TEDIT.INTEGER.IMAGEBOX
|
||||
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
|
||||
@@ -555,11 +563,11 @@
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE
|
||||
5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 .
|
||||
19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 (
|
||||
\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) (
|
||||
\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY
|
||||
30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971)))))
|
||||
(FILEMAP (NIL (3554 27051 (TEDIT.HARDCOPY 3564 . 4697) (\TEDIT.PRINT.MENU 4699 . 5665) (TEDIT.HCPYFILE
|
||||
5667 . 7841) (\TEDIT.HARDCOPY.DISPLAYLINE 7843 . 17953) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17955 .
|
||||
19684) (\TEDIT.HARDCOPY.MODIFYLOOKS 19686 . 21920) (\TEDIT.HCPYFMTSPEC 21922 . 25380) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 25382 . 26053) (\TEDIT.DISPLAY.DIACRITIC 26055 . 27049)) (27126 27956 (
|
||||
\TEDIT.SCALEREGION 27136 . 27954)) (28215 31755 (TEDIT.HARDCOPYFN 28225 . 29530) (
|
||||
\TEDIT.HARDCOPYFILEFN 29532 . 30093) (\TEDIT.POSTSCRIPT.HARDCOPY 30095 . 31026) (\TEDIT.PRESS.HARDCOPY
|
||||
31028 . 31753)) (33018 33819 (TEDIT-BOOK 33028 . 33817)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Feb-2025 11:32:56" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;220 52908
|
||||
(FILECREATED "28-Mar-2025 14:23:18" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;227 53951
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.REDO)
|
||||
:CHANGES-TO (FNS \TEDIT.UNDO.REPLACECODE \TEDIT.UNDO1)
|
||||
|
||||
:PREVIOUS-DATE " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219)
|
||||
:PREVIOUS-DATE "16-Mar-2025 18:50:43" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;225)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
||||
@@ -225,10 +225,12 @@
|
||||
EVENT])
|
||||
|
||||
(\TEDIT.HISTORYADD.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 6-Feb-2025 15:31 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:47 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 08:02 by rmk")
|
||||
(* ; "Edited 8-May-2024 12:34 by rmk")
|
||||
(SETQ EVENTS (REMOVE NIL EVENTS))
|
||||
(CL:WHEN EVENTS
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL
|
||||
@@ -324,7 +326,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.UNDO
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 13-Mar-2025 15:47 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:17 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 10:49 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 21:21 by rmk")
|
||||
@@ -370,6 +373,7 @@
|
||||
|
||||
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
|
||||
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UNDO1 TSTREAM EVENT)
|
||||
@@ -392,7 +396,9 @@
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO1
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 28-Mar-2025 14:22 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 18:46 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 13:51 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 21:41 by rmk")
|
||||
(* ; "Edited 19-Aug-2024 00:11 by rmk")
|
||||
@@ -421,12 +427,12 @@
|
||||
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
(\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT))
|
||||
((LIST :Replace :LowerCase :UpperCase)
|
||||
((LIST :Replace :Transform)
|
||||
|
||||
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
|
||||
(* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TSTREAM EVENT))
|
||||
(:Closefile (* ; "Closes an included file")
|
||||
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
|
||||
(CLOSEF? (GETTH EVENT THOLDINFO))))
|
||||
@@ -452,7 +458,8 @@
|
||||
T])
|
||||
|
||||
(TEDIT.REDO
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 2-Feb-2025 11:28 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2025 18:48 by rmk")
|
||||
(* ; "Edited 2-Feb-2025 11:28 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 17:53 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 23:11 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 16:49 by rmk")
|
||||
@@ -495,10 +502,12 @@
|
||||
(:Replace (* ;
|
||||
"It was a replacement (a del/insert combo)")
|
||||
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:Transform (\TEDIT.KEY.TRANSFORM TSTREAM (GETTH EVENT THOLDINFO)))
|
||||
(:LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(\TEDIT.LCASE.SEL TSTREAM TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(\TEDIT.UCASE.SEL TSTREAM TEXTOBJ SEL))
|
||||
(:InitialCap (\TEDIT.KEY.INITIALCAP TSTREAM TEXTOBJ SEL))
|
||||
(:CharLooks (* ; "It was a character looks change")
|
||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
@@ -633,14 +642,15 @@
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2025 22:35 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:10 by rmk")
|
||||
(* ; "Edited 27-May-2023 16:49 by rmk")
|
||||
(* ; "Edited 24-May-2023 22:43 by rmk")
|
||||
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.")
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, uppercase, or initialcap.")
|
||||
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
NIL TEXTOBJ)
|
||||
@@ -796,8 +806,9 @@
|
||||
(\TEDIT.SCROLL.CARET TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACECODE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 23-Sep-2024 00:45 by rmk")
|
||||
(TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 28-Mar-2025 14:22 by rmk")
|
||||
(* ; "Edited 23-Sep-2024 00:45 by rmk")
|
||||
(\TEDIT.RPLCHARCODE TSTREAM (GETTH EVENT THCH#)
|
||||
(GETTH EVENT THOLDINFO])
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -837,14 +848,14 @@
|
||||
(\TEDIT.THELP 'Redo-composite])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4896 5917 (\TEDIT.HISTORYEVENT.DEFPRINT 4906 . 5915)) (7007 17445 (\TEDIT.HISTORYADD
|
||||
7017 . 11878) (\TEDIT.HISTORYADD.COMPOSITE 11880 . 12639) (\TEDIT.CUMULATE.EVENTS 12641 . 14235) (
|
||||
\TEDIT.COMPOSITE.EVENT 14237 . 14973) (\TEDIT.HISTORY.PROP 14975 . 16338) (\TEDIT.HISTORY.EVENT 16340
|
||||
. 17269) (\TEDIT.POPEVENT 17271 . 17443)) (17498 35437 (TEDIT.UNDO 17508 . 21902) (\TEDIT.UNDO1 21904
|
||||
. 26116) (TEDIT.REDO 26118 . 32591) (\TEDIT.UNDO.UNDO 32593 . 35435)) (35438 50524 (
|
||||
\TEDIT.UNDO.INSERT 35448 . 36361) (\TEDIT.UNDO.DELETE 36363 . 37157) (\TEDIT.UNDO.MOVE 37159 . 38748)
|
||||
(\TEDIT.UNDO.REPLACE 38750 . 39846) (\TEDIT.UNDO.CHARLOOKS 39848 . 44422) (\TEDIT.UNDO.PARALOOKS 44424
|
||||
. 48656) (\TEDIT.UNDO.PAGELOOKS 48658 . 49067) (\TEDIT.UNDO.COMPOSITE 49069 . 50296) (
|
||||
\TEDIT.UNDO.REPLACECODE 50298 . 50522)) (50525 52885 (\TEDIT.REDO.INSERT 50535 . 51268) (
|
||||
\TEDIT.REDO.REPLACE 51270 . 52601) (\TEDIT.REDO.COMPOSITE 52603 . 52883)))))
|
||||
(FILEMAP (NIL (4922 5943 (\TEDIT.HISTORYEVENT.DEFPRINT 4932 . 5941)) (7033 17618 (\TEDIT.HISTORYADD
|
||||
7043 . 11904) (\TEDIT.HISTORYADD.COMPOSITE 11906 . 12812) (\TEDIT.CUMULATE.EVENTS 12814 . 14408) (
|
||||
\TEDIT.COMPOSITE.EVENT 14410 . 15146) (\TEDIT.HISTORY.PROP 15148 . 16511) (\TEDIT.HISTORY.EVENT 16513
|
||||
. 17442) (\TEDIT.POPEVENT 17444 . 17616)) (17671 36249 (TEDIT.UNDO 17681 . 22240) (\TEDIT.UNDO1 22242
|
||||
. 26663) (TEDIT.REDO 26665 . 33403) (\TEDIT.UNDO.UNDO 33405 . 36247)) (36250 51567 (
|
||||
\TEDIT.UNDO.INSERT 36260 . 37173) (\TEDIT.UNDO.DELETE 37175 . 37969) (\TEDIT.UNDO.MOVE 37971 . 39560)
|
||||
(\TEDIT.UNDO.REPLACE 39562 . 40779) (\TEDIT.UNDO.CHARLOOKS 40781 . 45355) (\TEDIT.UNDO.PARALOOKS 45357
|
||||
. 49589) (\TEDIT.UNDO.PAGELOOKS 49591 . 50000) (\TEDIT.UNDO.COMPOSITE 50002 . 51229) (
|
||||
\TEDIT.UNDO.REPLACECODE 51231 . 51565)) (51568 53928 (\TEDIT.REDO.INSERT 51578 . 52311) (
|
||||
\TEDIT.REDO.REPLACE 52313 . 53644) (\TEDIT.REDO.COMPOSITE 53646 . 53926)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2025 08:55:22" {WMEDLEY}<library>tedit>TEDIT-MENU.;450 160064
|
||||
(FILECREATED "23-Mar-2025 14:56:57" {WMEDLEY}<library>tedit>TEDIT-MENU.;464 162009
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.PAGEMENU.CREATE \TEDIT.CHARMENU.SPEC)
|
||||
:CHANGES-TO (FNS \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.FILLIN)
|
||||
|
||||
:PREVIOUS-DATE "12-Jan-2025 13:12:23" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;448)
|
||||
:PREVIOUS-DATE "19-Mar-2025 10:01:40" {WMEDLEY}<library>tedit>TEDIT-MENU.;461)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
||||
@@ -31,12 +31,12 @@
|
||||
MB.MARGINBAR.SELFN.TABS MB.MARGINBAR.SELFN.TABS.KIND MARGINBAR.GETSTATEFN
|
||||
MARGINBAR.SETSTATEFN MARGINBAR.NEUTRALIZE MARGINBAR.LOOKS MB.MARGINBAR.SIZEFN
|
||||
MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK
|
||||
MARGINBAR.INIT \TEDIT.FMTSPECTOMARBAR)
|
||||
MARGINBAR.INIT \TEDIT.PARALOOKS.TO.MARBAR)
|
||||
(BITMAPS \TEDIT.LEFTTAB \TEDIT.CENTERTAB \TEDIT.RIGHTTAB \TEDIT.DECIMALTAB
|
||||
\TEDIT.DOTTED.LEFTTAB \TEDIT.DOTTED.CENTERTAB \TEDIT.DOTTED.RIGHTTAB
|
||||
\TEDIT.DOTTED.DECIMALTAB TEDIT.EXTENDEDRIGHTMARK)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT]
|
||||
(COMS (FNS \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN)
|
||||
(COMS (FNS TEDIT.MENUSTREAM TEDITMENUP \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN)
|
||||
(BITMAPS TEXTMENUICON TEXTMENUICONMASK))
|
||||
(* ; "Generic support for Tedit menus")
|
||||
(FNS \TEDIT.MENU.CREATE \TEDIT.MENU.PARSE \TEDIT.MENU.NEUTRALIZE
|
||||
@@ -49,7 +49,7 @@
|
||||
|
||||
(* ; "EXPANDEDMENU")
|
||||
(FNS \TEDIT.EXPANDEDMENU.CREATE \TEDIT.EXPANDEDMENU.START \TEDIT.EXPANDEDMENU.FN
|
||||
\TEDIT.EXPANDEDMENU.ACTIONFN TEDIT.MENUSTREAM)
|
||||
\TEDIT.EXPANDEDMENU.ACTIONFN)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -66,7 +66,8 @@
|
||||
(* ;; "")
|
||||
|
||||
(* ; "CHARMENU")
|
||||
[INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT]
|
||||
[INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT))
|
||||
(TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha]
|
||||
(FNS \TEDIT.CHARMENU.CREATE \TEDIT.CHARMENU.START \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.PARSE
|
||||
\TEDIT.CHARMENU.FILLIN \TEDIT.SHOW.CHARLOOKS \TEDIT.APPLY.CHARLOOKS
|
||||
\TEDIT.OFFSETTYPE.STATEFN \TEDIT.OTHER.STATECHANGEFN \TEDIT.OTHER.SELECTFN)
|
||||
@@ -892,22 +893,24 @@
|
||||
'NILL
|
||||
'MarginRuler])
|
||||
|
||||
(\TEDIT.FMTSPECTOMARBAR
|
||||
[LAMBDA (FMTSPEC UNIT) (* ; "Edited 4-Aug-2024 22:50 by rmk")
|
||||
(\TEDIT.PARALOOKS.TO.MARBAR
|
||||
[LAMBDA (PARALOOKS UNIT) (* ; "Edited 19-Feb-2025 13:25 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:08 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 22:50 by rmk")
|
||||
|
||||
(* ;; "Creates a margin bar reflecting the properties of FMTSPEC, for PARAMENU display. Assumes that UNIT is the conversion factor (presumably PTSPERPICA) that takes FMTSPEC screen-point numbers into MARGINBAR numbers. No rounding.")
|
||||
(* ;; "Creates a margin bar reflecting the properties of PARALOOKS, for PARAMENU display. Assumes that UNIT is the conversion factor (presumably PTSPERPICA) that takes PARALOOKS screen-point numbers into MARGINBAR numbers. No rounding.")
|
||||
|
||||
(* ;; "Hardcopy scaling isn't relevant for menus.")
|
||||
|
||||
(create MARGINBAR
|
||||
MARL1 _ (FQUOTIENT (FGETPARA FMTSPEC 1STLEFTMAR)
|
||||
MARL1 _ (FQUOTIENT (FGETPLOOKS PARALOOKS 1STLEFTMAR)
|
||||
UNIT)
|
||||
MARLN _ (FQUOTIENT (FGETPARA FMTSPEC LEFTMAR)
|
||||
MARLN _ (FQUOTIENT (FGETPLOOKS PARALOOKS LEFTMAR)
|
||||
UNIT)
|
||||
MARR _ (FQUOTIENT (FGETPARA FMTSPEC RIGHTMAR)
|
||||
MARR _ (FQUOTIENT (FGETPLOOKS PARALOOKS RIGHTMAR)
|
||||
UNIT)
|
||||
MARUNIT _ UNIT
|
||||
MARTABS _ (for TAB in (FGETPARA FMTSPEC FMTTABS)
|
||||
MARTABS _ (for TAB in (FGETPLOOKS PARALOOKS FMTTABS)
|
||||
collect (create TAB using TAB TABX _ (QUOTIENT (fetch (TAB TABX) of TAB)
|
||||
UNIT])
|
||||
)
|
||||
@@ -936,8 +939,40 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.MENUSTREAM
|
||||
[LAMBDA (TSTREAM TITLE) (* ; "Edited 14-Mar-2025 16:14 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 15:29 by rmk")
|
||||
(* ; "Edited 28-Aug-2024 15:48 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 09:53 by rmk")
|
||||
(* jds "13-Aug-84 14:10")
|
||||
|
||||
(* ;; "returns the textstream of the teditmenu attached to this stream if any, or TSTREAM if it is that teditmenu")
|
||||
|
||||
(CL:UNLESS TITLE (SETQ TITLE "TEdit Menu"))
|
||||
(for W MTSTREAM in (CONS (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
(ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)))
|
||||
when (AND (STRING.EQUAL TITLE (WINDOWPROP W 'TITLE))
|
||||
(SETQ MTSTREAM (TEXTSTREAM W T))) do (RETURN MTSTREAM])
|
||||
|
||||
(TEDITMENUP
|
||||
[LAMBDA (TSTREAM TITLE) (* ; "Edited 14-Mar-2025 16:31 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 15:39 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:06 by rmk")
|
||||
(* ; "Edited 20-Sep-2023 22:36 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 10:14 by rmk")
|
||||
(CL:WHEN (AND (SETQ TSTREAM (TEXTSTREAM TSTREAM T))
|
||||
(GETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
MENUFLG)
|
||||
(\TEDIT.PRIMARYPANE TSTREAM)
|
||||
(CL:IF TITLE
|
||||
(STRING.EQUAL TITLE (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
'TITLE))
|
||||
T))
|
||||
TSTREAM])
|
||||
|
||||
(\TEDIT.MENU.START
|
||||
[LAMBDA (MENUSTREAM MAINWINDOW TITLE HEIGHT TYPE) (* ; "Edited 28-Jun-2024 23:08 by rmk")
|
||||
[LAMBDA (MENUSTREAM TSTREAM TITLE HEIGHT TYPE) (* ; "Edited 14-Mar-2025 16:13 by rmk")
|
||||
(* ; "Edited 28-Jun-2024 23:08 by rmk")
|
||||
(* ; "Edited 19-Apr-2024 10:53 by rmk")
|
||||
(* ; "Edited 10-Apr-2024 23:04 by rmk")
|
||||
(* ; "Edited 27-Feb-2024 08:12 by rmk")
|
||||
@@ -958,28 +993,18 @@
|
||||
|
||||
(* ;; "Pretext: menu windows can't have menu windows.")
|
||||
|
||||
(* ;; "Typically this is called from a menu under the main window running in the mouse process. When we're done, we want to return to the main window's editing process, not to the process we are called in.")
|
||||
|
||||
(CL:UNLESS [AND MAINWINDOW (OR (TEDITMENUP MAINWINDOW)
|
||||
(for WW in (ATTACHEDWINDOWS MAINWINDOW)
|
||||
thereis (STREQUAL (OR TITLE "TEdit Menu")
|
||||
(WINDOWPROP WW 'TEDITMENU]
|
||||
(LET ((WREG (CL:IF MAINWINDOW
|
||||
(WINDOWPROP MAINWINDOW 'REGION)
|
||||
(GETREGION)))
|
||||
(MENUTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM))
|
||||
MENUW)
|
||||
(SETQ MENUW (CREATEW (SETQ WREG (COND
|
||||
(MAINWINDOW (create REGION
|
||||
LEFT _ (fetch (REGION LEFT)
|
||||
of WREG)
|
||||
BOTTOM _ (fetch (REGION TOP)
|
||||
of WREG)
|
||||
WIDTH _ (fetch (REGION WIDTH)
|
||||
of WREG)
|
||||
HEIGHT _ (OR HEIGHT 133)))
|
||||
(T WREG)))
|
||||
(OR TITLE "TEdit Menu")))
|
||||
(CL:UNLESS TITLE (SETQ TITLE "TEdit Menu"))
|
||||
(CL:UNLESS (TEDIT.MENUSTREAM TSTREAM TITLE)
|
||||
(LET ((MAINWINDOW (\TEDIT.PRIMARYPANE TSTREAM))
|
||||
(MENUTEXTOBJ (GETTSTR MENUSTREAM TEXTOBJ))
|
||||
WREG MENUW)
|
||||
(SETQ WREG (WINDOWPROP MAINWINDOW 'REGION))
|
||||
(SETQ MENUW (CREATEW (create REGION
|
||||
LEFT _ (fetch (REGION LEFT) of WREG)
|
||||
BOTTOM _ (fetch (REGION TOP) of WREG)
|
||||
WIDTH _ (fetch (REGION WIDTH) of WREG)
|
||||
HEIGHT _ (OR HEIGHT 133))
|
||||
TITLE))
|
||||
(WINDOWADDPROP MENUW 'CLOSEFN (FUNCTION FREEATTACHEDWINDOW))
|
||||
(WINDOWPROP MENUW 'TEDITMENU (OR TITLE "TEdit Menu"))
|
||||
(* ; "Mark this as a TEDIT MENU window")
|
||||
@@ -991,31 +1016,26 @@
|
||||
|
||||
(* ;; "The mainwindow's PROMPTWINDOW is also the menus prompt window")
|
||||
|
||||
(CL:WHEN MAINWINDOW
|
||||
(WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW)))
|
||||
[TEDIT MENUSTREAM MENUW NIL `(TITLEMENUFN DON'T PROMPTWINDOW ,(GETTOBJ (TEXTOBJ
|
||||
MAINWINDOW
|
||||
)
|
||||
PROMPTWINDOW]
|
||||
(WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW))
|
||||
[TEDIT MENUSTREAM MENUW NIL `(TITLEMENUFN DON'T NOTSPLITTABLE T PROMPTWINDOW
|
||||
,(GETTOBJ (TEXTOBJ TSTREAM)
|
||||
PROMPTWINDOW]
|
||||
(PROCESSPROP (WINDOWPROP MENUW 'PROCESS)
|
||||
'NAME
|
||||
(PACK* "TEdit-" (CL:IF TYPE
|
||||
(L-CASE TYPE T)
|
||||
"Menu")))
|
||||
(CL:WHEN MAINWINDOW (* ;
|
||||
"Give the tty back to the main window")
|
||||
(TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS)))
|
||||
|
||||
(* ;; "No caret now, let the buttonevent fn bring it up")
|
||||
|
||||
(\TEDIT.UPCARET (GETPANEPROP (PANEPROPS (FGETTOBJ MENUTEXTOBJ PRIMARYPANE))
|
||||
PCARET)
|
||||
-10 -10)
|
||||
(TEXTPROP MENUTEXTOBJ 'NOTSPLITTABLE T)
|
||||
(WINDOWPROP MENUW 'BUTTONEVENTFN (FUNCTION \TEDIT.MENU.BUTTONEVENTFN))
|
||||
(SETSEL (GETTOBJ MENUTEXTOBJ SEL)
|
||||
(SETSEL (TEXTSEL MENUTEXTOBJ)
|
||||
SET NIL) (* ;
|
||||
"Have to click to get the selection going")
|
||||
(TEDIT.BACKTOMAIN MENUSTREAM)
|
||||
MENUW))])
|
||||
|
||||
(\TEDIT.MENU.BUTTONEVENTFN
|
||||
@@ -1161,7 +1181,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.EXPANDEDMENU.CREATE
|
||||
[LAMBDA NIL (* ; "Edited 7-Jan-2025 16:05 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 8-Mar-2025 12:27 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 16:05 by rmk")
|
||||
(* ; "Edited 8-Nov-2024 08:35 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 10:48 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 22:51 by rmk")
|
||||
@@ -1232,7 +1253,7 @@
|
||||
(FIELDTYPE STRING))
|
||||
3
|
||||
(TOGGLE (LABEL "Confirm"))
|
||||
TAB
|
||||
3
|
||||
(TOGGLE (IDENTIFIER USENEWLOOKS)
|
||||
(LABEL "Use New Looks"))
|
||||
EOL
|
||||
@@ -1253,7 +1274,8 @@
|
||||
(FIELDTYPE STRING])
|
||||
|
||||
(\TEDIT.EXPANDEDMENU.START
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Jan-2025 16:43 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:41 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 16:43 by rmk")
|
||||
(* ; "Edited 20-Aug-2024 15:46 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 27-Feb-2024 08:11 by rmk")
|
||||
@@ -1263,9 +1285,7 @@
|
||||
(* ; "'27-Sep-84 01:04' gbn")
|
||||
(LET (EXPANDEDMENU (TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(\TEDIT.MENU.START (SETQ EXPANDEDMENU (\TEDIT.EXPANDEDMENU.CREATE))
|
||||
(\TEDIT.PRIMARYPANE TEXTOBJ)
|
||||
"TEdit Menu"
|
||||
(HEIGHTIFWINDOW 60 T)
|
||||
TSTREAM "TEdit Menu" (HEIGHTIFWINDOW 60 T)
|
||||
'EXPANDED)
|
||||
(CL:WHEN (OR (GETTEXTPROP TEXTOBJ 'CLEARGET)
|
||||
(GETTEXTPROP TEXTOBJ 'CLEARPUT)) (* ; "initialize the button")
|
||||
@@ -1323,7 +1343,11 @@
|
||||
(RETURN 'DON'T])
|
||||
|
||||
(\TEDIT.EXPANDEDMENU.ACTIONFN
|
||||
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 7-Jan-2025 22:36 by rmk")
|
||||
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 18-Mar-2025 23:54 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 21:43 by rmk")
|
||||
(* ; "Edited 14-Mar-2025 15:43 by rmk")
|
||||
(* ; "Edited 5-Mar-2025 20:51 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 22:36 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:30 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 10:54 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 15:40 by rmk")
|
||||
@@ -1370,8 +1394,9 @@
|
||||
else (TEDIT.PROMPTPRINT MAINSTREAM "Include file not specified" T
|
||||
)))
|
||||
(FIND (SETQ STATE (MB.GET 'FINDPATTERN MENUTEXTOBJ 'STATE MENUSEL))
|
||||
(if (IGEQ 1 (NCHARS STATE))
|
||||
then (\TEDIT.KEY.FIND MAINSTREAM NIL NIL NIL NIL STATE)
|
||||
(if (IGEQ (NCHARS STATE)
|
||||
1)
|
||||
then (\TEDIT.KEY.FIND MAINSTREAM NIL NIL STATE)
|
||||
else (TEDIT.PROMPTPRINT MAINSTREAM "Search pattern not specified" T)
|
||||
))
|
||||
(SUBSTITUTE [LET* [(STATES (MB.GET '(REPLACEMENT PATTERN CONFIRM USENEWLOOKS
|
||||
@@ -1389,14 +1414,13 @@
|
||||
REPLACEMENT)))
|
||||
[TEDIT.SUBSTITUTE MAINSTREAM PATTERN (OR REPLACEMENT
|
||||
"")
|
||||
(EQ 'ON (LISTGET STATES 'CONFIRM])])
|
||||
(EQ 'ON (LISTGET STATES 'CONFIRM))
|
||||
(EQ 'ON (LISTGET STATES 'USENEWLOOKS])])
|
||||
(QUIT (* ; "Is it OK to quit the main edit?")
|
||||
(\TEDIT.FINISHEDIT? MAINSTREAM))
|
||||
(PAGELAYOUT (* ; "Page layout menu")
|
||||
(\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
|
||||
(\TEDIT.PRIMARYPANE MAINSTREAM)
|
||||
"Page Layout Menu"
|
||||
(HEIGHTIFWINDOW 135 5)
|
||||
MAINSTREAM "Page Layout Menu" (HEIGHTIFWINDOW 135 5)
|
||||
'PAGE))
|
||||
(PARALOOKS (* ; "Page layout menu")
|
||||
(\TEDIT.PARAMENU.START MAINSTREAM))
|
||||
@@ -1434,16 +1458,6 @@
|
||||
(\TEDIT.SHOWSEL MENUSEL NIL MENUTEXTOBJ) (* ;
|
||||
"And forget that anything is selected.")
|
||||
(SETSEL MENUSEL SET NIL])
|
||||
|
||||
(TEDIT.MENUSTREAM
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Aug-2024 15:48 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 09:53 by rmk")
|
||||
(* jds "13-Aug-84 14:10")
|
||||
|
||||
(* ;; "returns the textstream of the teditmenu attached to this stream if any")
|
||||
|
||||
(for W in (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)) when (TEDITMENUP W "TEdit Menu")
|
||||
do (RETURN (TSTREAM W])
|
||||
)
|
||||
|
||||
|
||||
@@ -1566,16 +1580,15 @@
|
||||
EOL])
|
||||
|
||||
(\TEDIT.PARAMENU.START
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Jan-2025 15:36 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:42 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 15:36 by rmk")
|
||||
(* ; "Edited 27-Jul-2024 00:06 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 27-Feb-2024 07:53 by rmk")
|
||||
(* ; "Edited 19-Sep-2023 08:51 by rmk")
|
||||
(* ; "Edited 20-Aug-87 16:51 by jds")
|
||||
(\TEDIT.MENU.START (\TEDIT.PARAMENU.CREATE)
|
||||
(\TEDIT.PRIMARYPANE TSTREAM)
|
||||
"Paragraph-Looks Menu"
|
||||
(HEIGHTIFWINDOW 141 T)
|
||||
TSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T)
|
||||
'PARALOOKS])
|
||||
|
||||
(\TEDIT.APPLY.PARALOOKS
|
||||
@@ -1633,7 +1646,9 @@
|
||||
(TEDIT.BACKTOMAIN MENUSTREAM))])
|
||||
|
||||
(\TEDIT.PARAMENU.FILLIN
|
||||
[LAMBDA (MENUSTREAM FMTSPEC) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (MENUSTREAM PARALOOKS) (* ; "Edited 19-Feb-2025 13:27 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:53 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 12:53 by rmk")
|
||||
(* ; "Edited 31-Aug-2024 11:29 by rmk")
|
||||
(* ; "Edited 25-Aug-2024 23:48 by rmk")
|
||||
@@ -1643,10 +1658,9 @@
|
||||
(* ; "Edited 9-Aug-2024 12:00 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 00:40 by rmk")
|
||||
|
||||
(* ;; "For the paragraph menu SHOW command, fills in the with values drawn from the FMTSPEC of the main documents selectiont. The strategy is to iterate through the image objects in the MENUTEXTOBJ and figure out from their property what aspect of FMTSPEC they depict.")
|
||||
(* ;; "For the paragraph menu SHOW command, fills in the with values drawn from the PARALOOKS of the main documents selectiont. The strategy is to iterate through the image objects in the MENUTEXTOBJ and figure out from their property what aspect of PARALOOKS they depict.")
|
||||
|
||||
(for PC OBJ VAL PROP SETSTATEFN inpieces (\TEDIT.FIRSTPIECE (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of MENUSTREAM))
|
||||
(for PC OBJ VAL PROP SETSTATEFN inpieces (\TEDIT.FIRSTPIECE (GETTSTR MENUSTREAM TEXTOBJ))
|
||||
when [SETQ SETSTATEFN (AND (SETQ OBJ (POBJ PC))
|
||||
(SETQ PROP (IMAGEOBJPROP OBJ 'IDENTIFIER))
|
||||
(IMAGEOBJPROP OBJ 'SETSTATEFN]
|
||||
@@ -1654,37 +1668,38 @@
|
||||
(* ;; "These are the properties of the PARAMENU image objects. ")
|
||||
|
||||
(SETQ VAL (SELECTQ PROP
|
||||
(QUAD (FGETPARA FMTSPEC QUAD))
|
||||
(LINELEADING (FGETPARA FMTSPEC LINELEAD))
|
||||
(PARALEADING (FGETPARA FMTSPEC LEADBEFORE))
|
||||
(QUAD (FGETPLOOKS PARALOOKS QUAD))
|
||||
(LINELEADING (FGETPLOOKS PARALOOKS LINELEAD))
|
||||
(PARALEADING (FGETPLOOKS PARALOOKS LEADBEFORE))
|
||||
(SPECIALX (* ; "0 means don't for these")
|
||||
(CL:IF (AND (FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(IGREATERP (FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(CL:IF (AND (FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
(IGREATERP (FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
0))
|
||||
(FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
'**EMPTY**))
|
||||
(SPECIALY (CL:IF (AND (FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(IGREATERP (FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(SPECIALY (CL:IF (AND (FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
(IGREATERP (FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
0))
|
||||
(FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
'**EMPTY**))
|
||||
(NEWPAGEBEFORE (FGETPARA FMTSPEC FMTNEWPAGEBEFORE))
|
||||
(NEWPAGEAFTER (FGETPARA FMTSPEC FMTNEWPAGEAFTER))
|
||||
(HEADINGKEEP (FGETPARA FMTSPEC FMTHEADINGKEEP))
|
||||
(HARDCOPY (FGETPARA FMTSPEC FMTHARDCOPY))
|
||||
(DEFAULTTAB (FGETPARA FMTSPEC FMTDEFAULTTAB))
|
||||
(NEWPAGEBEFORE (FGETPLOOKS PARALOOKS FMTNEWPAGEBEFORE))
|
||||
(NEWPAGEAFTER (FGETPLOOKS PARALOOKS FMTNEWPAGEAFTER))
|
||||
(HEADINGKEEP (FGETPLOOKS PARALOOKS FMTHEADINGKEEP))
|
||||
(HARDCOPY (FGETPLOOKS PARALOOKS FMTHARDCOPY))
|
||||
(DEFAULTTAB (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))
|
||||
(TABTYPE (* ; "Doesn't change")
|
||||
(IMAGEOBJPROP OBJ 'STATE))
|
||||
(TYPE (* ; "Presumably PAGEHEADING here")
|
||||
(CL:IF (EQ 'PAGEHEADING (FGETPARA FMTSPEC FMTPARATYPE))
|
||||
(CL:IF (EQ 'PAGEHEADING (FGETPLOOKS PARALOOKS FMTPARATYPE))
|
||||
'ON
|
||||
'OFF))
|
||||
(SUBTYPE (FGETPARA FMTSPEC FMTPARASUBTYPE))
|
||||
(SUBTYPE (FGETPLOOKS PARALOOKS FMTPARASUBTYPE))
|
||||
(DOTTEDLEADER (* ;
|
||||
"Ephemeral property of individual tabs")
|
||||
'OFF)
|
||||
(MARGINBAR [\TEDIT.FMTSPECTOMARBAR FMTSPEC (fetch (MARGINBAR MARUNIT)
|
||||
of (IMAGEOBJPROP OBJ
|
||||
(MARGINBAR [\TEDIT.PARALOOKS.TO.MARBAR PARALOOKS (fetch (MARGINBAR MARUNIT)
|
||||
of (IMAGEOBJPROP
|
||||
OBJ
|
||||
'OBJECTDATUM])
|
||||
(TABTYPE (\TEDIT.THELP))
|
||||
(\TEDIT.THELP PROP)))
|
||||
@@ -1712,6 +1727,8 @@
|
||||
|
||||
|
||||
(RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT))
|
||||
|
||||
(RPAQ? TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha))
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.CHARMENU.CREATE
|
||||
@@ -1754,7 +1771,8 @@
|
||||
,@(\TEDIT.CHARMENU.SPEC TSTREAM])
|
||||
|
||||
(\TEDIT.CHARMENU.START
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Jan-2025 22:37 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:41 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 22:37 by rmk")
|
||||
(* ; "Edited 17-Dec-2024 00:04 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
(* ; "Edited 27-Feb-2024 07:56 by rmk")
|
||||
@@ -1765,13 +1783,13 @@
|
||||
(* ;; "Open a character-looks menu.")
|
||||
|
||||
(\TEDIT.MENU.START (\TEDIT.CHARMENU.CREATE TSTREAM)
|
||||
(\TEDIT.PRIMARYPANE TSTREAM)
|
||||
"Character Looks Menu"
|
||||
(HEIGHTIFWINDOW 100 T)
|
||||
TSTREAM "Character Looks Menu" (HEIGHTIFWINDOW 100 T)
|
||||
'CHARLOOKS])
|
||||
|
||||
(\TEDIT.CHARMENU.SPEC
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 26-Jan-2025 22:05 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 23-Mar-2025 14:48 by rmk")
|
||||
(* ; "Edited 15-Mar-2025 23:38 by rmk")
|
||||
(* ; "Edited 26-Jan-2025 22:05 by rmk")
|
||||
(* ; "Edited 10-Jan-2025 10:49 by rmk")
|
||||
(* ; "Edited 3-Jan-2025 11:21 by rmk")
|
||||
(* ; "Edited 1-Jan-2025 09:38 by rmk")
|
||||
@@ -1795,7 +1813,7 @@
|
||||
(FUNCTION \TEDIT.OFFSETTYPE.STATEFN)
|
||||
(FUNCTION \TEDIT.OTHER.STATECHANGEFN)
|
||||
(FUNCTION \TEDIT.OTHER.SELECTFN))
|
||||
(LET [[FONTFAMILIES (APPEND '(Classic Helvetica Modern Terminal TimesRoman]
|
||||
(LET [(FONTFAMILIES (APPEND TEDIT.FONTFAMILIES))
|
||||
(FONTDEVICES (CONS 'All (for D in TEDIT.FONTDEVICES collect (CL:IF (EQ 'PDF D)
|
||||
'PDF
|
||||
(L-CASE D T))]
|
||||
@@ -1829,8 +1847,9 @@
|
||||
3
|
||||
(3STATE (LABEL Italic))
|
||||
3
|
||||
(FIELD (PRELABEL "Size:")
|
||||
(FIELDTYPE NUMBER))
|
||||
(FIELD (IDENTIFIER SIZE)
|
||||
(PRELABEL "Size:")
|
||||
(FIELDTYPE TRIMMEDSTRING))
|
||||
EOL
|
||||
(NWAY (IDENTIFIER OFFSETTYPE)
|
||||
(BUTTONS (Normal Superscript Subscript))
|
||||
@@ -1891,7 +1910,8 @@
|
||||
NEWLOOKS])
|
||||
|
||||
(\TEDIT.CHARMENU.FILLIN
|
||||
[LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "Edited 1-Jan-2025 15:24 by rmk")
|
||||
[LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "Edited 22-Mar-2025 23:27 by rmk")
|
||||
(* ; "Edited 1-Jan-2025 15:24 by rmk")
|
||||
(* ; "Edited 28-Dec-2024 12:48 by rmk")
|
||||
(* ; "Edited 20-Dec-2024 12:18 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
@@ -1912,9 +1932,9 @@
|
||||
first (SETQ FONT (FGETCLOOKS CHARLOOKS CLFONT))
|
||||
(SETQ DEVICE (MB.GET 'DEVICE MENUSTREAM 'STATE))
|
||||
(CL:WHEN (type? FONTCLASS FONT)
|
||||
(CL:WHEN (MEMB DEVICE '(OFF ALL))
|
||||
(CL:WHEN (MEMB DEVICE '(OFF ALL NIL))
|
||||
(TEDIT.PROMPTPRINT MENUSTREAM
|
||||
"Please specify a particular display/hardcopy format" T)
|
||||
"Please select a particular display/print device" T)
|
||||
(RETURN))
|
||||
(SETQ FONT (FONTCREATE FONT NIL NIL NIL DEVICE)))
|
||||
when [AND (SETQ OBJ (POBJ PC))
|
||||
@@ -2614,28 +2634,29 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5033 51162 (DRAWMARGINSCALE 5043 . 8502) (MARGINBAR 8504 . 15629) (MARGINBAR.CREATE
|
||||
15631 . 19050) (MB.MARGINBAR.BUTTONEVENTINFN 19052 . 26691) (MB.MARGINBAR.SELFN.TABS 26693 . 31933) (
|
||||
MB.MARGINBAR.SELFN.TABS.KIND 31935 . 32870) (MARGINBAR.GETSTATEFN 32872 . 36750) (MARGINBAR.SETSTATEFN
|
||||
36752 . 36962) (MARGINBAR.NEUTRALIZE 36964 . 37377) (MARGINBAR.LOOKS 37379 . 40485) (
|
||||
MB.MARGINBAR.SIZEFN 40487 . 41090) (MB.MARGINBAR.DISPLAYFN 41092 . 44153) (MDESCALE 44155 . 44695) (
|
||||
MSCALE 44697 . 45027) (MB.MARGINBAR.SHOWTAB 45029 . 47352) (MB.MARGINBAR.TABTRACK 47354 . 48739) (
|
||||
MARGINBAR.INIT 48741 . 50134) (\TEDIT.FMTSPECTOMARBAR 50136 . 51160)) (51987 58204 (\TEDIT.MENU.START
|
||||
51997 . 57628) (\TEDIT.MENU.BUTTONEVENTFN 57630 . 58202)) (58523 66445 (\TEDIT.MENU.CREATE 58533 .
|
||||
60344) (\TEDIT.MENU.PARSE 60346 . 64035) (\TEDIT.MENU.NEUTRALIZE 64037 . 66108) (
|
||||
\TEDITMENU.RECORD.UNFORMATTED 66110 . 66443)) (66511 86444 (\TEDIT.EXPANDEDMENU.CREATE 66521 . 71816)
|
||||
(\TEDIT.EXPANDEDMENU.START 71818 . 73192) (\TEDIT.EXPANDEDMENU.FN 73194 . 76449) (
|
||||
\TEDIT.EXPANDEDMENU.ACTIONFN 76451 . 85885) (TEDIT.MENUSTREAM 85887 . 86442)) (86506 101708 (
|
||||
\TEDIT.PARAMENU.CREATE 86516 . 92537) (\TEDIT.PARAMENU.START 92539 . 93405) (\TEDIT.APPLY.PARALOOKS
|
||||
93407 . 94459) (\TEDIT.SHOW.PARALOOKS 94461 . 97244) (\TEDIT.PARAMENU.FILLIN 97246 . 101706)) (101827
|
||||
127603 (\TEDIT.CHARMENU.CREATE 101837 . 104441) (\TEDIT.CHARMENU.START 104443 . 105474) (
|
||||
\TEDIT.CHARMENU.SPEC 105476 . 109925) (\TEDIT.CHARMENU.PARSE 109927 . 113095) (\TEDIT.CHARMENU.FILLIN
|
||||
113097 . 117442) (\TEDIT.SHOW.CHARLOOKS 117444 . 120701) (\TEDIT.APPLY.CHARLOOKS 120703 . 121864) (
|
||||
\TEDIT.OFFSETTYPE.STATEFN 121866 . 123829) (\TEDIT.OTHER.STATECHANGEFN 123831 . 125476) (
|
||||
\TEDIT.OTHER.SELECTFN 125478 . 127601)) (127665 154104 (\TEDIT.PAGEMENU.CREATE 127675 . 134869) (
|
||||
\TEDIT.SHOW.PAGELOOKS 134871 . 136666) (\TEDIT.PAGEMENU.FILLIN 136668 . 138218) (
|
||||
\TEDIT.PAGEREGION.UNPARSE 138220 . 147410) (\TEDIT.APPLY.PAGELOOKS 147412 . 149339) (
|
||||
\TEDIT.CHANGE.PAGELOOKS 149341 . 153260) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 153262 . 154102)) (154105
|
||||
159908 (\TEDIT.PAGEMENU.CREATE.HEADINGS 154115 . 156927) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 156929
|
||||
. 158354) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 158356 . 159906)))))
|
||||
(FILEMAP (NIL (5138 51509 (DRAWMARGINSCALE 5148 . 8607) (MARGINBAR 8609 . 15734) (MARGINBAR.CREATE
|
||||
15736 . 19155) (MB.MARGINBAR.BUTTONEVENTINFN 19157 . 26796) (MB.MARGINBAR.SELFN.TABS 26798 . 32038) (
|
||||
MB.MARGINBAR.SELFN.TABS.KIND 32040 . 32975) (MARGINBAR.GETSTATEFN 32977 . 36855) (MARGINBAR.SETSTATEFN
|
||||
36857 . 37067) (MARGINBAR.NEUTRALIZE 37069 . 37482) (MARGINBAR.LOOKS 37484 . 40590) (
|
||||
MB.MARGINBAR.SIZEFN 40592 . 41195) (MB.MARGINBAR.DISPLAYFN 41197 . 44258) (MDESCALE 44260 . 44800) (
|
||||
MSCALE 44802 . 45132) (MB.MARGINBAR.SHOWTAB 45134 . 47457) (MB.MARGINBAR.TABTRACK 47459 . 48844) (
|
||||
MARGINBAR.INIT 48846 . 50239) (\TEDIT.PARALOOKS.TO.MARBAR 50241 . 51507)) (52334 59240 (
|
||||
TEDIT.MENUSTREAM 52344 . 53344) (TEDITMENUP 53346 . 54315) (\TEDIT.MENU.START 54317 . 58664) (
|
||||
\TEDIT.MENU.BUTTONEVENTFN 58666 . 59238)) (59559 67481 (\TEDIT.MENU.CREATE 59569 . 61380) (
|
||||
\TEDIT.MENU.PARSE 61382 . 65071) (\TEDIT.MENU.NEUTRALIZE 65073 . 67144) (\TEDITMENU.RECORD.UNFORMATTED
|
||||
67146 . 67479)) (67547 87539 (\TEDIT.EXPANDEDMENU.CREATE 67557 . 72959) (\TEDIT.EXPANDEDMENU.START
|
||||
72961 . 74391) (\TEDIT.EXPANDEDMENU.FN 74393 . 77648) (\TEDIT.EXPANDEDMENU.ACTIONFN 77650 . 87537)) (
|
||||
87601 103158 (\TEDIT.PARAMENU.CREATE 87611 . 93632) (\TEDIT.PARAMENU.START 93634 . 94566) (
|
||||
\TEDIT.APPLY.PARALOOKS 94568 . 95620) (\TEDIT.SHOW.PARALOOKS 95622 . 98405) (\TEDIT.PARAMENU.FILLIN
|
||||
98407 . 103156)) (103363 129548 (\TEDIT.CHARMENU.CREATE 103373 . 105977) (\TEDIT.CHARMENU.START 105979
|
||||
. 107076) (\TEDIT.CHARMENU.SPEC 107078 . 111761) (\TEDIT.CHARMENU.PARSE 111763 . 114931) (
|
||||
\TEDIT.CHARMENU.FILLIN 114933 . 119387) (\TEDIT.SHOW.CHARLOOKS 119389 . 122646) (
|
||||
\TEDIT.APPLY.CHARLOOKS 122648 . 123809) (\TEDIT.OFFSETTYPE.STATEFN 123811 . 125774) (
|
||||
\TEDIT.OTHER.STATECHANGEFN 125776 . 127421) (\TEDIT.OTHER.SELECTFN 127423 . 129546)) (129610 156049 (
|
||||
\TEDIT.PAGEMENU.CREATE 129620 . 136814) (\TEDIT.SHOW.PAGELOOKS 136816 . 138611) (
|
||||
\TEDIT.PAGEMENU.FILLIN 138613 . 140163) (\TEDIT.PAGEREGION.UNPARSE 140165 . 149355) (
|
||||
\TEDIT.APPLY.PAGELOOKS 149357 . 151284) (\TEDIT.CHANGE.PAGELOOKS 151286 . 155205) (
|
||||
\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 155207 . 156047)) (156050 161853 (\TEDIT.PAGEMENU.CREATE.HEADINGS
|
||||
156060 . 158872) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 158874 . 160299) (
|
||||
\TEDIT.PAGEMENU.HEADINGS.STATEFN 160301 . 161851)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Jan-2025 12:29:36" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;29 70509
|
||||
(FILECREATED "19-Feb-2025 12:09:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;33 72260
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.CHARLOOKS2 \TEDIT.GET.CHARLOOKS0 \TEDIT.GET.CHARLOOKS1
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS2)
|
||||
:CHANGES-TO (FNS \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.GET.SINGLE.PARALOOKS2
|
||||
\TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
|
||||
|
||||
:PREVIOUS-DATE "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 22:08:39" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;31)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
|
||||
@@ -47,7 +47,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB2
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
@@ -77,7 +78,7 @@
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT
|
||||
do (SETQ PC NIL) (* ;
|
||||
"This loop may not really read a piece, so we have to distinguish that case.")
|
||||
@@ -323,7 +324,8 @@
|
||||
(RETURN LOOKS])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:25 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 16:07 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 23:01 by rmk")
|
||||
@@ -333,16 +335,16 @@
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(PROG (DEFTAB TABS OUTPUTFORMAT LEN)
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS 1STLEFTMAR)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR)) (* ;
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEFTMAR)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPARA LOOKS FMTTABS))
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
|
||||
(\SMALLPOUT FILE (FGETPLOOKS LOOKS LINELEAD)) (* ; "inter-line leading")
|
||||
(SETQ DEFTAB (FGETPLOOKS LOOKS FMTDEFAULTTAB))
|
||||
(SETQ TABS (FGETPLOOKS LOOKS FMTTABS))
|
||||
(COND
|
||||
((AND (OR DEFTAB TABS)) (* ;
|
||||
"There are tab specs to save, or there is a default tab setting to save")
|
||||
@@ -350,7 +352,7 @@
|
||||
(T (* ;
|
||||
"There are no tab looks. Just let him go.")
|
||||
(\BOUT FILE 2)))
|
||||
(\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
|
||||
(\BOUT FILE (SELECTQ (FGETPLOOKS LOOKS QUAD)
|
||||
(LEFT 1)
|
||||
(RIGHT 2)
|
||||
((CENTER CENTERED)
|
||||
@@ -370,17 +372,17 @@
|
||||
(CENTERED 2)
|
||||
(DECIMAL 3)
|
||||
(\TEDIT.THELP]))
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
|
||||
(\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALX)
|
||||
0))
|
||||
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
|
||||
(\SMALLPOUT FILE (OR (FGETPLOOKS LOOKS FMTSPECIALY)
|
||||
0))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTUSERINFO))
|
||||
(\ATMOUT FILE (FGETPLOOKS LOOKS FMTPARATYPE))
|
||||
(\ATMOUT FILE (FGETPLOOKS LOOKS FMTPARASUBTYPE))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTSTYLE))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTCHARSTYLES))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTNEWPAGEBEFORE))
|
||||
(\ARBOUT FILE (FGETPLOOKS LOOKS FMTNEWPAGEAFTER])
|
||||
|
||||
(\TEDIT.PUT.SINGLE.CHARLOOKS2
|
||||
[LAMBDA (FILE LOOKS) (* ; "Edited 2-Jan-2025 10:51 by rmk")
|
||||
@@ -458,7 +460,9 @@
|
||||
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE])
|
||||
|
||||
(\TEDIT.GET.SINGLE.PARALOOKS2
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:07 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:07 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:48 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:22 by rmk")
|
||||
@@ -470,28 +474,28 @@
|
||||
(* ; "Edited 30-May-91 20:33 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
TABFLG DEFTAB TABS)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -501,22 +505,23 @@
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
FMT])
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
PARALOOKS])
|
||||
|
||||
(\TEDIT.PUT.CHARLOOKS.LIST2
|
||||
[LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk")
|
||||
@@ -570,7 +575,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB1
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
@@ -599,7 +605,7 @@
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT
|
||||
do (SETQ PC NIL) (* ;
|
||||
"This loop may not really read a piece, so we have to distinguish that case.")
|
||||
@@ -776,7 +782,9 @@
|
||||
(FSETCLOOKS LOOKS CLFONT FONT])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS1
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:08 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:08 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:48 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:00 by rmk")
|
||||
@@ -788,53 +796,54 @@
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Read a paragraph format spec from the FILE, and return it for later use.")
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
TABFLG DEFTAB)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(* ; "Will be tab specs")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
[FSETPARA FMT FMTTABS (for TAB# from 1 to (BIN FILE)
|
||||
collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _ (SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP])
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
[FSETPLOOKS PARALOOKS FMTTABS (for TAB# from 1 to (BIN FILE)
|
||||
collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _ (SELECTQ (BIN FILE)
|
||||
(0 'LEFT)
|
||||
(1 'RIGHT)
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP])
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
|
||||
"There are other paragraph parameters to be read.")
|
||||
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALX (\SMALLPIN FILE))
|
||||
(* ;
|
||||
"Special X location on page for this paragraph")
|
||||
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
FMT])
|
||||
(FSETPLOOKS PARALOOKS FMTSPECIALY (\SMALLPIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTUSERINFO (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARATYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTPARASUBTYPE (\ATMIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTSTYLE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTCHARSTYLES (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEBEFORE (\ARBIN FILE))
|
||||
(FSETPLOOKS PARALOOKS FMTNEWPAGEAFTER (\ARBIN FILE)))
|
||||
PARALOOKS])
|
||||
|
||||
(TEDIT.GET.OBJECT1
|
||||
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||
@@ -873,7 +882,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.GET.PCTB0
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:27 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:47 by rmk")
|
||||
@@ -894,8 +904,8 @@
|
||||
8))
|
||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) for I
|
||||
from 1 to PCCOUNT
|
||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
for I from 1 to PCCOUNT
|
||||
do (SETQ PCLEN (\DWIN TEXT))
|
||||
(SETQ PC
|
||||
(create PIECE
|
||||
@@ -1029,7 +1039,9 @@
|
||||
OBJ])
|
||||
|
||||
(\TEDIT.GET.PARALOOKS0
|
||||
[LAMBDA (PC FILE) (* ; "Edited 23-Oct-2024 16:09 by rmk")
|
||||
[LAMBDA (PC FILE) (* ; "Edited 19-Feb-2025 12:09 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2024 16:09 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2024 09:47 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:23 by rmk")
|
||||
@@ -1041,29 +1053,29 @@
|
||||
(* ; "Edited 30-May-91 20:34 by jds")
|
||||
(* ;
|
||||
"Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
|
||||
(LET ((FMT (create FMTSPEC))
|
||||
(LET ((PARALOOKS (create PARALOOKS))
|
||||
TABFLG DEFTAB TABS)
|
||||
(SETPC PC PPARALOOKS FMT)
|
||||
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(SETPC PC PPARALOOKS PARALOOKS)
|
||||
(FSETPLOOKS PARALOOKS 1STLEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the first line of the paragraph")
|
||||
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
(FSETPLOOKS PARALOOKS LEFTMAR (\SMALLPIN FILE)) (* ;
|
||||
"Left margin for the rest of the paragraph")
|
||||
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(FSETPLOOKS PARALOOKS RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
|
||||
(FSETPLOOKS PARALOOKS LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
|
||||
(SETQ TABFLG (BIN FILE))
|
||||
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(FSETPLOOKS PARALOOKS QUAD (SELECTC (BIN FILE)
|
||||
(1 'LEFT)
|
||||
(2 'RIGHT)
|
||||
(3 'CENTERED)
|
||||
(4 'JUSTIFIED)
|
||||
(\TEDIT.THELP)))
|
||||
(CL:UNLESS (ZEROP TABFLG) (* ; "There are tabs to read")
|
||||
(SETQ DEFTAB (\SMALLPIN FILE))
|
||||
(CL:WHEN (ILEQ DEFTAB 1)
|
||||
(SETQ DEFTAB DEFAULTTAB))
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFTAB)
|
||||
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
|
||||
TABX _ (\SMALLPIN FILE)
|
||||
TABKIND _
|
||||
@@ -1073,20 +1085,20 @@
|
||||
(2 'CENTERED)
|
||||
(3 'DECIMAL)
|
||||
(\TEDIT.THELP]
|
||||
(FSETPARA FMT FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
|
||||
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
|
||||
FMT])
|
||||
(FSETPLOOKS PARALOOKS FMTTABS TABS))
|
||||
(CL:UNLESS (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FSETPLOOKS PARALOOKS FMTDEFAULTTAB DEFAULTTAB))
|
||||
PARALOOKS])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1758 36532 (\TEDIT.GET.PCTB2 1768 . 12063) (\TEDIT.GET.PARALOOKS2 12065 . 12654) (
|
||||
\TEDIT.GET.CHARLOOKS2 12656 . 13987) (\TEDIT.PARSE.PAGEFRAMES2 13989 . 16728) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 16730 . 17237) (\TEDIT.GET.SINGLE.CHARLOOKS2 17239 . 20450) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 20452 . 24569) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24571 . 28281) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 28283 . 28790) (\TEDIT.GET.SINGLE.PARALOOKS2 28792 . 33250) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 33252 . 35331) (\TEDIT.PUT.PARALOOKS.LIST2 35333 . 36530)) (36609 56608 (
|
||||
\TEDIT.GET.PCTB1 36619 . 43310) (\TEDIT.GET.PAGEFRAMES1 43312 . 43764) (\TEDIT.PARSE.PAGEFRAMES1 43766
|
||||
. 46419) (\TEDIT.GET.CHARLOOKS1 46421 . 50466) (\TEDIT.GET.PARALOOKS1 50468 . 54874) (
|
||||
TEDIT.GET.OBJECT1 54876 . 56606)) (56668 70486 (\TEDIT.GET.PCTB0 56678 . 60641) (\TEDIT.GET.CHARLOOKS0
|
||||
60643 . 64738) (\TEDIT.GET.OBJECT0 64740 . 66799) (\TEDIT.GET.PARALOOKS0 66801 . 70484)))))
|
||||
(FILEMAP (NIL (1758 37224 (\TEDIT.GET.PCTB2 1768 . 12181) (\TEDIT.GET.PARALOOKS2 12183 . 12772) (
|
||||
\TEDIT.GET.CHARLOOKS2 12774 . 14105) (\TEDIT.PARSE.PAGEFRAMES2 14107 . 16846) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 16848 . 17355) (\TEDIT.GET.SINGLE.CHARLOOKS2 17357 . 20568) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 20570 . 24820) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24822 . 28532) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 28534 . 29041) (\TEDIT.GET.SINGLE.PARALOOKS2 29043 . 33942) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 33944 . 36023) (\TEDIT.PUT.PARALOOKS.LIST2 36025 . 37222)) (37301 57923 (
|
||||
\TEDIT.GET.PCTB1 37311 . 44120) (\TEDIT.GET.PAGEFRAMES1 44122 . 44574) (\TEDIT.PARSE.PAGEFRAMES1 44576
|
||||
. 47229) (\TEDIT.GET.CHARLOOKS1 47231 . 51276) (\TEDIT.GET.PARALOOKS1 51278 . 56189) (
|
||||
TEDIT.GET.OBJECT1 56191 . 57921)) (57983 72237 (\TEDIT.GET.PCTB0 57993 . 62074) (\TEDIT.GET.CHARLOOKS0
|
||||
62076 . 66171) (\TEDIT.GET.OBJECT0 66173 . 68232) (\TEDIT.GET.PARALOOKS0 68234 . 72235)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Jan-2025 23:09:11" {WMEDLEY}<library>tedit>TEDIT-PAGE.;204 131960
|
||||
(FILECREATED "23-Feb-2025 10:06:16" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;208 133418
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.FORMATFOLIO \TEDIT.FORMATHEADING \TEDIT.HARDCOPY.PAGEHEADINGS
|
||||
TEDIT.SINGLE.PAGEFORMAT)
|
||||
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
|
||||
|
||||
:PREVIOUS-DATE " 7-Jan-2025 22:54:12" {WMEDLEY}<library>tedit>TEDIT-PAGE.;203)
|
||||
:PREVIOUS-DATE "19-Feb-2025 13:33:12" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;207)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||
@@ -186,10 +185,9 @@
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \FIRST-COLUMN-START MACRO [(LINE FMTSPEC)
|
||||
(PUTPROPS \FIRST-COLUMN-START MACRO [(LINE PARALOOKS)
|
||||
(AND (FGETLD LINE 1STLN)
|
||||
(EQ (FFETCH (FMTSPEC FMTCOLUMN) OF FMTSPEC)
|
||||
'FIRST])
|
||||
(EQ 'FIRST (FGETPLOOKS PARALOOKS FMTCOLUMN])
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -632,7 +630,8 @@
|
||||
|
||||
(TEDIT.FORMAT.HARDCOPY
|
||||
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
|
||||
ENDPG) (* ; "Edited 30-Aug-2024 15:45 by rmk")
|
||||
ENDPG QUIET) (* ; "Edited 23-Feb-2025 09:59 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 15:45 by rmk")
|
||||
(* ; "Edited 10-Jul-2024 23:34 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:32 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:01 by rmk")
|
||||
@@ -702,7 +701,7 @@
|
||||
[SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM TEXTSTREAM]
|
||||
(RESETLST (* ;
|
||||
"Set up to do the user's cleanup on the way out, as well.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
|
||||
(CL:UNLESS QUIET (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T))
|
||||
[COND
|
||||
((AND FILE (OPENP FILE)
|
||||
(IMAGESTREAMTYPE FILE)) (* ;
|
||||
@@ -759,15 +758,16 @@
|
||||
(FUNCTION NILL))
|
||||
TEXTSTREAM))
|
||||
(SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
|
||||
""
|
||||
"s")
|
||||
" printed"
|
||||
(CL:IF (EQ FILE SCRATCHFILE)
|
||||
(CONCAT " to " (OR TARGETFILENAME (FULLNAME
|
||||
FILE)))
|
||||
""))
|
||||
T)
|
||||
(CL:UNLESS QUIET
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES)
|
||||
""
|
||||
"s")
|
||||
" printed"
|
||||
(CL:IF (EQ FILE SCRATCHFILE)
|
||||
(CONCAT " to " (OR TARGETFILENAME
|
||||
(FULLNAME FILE)))
|
||||
""))
|
||||
T))
|
||||
(RETURN NPAGES)))])
|
||||
)
|
||||
|
||||
@@ -1005,7 +1005,9 @@
|
||||
LINE))])
|
||||
|
||||
(\TEDIT.FORMATPAGE
|
||||
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 11-Dec-2024 22:39 by rmk")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 22:39 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:24 by rmk")
|
||||
(* ; "Edited 13-Mar-2024 10:28 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:10 by rmk")
|
||||
@@ -1050,7 +1052,7 @@
|
||||
(SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC)
|
||||
PC TEXTOBJ)) (* ;
|
||||
"RMK: Why both 'NEWPAGELAYOUT and :NEW-PAGE-LAYOUT ?")
|
||||
(CL:WHEN (EQ 'NEWPAGELAYOUT (fetch (FMTSPEC FMTPARATYPE) of NEWPARALOOKS))
|
||||
(CL:WHEN (EQ 'NEWPAGELAYOUT (GETPLOOKS NEWPARALOOKS FMTPARATYPE))
|
||||
|
||||
(* ;; "The first paragra ph on this page starts a new page layout.")
|
||||
|
||||
@@ -1059,10 +1061,11 @@
|
||||
(* ;; "The first character of the paragraph after the one containing PC:")
|
||||
|
||||
[SETPFS FORMATTINGSTATE CHNO (ADD1 (CAR (\TEDIT.PARA.LAST TEXTOBJ PC]
|
||||
[SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES
|
||||
(LISTGET (fetch (FMTSPEC FMTUSERINFO)
|
||||
of NEWPARALOOKS)
|
||||
'NEWPAGELAYOUT]
|
||||
[SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES (LISTGET
|
||||
(GETPLOOKS
|
||||
NEWPARALOOKS
|
||||
FMTUSERINFO)
|
||||
'NEWPAGELAYOUT]
|
||||
(RETURN))
|
||||
|
||||
(* ;; "")
|
||||
@@ -1142,7 +1145,9 @@
|
||||
1])
|
||||
|
||||
(\TEDIT.FORMATTEXTBOX
|
||||
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 11-Dec-2024 22:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:39 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 22:37 by rmk")
|
||||
(* ; "Edited 24-Nov-2024 11:46 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 19:16 by rmk")
|
||||
@@ -1201,7 +1206,7 @@
|
||||
(SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES FOOTNOTELINES)
|
||||
(* ; "Remember any remaining footnotes")
|
||||
[SETQ LINES
|
||||
(bind LINE FMTSPEC LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE
|
||||
(bind LINE PARALOOKS LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE
|
||||
COLUMN-YBASE (TEXTLEN _ (TEXTLEN TEXTOBJ)) while (AND (ILEQ CHNO TEXTLEN)
|
||||
(NOT FORCENEXTPAGE))
|
||||
collect (BLOCK)
|
||||
@@ -1217,7 +1222,7 @@
|
||||
(FGETLD LINE FORCED-END))
|
||||
'USERBREAK))
|
||||
(SETQ LHEIGHT (FGETLD LINE LHEIGHT))
|
||||
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(SETQ PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(COND
|
||||
((FGETLD LINE LMARK)
|
||||
|
||||
@@ -1225,7 +1230,7 @@
|
||||
|
||||
(SETQ CHNO (FGETLD LINE LCHARLIM))
|
||||
LINE)
|
||||
((LISTGET (FGETPARA FMTSPEC FMTUSERINFO)
|
||||
((LISTGET (FGETPLOOKS PARALOOKS FMTUSERINFO)
|
||||
'FOOTNOTE)
|
||||
|
||||
(* ;; "This paragraph is a footnote para.")
|
||||
@@ -1279,14 +1284,14 @@
|
||||
(* ;; "So that only the first line of a specially-placed paragraph is guaranteed to appear in the current box.")
|
||||
|
||||
[SETQ YBOT (COND
|
||||
((AND (FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY)))
|
||||
((AND (FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALY)))
|
||||
(FGETLD LINE 1STLN))
|
||||
(* ;
|
||||
"There is a special Y location for this paragraph. Move there")
|
||||
(SETQ SPECIALYPOS (FGETPARA FMTSPEC FMTSPECIALY)))
|
||||
(SETQ SPECIALYPOS (FGETPLOOKS PARALOOKS FMTSPECIALY)))
|
||||
((AND COLUMN-YBASE (FGETLD LINE 1STLN)
|
||||
(EQ (FGETPARA FMTSPEC FMTCOLUMN)
|
||||
(EQ (FGETPLOOKS PARALOOKS FMTCOLUMN)
|
||||
'NEXT))
|
||||
|
||||
(* ;;
|
||||
@@ -1297,20 +1302,22 @@
|
||||
|
||||
(* ;; "We're into it; take account of this line's height. Original code did the complicated LHEIGHT calculation and threw it away. I assume that that was an error, that the new setting of LHEIGHT is for the benefit of the new YBOT value (which I pulled out of an alternative branch of a COND.")
|
||||
|
||||
(CL:WHEN (FGETPARA FMTSPEC FMTBASETOBASE)
|
||||
(CL:WHEN (FGETPLOOKS PARALOOKS FMTBASETOBASE)
|
||||
[SETQ LHEIGHT
|
||||
(IPLUS (FGETLD LINE LDESCENT)
|
||||
(FGETPARA FMTSPEC FMTBASETOBASE)
|
||||
(FGETPLOOKS PARALOOKS FMTBASETOBASE)
|
||||
(COND
|
||||
((FGETLD LINE 1STLN)
|
||||
(IPLUS (FGETPARA FMTSPEC LEADBEFORE
|
||||
)
|
||||
(FGETPARA (GETLD PREVLINE
|
||||
LFMTSPEC)
|
||||
(IPLUS (FGETPLOOKS PARALOOKS
|
||||
LEADBEFORE)
|
||||
(FGETPLOOKS (GETLD PREVLINE
|
||||
|
||||
LPARALOOKS
|
||||
)
|
||||
LEADAFTER)))
|
||||
(T 0])
|
||||
(COND
|
||||
((\FIRST-COLUMN-START LINE FMTSPEC)
|
||||
((\FIRST-COLUMN-START LINE PARALOOKS)
|
||||
(IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT)
|
||||
LHEIGHT))
|
||||
(T (IDIFFERENCE YBOT LHEIGHT]
|
||||
@@ -1329,7 +1336,7 @@
|
||||
NIL)
|
||||
((AND (NOT FIRSTLINE)
|
||||
(FGETLD LINE 1STLN)
|
||||
(SETQ NEWPAGETYPE (OR (FGETPARA (FGETLD LINE LFMTSPEC)
|
||||
(SETQ NEWPAGETYPE (OR (FGETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTNEWPAGEBEFORE)
|
||||
BREAKAFTERLASTPARA)))
|
||||
|
||||
@@ -1346,7 +1353,7 @@
|
||||
(SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE NEWPAGETYPE))
|
||||
NIL)
|
||||
(T (* ; "This line is good; use it.")
|
||||
(CL:WHEN (AND (FGETPARA FMTSPEC FMTNEWPAGEAFTER))
|
||||
(CL:WHEN (AND (FGETPLOOKS PARALOOKS FMTNEWPAGEAFTER))
|
||||
(* ;
|
||||
"We're supposed to put the line after this one at the start of a new page/column (any box, later)")
|
||||
(SETQ BREAKAFTERLASTPARA T))
|
||||
@@ -1354,7 +1361,7 @@
|
||||
(IMIN PRIOR-COLUMN-YBOT YBOT)
|
||||
YBOT))
|
||||
(SETYBOT LINE YBOT)
|
||||
(CL:WHEN (\FIRST-COLUMN-START LINE FMTSPEC)
|
||||
(CL:WHEN (\FIRST-COLUMN-START LINE PARALOOKS)
|
||||
|
||||
(* ;; "This is the start of a new group of paragraphs to be lined up in columns. Save the YBASE for these guys for the other columns.")
|
||||
|
||||
@@ -1474,7 +1481,8 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.SKIP.SPECIALCOND
|
||||
[LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
[LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 19:35 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 10:27 by rmk")
|
||||
(* ; "Edited 5-Jul-2023 14:19 by rmk")
|
||||
@@ -1493,11 +1501,11 @@
|
||||
(FSETLD LINE LDESCENT 0)
|
||||
(FSETLD LINE LTRUEASCENT 0)
|
||||
(FSETLD LINE LTRUEDESCENT 0)
|
||||
(FSETLD LINE LCHARLIM (IPLUS CHNO (for PC (HEADINGTYPE _ (GETPARA PARALOOKS FMTPARASUBTYPE))
|
||||
(FSETLD LINE LCHARLIM (IPLUS CHNO (for PC (HEADINGTYPE _ (GETPLOOKS PARALOOKS FMTPARASUBTYPE))
|
||||
inpieces (fetch (TEXTSTREAM PIECE) of TSTREAM)
|
||||
while (AND (EQ 'PAGEHEADING (GETPARA (PPARALOOKS PC)
|
||||
while (AND (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS PC)
|
||||
FMTPARATYPE))
|
||||
(EQ HEADINGTYPE (GETPARA (PPARALOOKS PC)
|
||||
(EQ HEADINGTYPE (GETPLOOKS (PPARALOOKS PC)
|
||||
FMTPARASUBTYPE)))
|
||||
sum (PLEN PC])
|
||||
)
|
||||
@@ -1509,7 +1517,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.HARDCOPY.PAGEHEADINGS
|
||||
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 12-Jan-2025 17:31 by rmk")
|
||||
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 12-Jan-2025 17:31 by rmk")
|
||||
(* ; "Edited 10-Jan-2025 15:42 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
@@ -1524,13 +1533,14 @@
|
||||
"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 (GETPARA (PPARALOOKS PC)
|
||||
while (AND PC (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS PC)
|
||||
FMTPARATYPE)))
|
||||
do (SETQ HEADINGSUBTYPE (GETPARA (PPARALOOKS PC)
|
||||
do (SETQ HEADINGSUBTYPE (GETPLOOKS (PPARALOOKS PC)
|
||||
FMTPARASUBTYPE))
|
||||
(for P (START _ CHNO) inpieces PC while (AND (EQ 'PAGEHEADING (GETPARA (PPARALOOKS P)
|
||||
(for P (START _ CHNO) inpieces PC while (AND (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS P)
|
||||
FMTPARATYPE))
|
||||
(EQ HEADINGSUBTYPE (GETPARA (PPARALOOKS P)
|
||||
(EQ HEADINGSUBTYPE (GETPLOOKS (PPARALOOKS
|
||||
P)
|
||||
FMTPARASUBTYPE)))
|
||||
do
|
||||
(* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the selpieces")
|
||||
@@ -1579,7 +1589,9 @@
|
||||
|
||||
(\TEDIT.HARDCOPY-COLUMN-END
|
||||
[LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE
|
||||
FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 11-Dec-2024 20:52 by rmk")
|
||||
FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:39 by rmk")
|
||||
(* ; "Edited 11-Dec-2024 20:52 by rmk")
|
||||
(* ; "Edited 24-Nov-2024 11:46 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 19:22 by rmk")
|
||||
@@ -1642,23 +1654,24 @@
|
||||
LCHARLIM))]
|
||||
([AND (NEQ FORCENEXTPAGE 'USERBREAK)
|
||||
(ILEQ CHNO (TEXTLEN TEXTOBJ))
|
||||
(OR (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
(OR (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
FMTHEADINGKEEP)
|
||||
(AND (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
(AND (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
FMTKEEP)
|
||||
(NOT (GETLD LASTLINE LSTLN]
|
||||
|
||||
(* ;; "Only do widow/orphan detection if this is NOT a page break the user asked for. And this isn't the end of the document.")
|
||||
|
||||
(for LASTLINE in (REVERSE LINES) while [OR (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
(for LASTLINE in (REVERSE LINES) while [OR (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
FMTHEADINGKEEP)
|
||||
(AND (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
(AND (GETPLOOKS (GETLD LASTLINE
|
||||
LPARALOOKS)
|
||||
FMTKEEP)
|
||||
(NOT (GETLD LASTLINE LSTLN]
|
||||
do
|
||||
(* ;; "Run thru, removing any trailing headings. However, assure that there's at least one line on a page.")
|
||||
finally (COND
|
||||
((AND LASTLINE (AND (NOT (GETPARA (GETLD LASTLINE LFMTSPEC)
|
||||
((AND LASTLINE (AND (NOT (GETPLOOKS (GETLD LASTLINE LPARALOOKS)
|
||||
FMTHEADINGKEEP))
|
||||
(GETLD LASTLINE LSTLN)))
|
||||
|
||||
@@ -2071,18 +2084,18 @@
|
||||
(RETURN (DREMOVE NIL $$VAL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (12253 15865 (\TEDIT.PARSE.PAGEFRAMES 12263 . 14042) (\TEDIT.PUT.PAGEFRAMES 14044 .
|
||||
14868) (\TEDIT.UNPARSE.PAGEFRAMES 14870 . 15863)) (15928 37826 (TEDIT.SINGLE.PAGEFORMAT 15938 . 26812)
|
||||
(TEDIT.COMPOUND.PAGEFORMAT 26814 . 27793) (TEDIT.PAGEFORMAT 27795 . 35084) (TEDIT.GET.PAGEFORMAT
|
||||
35086 . 37824)) (38113 48615 (TEDIT.FORMAT.HARDCOPY 38123 . 48613)) (48702 100270 (\TEDIT.FORMATBOX
|
||||
48712 . 61815) (\TEDIT.FORMATHEADING 61817 . 66463) (\TEDIT.FORMATPAGE 66465 . 74995) (
|
||||
\TEDIT.FORMATTEXTBOX 74997 . 90921) (\TEDIT.FORMATFOLIO 90923 . 96240) (\TEDIT.FORMAT.FOUNDBOX? 96242
|
||||
. 98281) (\TEDIT.SKIP.SPECIALCOND 98283 . 100268)) (100350 104856 (\TEDIT.HARDCOPY.PAGEHEADINGS
|
||||
100360 . 104854)) (104965 112694 (\TEDIT.HARDCOPY-COLUMN-END 104975 . 112692)) (112739 117680 (
|
||||
SCALEPAGEUNITS 112749 . 113890) (SCALEPAGEXUNITS 113892 . 114662) (SCALEPAGEYUNITS 114664 . 115435) (
|
||||
\TEDIT.PAPERHEIGHT 115437 . 116372) (\TEDIT.PAPERWIDTH 116374 . 117678)) (118096 121664 (ROMANNUMERALS
|
||||
118106 . 121662)) (121703 128969 (TEDIT.PAGENO.CREATE 121713 . 122089) (\TEDIT.PAGENO.OBJINIT 122091
|
||||
. 123374) (\TEDIT.PAGENO.BUTTONEVENTINFN 123376 . 124442) (\TEDIT.PAGENO.IMAGEBOXFN 124444 . 126594)
|
||||
(\TEDIT.PAGENO.DISPLAYFN 126596 . 128246) (\TEDIT.PAGENO.GETFN 128248 . 128640) (\TEDIT.PAGENO.PUTFN
|
||||
128642 . 128967)) (129034 131937 (\TEDIT.FORMAT.FOOTNOTE 129044 . 131935)))))
|
||||
(FILEMAP (NIL (12098 15710 (\TEDIT.PARSE.PAGEFRAMES 12108 . 13887) (\TEDIT.PUT.PAGEFRAMES 13889 .
|
||||
14713) (\TEDIT.UNPARSE.PAGEFRAMES 14715 . 15708)) (15773 37671 (TEDIT.SINGLE.PAGEFORMAT 15783 . 26657)
|
||||
(TEDIT.COMPOUND.PAGEFORMAT 26659 . 27638) (TEDIT.PAGEFORMAT 27640 . 34929) (TEDIT.GET.PAGEFORMAT
|
||||
34931 . 37669)) (37958 48639 (TEDIT.FORMAT.HARDCOPY 37968 . 48637)) (48726 101203 (\TEDIT.FORMATBOX
|
||||
48736 . 61839) (\TEDIT.FORMATHEADING 61841 . 66487) (\TEDIT.FORMATPAGE 66489 . 75356) (
|
||||
\TEDIT.FORMATTEXTBOX 75358 . 91739) (\TEDIT.FORMATFOLIO 91741 . 97058) (\TEDIT.FORMAT.FOUNDBOX? 97060
|
||||
. 99099) (\TEDIT.SKIP.SPECIALCOND 99101 . 101201)) (101283 105992 (\TEDIT.HARDCOPY.PAGEHEADINGS
|
||||
101293 . 105990)) (106101 114152 (\TEDIT.HARDCOPY-COLUMN-END 106111 . 114150)) (114197 119138 (
|
||||
SCALEPAGEUNITS 114207 . 115348) (SCALEPAGEXUNITS 115350 . 116120) (SCALEPAGEYUNITS 116122 . 116893) (
|
||||
\TEDIT.PAPERHEIGHT 116895 . 117830) (\TEDIT.PAPERWIDTH 117832 . 119136)) (119554 123122 (ROMANNUMERALS
|
||||
119564 . 123120)) (123161 130427 (TEDIT.PAGENO.CREATE 123171 . 123547) (\TEDIT.PAGENO.OBJINIT 123549
|
||||
. 124832) (\TEDIT.PAGENO.BUTTONEVENTINFN 124834 . 125900) (\TEDIT.PAGENO.IMAGEBOXFN 125902 . 128052)
|
||||
(\TEDIT.PAGENO.DISPLAYFN 128054 . 129704) (\TEDIT.PAGENO.GETFN 129706 . 130098) (\TEDIT.PAGENO.PUTFN
|
||||
130100 . 130425)) (130492 133395 (\TEDIT.FORMAT.FOOTNOTE 130502 . 133393)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243 67795
|
||||
(FILECREATED " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248 68998
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.DELETEPIECES)
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
|
||||
:PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
|
||||
:PREVIOUS-DATE " 7-Feb-2025 08:31:28" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;246)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -25,7 +25,7 @@
|
||||
(RECORDS BTREENODE BTSLOT)
|
||||
(MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT
|
||||
\FINDSLOT)
|
||||
(MACROS \LASTPIECEP)
|
||||
(MACROS \SUFFIXPIECEP)
|
||||
(I.S.OPRS inslots inpieces backpieces))
|
||||
(MACROS \INSURE.VACANT.BTREESLOT)
|
||||
(ADDVARS (INSPECTDONTSORTFIELDS BTREENODE)))
|
||||
@@ -138,9 +138,9 @@
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ))
|
||||
PC)))
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE))
|
||||
PC)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -215,7 +215,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MAKEPCTB
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:09 by rmk")
|
||||
(* ; "Edited 8-Sep-2023 16:30 by rmk")
|
||||
(* ; "Edited 26-Apr-2023 14:03 by rmk")
|
||||
@@ -236,8 +238,8 @@
|
||||
PLEN _ 0
|
||||
PTREENODE _ NODE
|
||||
PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(FSETTOBJ TEXTOBJ LASTPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(FSETTOBJ TEXTOBJ SUFFIXPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ TEXTLEN 0)
|
||||
(FSETTOBJ TEXTOBJ PCTB (CONS NODE])
|
||||
@@ -272,7 +274,8 @@
|
||||
DELTA])
|
||||
|
||||
(\TEDIT.FIRSTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 12:54 by rmk")
|
||||
(* ; "Edited 24-Aug-2022 12:45 by rmk")
|
||||
@@ -285,7 +288,7 @@
|
||||
|
||||
(* ;; "If we don't bottom out in a piece, something else is screwed up. But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")
|
||||
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
NODE])
|
||||
|
||||
(\TEDIT.DELETETREE
|
||||
@@ -383,16 +386,16 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.LASTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:20 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 19:23 by rmk")
|
||||
(* ; "Edited 21-Aug-2022 17:13 by rmk")
|
||||
(* ; "Edited 16-Aug-2022 10:16 by rmk")
|
||||
(* ; "Edited 14-Apr-93 16:29 by jds")
|
||||
|
||||
(* ;; "Returns the LASTPIECE by running down the right side of the B-tree. Should be the same as (fetch LASTPIECE of TEXTOBJ). Argument can also be a node.")
|
||||
(* ;; "Returns the last real piece of the text, NIL for an empty document.")
|
||||
|
||||
(bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD)
|
||||
do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD])
|
||||
(PREVPIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE])
|
||||
|
||||
(\TEDIT.PCTOCH
|
||||
[LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk")
|
||||
@@ -421,7 +424,8 @@
|
||||
of TOPNODE])
|
||||
|
||||
(\TEDIT.CHTOPC
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 7-Feb-2025 08:29 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
(* ; "Edited 1-Nov-2023 23:29 by rmk")
|
||||
(* ; "Edited 13-Apr-2023 22:22 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 09:49 by rmk")
|
||||
@@ -435,7 +439,7 @@
|
||||
|
||||
(* ;; "There are 2 acceleration cases:")
|
||||
|
||||
(* ;; " if CH# is after the current text length, the pseudo LASTPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
(* ;; " if CH# is after the current text length, the pseudo SUFFIXPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
|
||||
(* ;; " If the TEXTOBJ contains a HINTPC and CH# is in the range HINTPCSTARTCH# and HINTPCSTARTCH#+PLEN-1, then HINTPC is returned. Others may cache that, but we cache it here too for repeated sequential calls.")
|
||||
|
||||
@@ -447,7 +451,7 @@
|
||||
(if (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (CL:WHEN TELL-PC-START?
|
||||
(SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
elseif (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC))
|
||||
(IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)))
|
||||
(ILESSP (IDIFFERENCE CH# STARTCH)
|
||||
@@ -463,7 +467,7 @@
|
||||
|
||||
(* ;; "When PCTB is a list of top-level BTNODES, we find the sub-tree that contains the global CH# piece, sum the TOTLEN's of all prior top-level nodes, retrieve the piece from the identified subtree after adjusting to its LOCAL#. START-OF-PIECE, if required, is globally correct.")
|
||||
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the LASTPIECE case above. Also look at \INSERTPIECE.")
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the SUFFIXPIECE case above. Also look at \INSERTPIECE.")
|
||||
|
||||
(for old BASE-NODE NEXT in (FGETTOBJ TEXTOBJ PCTB)
|
||||
do (SETQ NEXT (IPLUS ALLPRIOR (ffetch (BTREENODE TOTLEN) of BASE-NODE)))
|
||||
@@ -628,16 +632,17 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.LINKNEWPIECE
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Feb-2025 08:26 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
|
||||
(* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain. This doesn't deal with the btree.")
|
||||
|
||||
(* ;; "NEXT=NIL denotes the last piece LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
(* ;; "NEXT=NIL denotes the last piece SUFFIXPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
|
||||
(CL:UNLESS NEXT
|
||||
(SETQ NEXT (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)))
|
||||
(SETQ NEXT (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(LET ((NEXTPREV (PREVPIECE NEXT)))
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ)
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\SUFFIXPIECEP NEXT TEXTOBJ)
|
||||
NEXT))
|
||||
(* ; "NIL for last piece")
|
||||
(freplace (PIECE PREVPIECE) of NEW with NEXTPREV) (* ;
|
||||
@@ -651,7 +656,8 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
@@ -661,7 +667,7 @@
|
||||
(CL:WHEN PREV
|
||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
||||
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
||||
|
||||
(\TEDIT.SPLITPIECE
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
@@ -732,7 +738,8 @@
|
||||
PC])
|
||||
|
||||
(\TEDIT.INSERTPIECE
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:28 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 23:05 by rmk")
|
||||
(* ; "Edited 9-Jun-2023 22:40 by rmk")
|
||||
@@ -741,15 +748,15 @@
|
||||
|
||||
(* ;; "Insert the piece NEWPC in front of the piece NEXTPC. At the end, NEWPC appears before NEXTPC in the piece tree, and all counts and lengths are consistent.")
|
||||
|
||||
(* ;; "The last piece LASTPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the lastpiece has its rightful place in the tree.")
|
||||
(* ;; "The last piece SUFFIXPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the suffix piece has its rightful place in the tree.")
|
||||
|
||||
(* ;; "Caller guarantees that the chain links of NEW can be smashed.")
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.INSERTPIECE 'START TEXTOBJ)
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(* ; "Inserting at the very end")
|
||||
(LET ((PCTB (FGETTOBJ TEXTOBJ PCTB))
|
||||
LASTTREECONS)
|
||||
@@ -785,7 +792,8 @@
|
||||
NEWPC])
|
||||
|
||||
(\TEDIT.INSERTPIECES
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:08 by rmk")
|
||||
@@ -803,7 +811,7 @@
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(for PC (PREVPC _ (PREVPIECE NEXTPC)) inpieces PIECES
|
||||
do
|
||||
(* ;; "This is a variant of \INSERTPIECE specialized for filling in an empty TEXTOBJ from a piece chain. Insertion always happens before NEXTPC, and the chain-links are not smashed. ")
|
||||
@@ -819,7 +827,7 @@
|
||||
|
||||
(* ;; "PC is the final piece of the chain")
|
||||
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FSETPC PC NEXTPIECE NEXTPC))
|
||||
(FSETPC NEXTPC PREVPIECE PC)
|
||||
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES))
|
||||
@@ -827,7 +835,8 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 23:03 by rmk")
|
||||
@@ -840,7 +849,7 @@
|
||||
|
||||
(* ;; "As the PC is deleted from the tree on each iteration, the original previous PREV piece is linked to PC's next, and the next PREVPIECE is linked to PREV so that the tree and the links are uninterruptably consistent.")
|
||||
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then LASTPIECE's PREVPIECE will be updated.")
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then SUFFIXPIECE's PREVPIECE will be updated.")
|
||||
|
||||
(* ;; " Since the pieces are not unlinked on the fly, the tree may be invalid until all the pieces are gone.")
|
||||
|
||||
@@ -851,7 +860,7 @@
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
(SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
|
||||
do (UNINTERRUPTABLY
|
||||
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
|
||||
@@ -875,7 +884,8 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
|
||||
|
||||
(\TEDIT.ALIGNEDPIECE
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 7-Feb-2025 08:05 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:48 by rmk")
|
||||
(* ; "Edited 20-May-2023 13:53 by rmk")
|
||||
@@ -890,7 +900,7 @@
|
||||
then
|
||||
(* ;; "Doesn't return NIL in this case, returns the last piece.")
|
||||
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
elseif (ILEQ CHNO 1)
|
||||
then (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
else (LET (PC START-OF-PIECE)
|
||||
@@ -956,13 +966,14 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.CHECK-BTREE
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 7-Feb-2025 08:07 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:33 by rmk")
|
||||
(* ; "Edited 7-Sep-2022 09:43 by rmk")
|
||||
(* ; "Edited 4-Sep-2022 16:37 by rmk")
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS LASTPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for BT (SUFFIXPIECE _ (FGETTOBJ TEXTOBJ SUFFIXPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS SUFFIXPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
do (SELECTC (PTYPE PC)
|
||||
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
|
||||
@@ -989,7 +1000,8 @@
|
||||
'VALID])
|
||||
|
||||
(\TEDIT.CHECK-BTREE1
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 7-Feb-2025 08:31 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:06 by rmk")
|
||||
(* ; "Edited 27-May-2023 15:00 by rmk")
|
||||
(* ; "Edited 1-Sep-2022 09:49 by rmk")
|
||||
@@ -999,30 +1011,30 @@
|
||||
(* ;;
|
||||
"Returns the TOTLEN/PLEN of NODE, after verifying that all of the nodes underneath are consistent.")
|
||||
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE))
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ SUFFIXPIECE))
|
||||
(ADD DEPTH 1)
|
||||
(if (type? PIECE NODE)
|
||||
then [if (EQ NODE LASTPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE LASTPIECE)
|
||||
(NEXTPIECE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
|
||||
then [if (EQ NODE SUFFIXPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE SUFFIXPIECE)
|
||||
(NEXTPIECE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of SUFFIXPIECE is not NULL" SUFFIXPIECE))
|
||||
else (CL:UNLESS (IGEQ (PLEN NODE)
|
||||
0)
|
||||
(\TEDIT.BTFAIL "Negative PLEN" NODE))
|
||||
(CL:UNLESS (OR (NEXTPIECE NODE)
|
||||
(EQ NODE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
|
||||
(EQ NODE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of SUFFIXPIECE" NODE))
|
||||
(CL:UNLESS (EQ PARENT (fetch (PIECE PTREENODE) of NODE))
|
||||
(\TEDIT.BTFAIL "Piece with wrong PTREENODE" NODE))
|
||||
(CL:WHEN (PREVPIECE NODE)
|
||||
(CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE)))
|
||||
(AND (NULL (NEXTPIECE (PREVPIECE NODE)))
|
||||
(EQ NODE LASTPIECE)))
|
||||
(EQ NODE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PREVPIECE is not consistent" NODE)))
|
||||
(CL:WHEN (OR (NEXTPIECE NODE)
|
||||
LASTPIECE)
|
||||
SUFFIXPIECE)
|
||||
(CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
|
||||
LASTPIECE)))
|
||||
SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "NEXTPIECE is not consistent" NODE)))]
|
||||
(add NPIECES 1)
|
||||
(add [CDR (OR (SASSOC DEPTH DEPTHHIST)
|
||||
@@ -1098,13 +1110,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
|
||||
\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) (
|
||||
\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) (
|
||||
\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE
|
||||
36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) (
|
||||
\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 .
|
||||
53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) (
|
||||
\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729
|
||||
. 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670)))))
|
||||
(FILEMAP (NIL (8685 56524 (\TEDIT.MAKEPCTB 8695 . 10475) (\TEDIT.UPDATEPCNODES 10477 . 12771) (
|
||||
\TEDIT.FIRSTPIECE 12773 . 14180) (\TEDIT.DELETETREE 14182 . 17456) (\TEDIT.INSERTTREE 17458 . 20203) (
|
||||
\TEDIT.LASTPIECE 20205 . 21012) (\TEDIT.PCTOCH 21014 . 23111) (\TEDIT.CHTOPC 23113 . 29290) (
|
||||
\TEDIT.SET-TOTLEN 29292 . 30080) (\TEDIT.MAKE.VACANT.BTREESLOT 30082 . 36812) (\TEDIT.LINKNEWPIECE
|
||||
36814 . 38403) (\TEDIT.UNLINKPIECE 38405 . 39225) (\TEDIT.SPLITPIECE 39227 . 43883) (
|
||||
\TEDIT.INSERTPIECE 43885 . 47157) (\TEDIT.INSERTPIECES 47159 . 50251) (\TEDIT.DELETEPIECES 50253 .
|
||||
54407) (\TEDIT.ALIGNEDPIECE 54409 . 56522)) (56552 68875 (\TEDIT.BTVALIDATE 56562 . 58103) (
|
||||
\TEDIT.BTVALIDATE.PRINT 58105 . 59470) (\TEDIT.CHECK-BTREE 59472 . 61799) (\TEDIT.CHECK-BTREE1 61801
|
||||
. 67432) (\TEDIT.BTFAIL 67434 . 67856) (\TEDIT.MATCHPCS 67858 . 68873)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/tedit/TEDIT-RELEASENOTES.PDF
Normal file
BIN
library/tedit/TEDIT-RELEASENOTES.PDF
Normal file
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2025 10:36:27" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;850 186125
|
||||
(FILECREATED "30-Mar-2025 10:02:52" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;871 189269
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.UPDATE.LINES)
|
||||
:CHANGES-TO (FNS \TEDIT.VALID.LINES \TEDIT.PANE.CREATELINES \TEDIT.SUFFIXLINE.CREATE
|
||||
\TEDIT.LASTVALIDLINE \TEDIT.LINES.ABOVE \TEDIT.UPDATE.LINES \TEDIT.FORMATLINE)
|
||||
(RECORDS LINEDESCRIPTOR)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-2025 16:05:23" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;849)
|
||||
:PREVIOUS-DATE " 6-Mar-2025 11:42:48" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;867)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||
@@ -53,9 +55,9 @@
|
||||
(GLOBALVARS TEDIT.LINELEADING.BELOW)
|
||||
(FNS \TLVALIDATE)
|
||||
(* ; "Consistency checking")
|
||||
(INITVARS *TEDIT-CACHED-FMTSPEC*)
|
||||
(INITVARS *TEDIT-CACHED-PARALOOKS*)
|
||||
(* ; "Heuristic for \FORMATLINE")
|
||||
(GLOBALVARS *TEDIT-CACHED-FMTSPEC*)
|
||||
(GLOBALVARS *TEDIT-CACHED-PARALOOKS*)
|
||||
(FNS \TEDIT.DISPLAYLINE \TEDIT.DISPLAYLINE.TABS \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE
|
||||
\TEDIT.BLTCHAR \TEDIT.DIACRITIC.SHIFT)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -134,10 +136,10 @@
|
||||
LMARK (* ; "One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)")
|
||||
LTEXTSTREAM (* ; "A cached textstream that this line took its text from. Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity.")
|
||||
NIL (* ; "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ")
|
||||
NIL (* ;
|
||||
"Was LDOBJ: The object which lies behind this line of text, for updating, etc.")
|
||||
LFMTSPEC (* ;
|
||||
"The format spec for this line's paragraph (eventually)")
|
||||
LFIRSTSEPR (* ;
|
||||
"Character position of the first separator on the line, for detecting the last valid line.")
|
||||
LPARALOOKS (* ;
|
||||
"The paragraph looks for this line's paragraph (eventually)")
|
||||
(NIL FLAG) (* ;
|
||||
"Was LDIRTY: T if this line has changed since it was last formatted.")
|
||||
(NIL FLAG) (* ; "Was FORCED-END flag")
|
||||
@@ -687,6 +689,12 @@
|
||||
|
||||
(\TEDIT.FORMATLINE
|
||||
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 29-Mar-2025 11:39 by rmk")
|
||||
(* ; "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")
|
||||
@@ -709,7 +717,7 @@
|
||||
(DECLARE (SPECVARS TSTREAM))
|
||||
|
||||
(* ;;
|
||||
"Note that lines lie within paragraphs, and all pieces within a paragraph have the same FMTSPEC.")
|
||||
"Note that lines lie within paragraphs, and all pieces within a paragraph have the same PARALOOKS.")
|
||||
|
||||
(* ;; "The SPECVARS are accessed and reset under the subfunction\FORMATLINE.UPDATELOOKS, IMAGESTREAM and FORMATTINGSTATE are passed only for hardcopy. ")
|
||||
|
||||
@@ -755,9 +763,9 @@
|
||||
(SPACELEFT 0)
|
||||
(TX 0)
|
||||
(BOXSTREAM IMAGESTREAM)
|
||||
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)
|
||||
THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS 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 FIRSTSEPR)
|
||||
(DECLARE (SPECVARS TEXTOBJ LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT
|
||||
START-OF-PIECE HASKERN UNBREAKABLE))
|
||||
(CL:UNLESS LINE
|
||||
@@ -817,16 +825,16 @@
|
||||
|
||||
(SETQ LINETYPE (if (NOT (DISPLAYSTREAMP IMAGESTREAM))
|
||||
then 'TRUEHARDCOPY
|
||||
elseif (FGETPARA (PPARALOOKS PC)
|
||||
elseif (FGETPLOOKS (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 LFMTSPEC, the IMAGESTREAM is unmodified.")
|
||||
(* ;; "The unchanging paragraph look has now been established and scaled appropriately. It is returned in the LPARALOOKS, the IMAGESTREAM is unmodified.")
|
||||
|
||||
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(SETQ SCALE (FGETPARA FMTSPEC FMTHARDCOPYSCALE))
|
||||
(SETQ PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(SETQ SCALE (FGETPLOOKS PARALOOKS FMTHARDCOPYSCALE))
|
||||
[if (REGIONP REGION)
|
||||
then (SETQ WMARGIN (ffetch (REGION LEFT) of REGION))
|
||||
(* ;
|
||||
@@ -836,14 +844,14 @@
|
||||
"A little more display margin on both sides")
|
||||
(SETQ WIDTH (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT)
|
||||
(UNFOLD WMARGIN 2]
|
||||
(SETQ RIGHTMARGIN (if (ZEROP (FGETPARA FMTSPEC RIGHTMAR))
|
||||
(SETQ RIGHTMARGIN (if (ZEROP (FGETPLOOKS PARALOOKS RIGHTMAR))
|
||||
then
|
||||
(* ;; "RIGHTMAR = 0 => follow the window/region's width")
|
||||
|
||||
(CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(ITIMES SCALE WIDTH)
|
||||
WIDTH)
|
||||
else (FGETPARA FMTSPEC RIGHTMAR)))
|
||||
else (FGETPLOOKS PARALOOKS RIGHTMAR)))
|
||||
|
||||
(* ;; "Account for first-line indentation from the true left margin (LEFTMAR)")
|
||||
|
||||
@@ -854,8 +862,8 @@
|
||||
(OR (NOT (\PREV.VISIBLE.PIECE PC))
|
||||
(PPARALAST (\PREV.VISIBLE.PIECE PC]
|
||||
(SETQ LX1 (CL:IF 1STLN
|
||||
(FGETPARA FMTSPEC 1STLEFTMAR)
|
||||
(FGETPARA FMTSPEC LEFTMAR)))
|
||||
(FGETPLOOKS PARALOOKS 1STLEFTMAR)
|
||||
(FGETPLOOKS PARALOOKS LEFTMAR)))
|
||||
(SETQ WIDTH (IDIFFERENCE RIGHTMARGIN LX1))
|
||||
|
||||
(* ;; "")
|
||||
@@ -881,7 +889,7 @@
|
||||
(bind CH DX BOX INSPACES FIRSTWHITESLOT PREVCH KERN (FIRSTWHITEX _ TX)
|
||||
(INWORD _ T)
|
||||
(LASTCHARSLOT _ (LASTCHARSLOT THISLINE))
|
||||
(JUSTIFIED _ (EQ 'JUSTIFIED (FGETPARA FMTSPEC QUAD)))
|
||||
(JUSTIFIED _ (EQ 'JUSTIFIED (FGETPLOOKS PARALOOKS QUAD)))
|
||||
(TEXTLEN _ (TEXTLEN TEXTOBJ)) for old CHNO by 1 while (ILEQ CHNO TEXTLEN)
|
||||
while (SETQ CH (BIN TSTREAM))
|
||||
do
|
||||
@@ -934,7 +942,8 @@
|
||||
(SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN)
|
||||
CH BOXSTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(SCALEDOWN SCALE WIDTH)
|
||||
WIDTH)))
|
||||
WIDTH)
|
||||
TSTREAM))
|
||||
(IMAGEOBJPROP CH 'BOUNDBOX BOX)
|
||||
(SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE (fetch (IMAGEBOX YSIZE)
|
||||
of BOX)
|
||||
@@ -964,7 +973,8 @@
|
||||
(* ;; "Not including this space in the justifying chain, so it won't expand. If that looks odd, let it fall through to the PUSHCHAR below.")
|
||||
|
||||
(PUSHCHAR CHARSLOT CH DX)
|
||||
else (SPACEBREAK)
|
||||
else (CL:UNLESS FIRSTSEPR (SETQ FIRSTSEPR CHNO))
|
||||
(SPACEBREAK)
|
||||
(add TX DX)
|
||||
(SAVEBREAK)
|
||||
|
||||
@@ -979,6 +989,8 @@
|
||||
|
||||
(* ;; "Remove all prior candidate break points and expandable spaces")
|
||||
|
||||
(CL:UNLESS (OR FIRSTSEPR UNBREAKABLE)
|
||||
(SETQ FIRSTSEPR CHNO))
|
||||
(FORGETPREVIOUSBREAK)
|
||||
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
|
||||
|
||||
@@ -986,8 +998,8 @@
|
||||
(* ;
|
||||
"Start with 0 width, then set up the next tab")
|
||||
(FILLCHARSLOT CHARSLOT CH 0)
|
||||
(SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE CHARSLOT LX1
|
||||
TX TABPENDING))
|
||||
(SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE CHARSLOT
|
||||
LX1 TX TABPENDING))
|
||||
(* ;
|
||||
"Proper width is already in CHARSLOT")
|
||||
(SETQ DX (CL:IF (FIXP TABPENDING)
|
||||
@@ -1006,7 +1018,9 @@
|
||||
(SETQ INSPACES NIL)
|
||||
(CL:UNLESS (DIACRITICP CH)
|
||||
|
||||
(* ;; "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. ")
|
||||
(* ;; "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.")
|
||||
|
||||
(add TX DX))
|
||||
(CL:WHEN (IGREATERP TX WIDTH)
|
||||
@@ -1084,8 +1098,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 FMTSPEC SCALE CHARSLOT LX1
|
||||
TX TABPENDING T))
|
||||
(\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE CHARSLOT
|
||||
LX1 TX TABPENDING T))
|
||||
(* ;
|
||||
"Tab over to the LEFT side of the decimal point.")
|
||||
(add TX (CL:IF (FIXP TABPENDING)
|
||||
@@ -1161,8 +1175,8 @@
|
||||
(CL:WHEN TABPENDING
|
||||
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
|
||||
(* ; "Don't justify spaces before tabs")
|
||||
(add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE (fetch (PENDINGTAB PTCHARSLOT)
|
||||
of TABPENDING)
|
||||
(add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE (fetch (PENDINGTAB PTCHARSLOT)
|
||||
of TABPENDING)
|
||||
LX1
|
||||
(IDIFFERENCE TX OVERHANG)
|
||||
TABPENDING T)))
|
||||
@@ -1172,6 +1186,7 @@
|
||||
(* ;;
|
||||
"All the line information is now in our variables. Migrate to the LINE and THISLINE fields. ")
|
||||
|
||||
(FSETLD LINE LFIRSTSEPR (OR FIRSTSEPR (ADD1 CHNO)))(* ; "For detecting last valid line")
|
||||
(FSETLD LINE LCHAR1 CH#1)
|
||||
(FSETLD LINE LCHARLAST CHNO)
|
||||
(FSETLD LINE LX1 LX1) (* ;
|
||||
@@ -1184,19 +1199,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 (FGETPARA FMTSPEC FMTPARATYPE)
|
||||
(OR (EQ (FGETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
'PAGEHEADING)
|
||||
(FGETPARA FMTSPEC FMTNEWPAGEBEFORE)
|
||||
(FGETPARA FMTSPEC FMTNEWPAGEAFTER)
|
||||
[AND (FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALX]
|
||||
(AND (FGETPARA FMTSPEC FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY]
|
||||
(FGETPLOOKS PARALOOKS FMTNEWPAGEBEFORE)
|
||||
(FGETPLOOKS PARALOOKS FMTNEWPAGEAFTER)
|
||||
[AND (FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALX]
|
||||
(AND (FGETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALY]
|
||||
'GREY))
|
||||
(FSETLD LINE FORCED-END FORCED-END)
|
||||
(FSETLD LINE LEFTMARGIN (CL:IF 1STLN
|
||||
(FGETPARA FMTSPEC 1STLEFTMAR)
|
||||
(FGETPARA FMTSPEC LEFTMAR)))
|
||||
(FGETPLOOKS PARALOOKS 1STLEFTMAR)
|
||||
(FGETPLOOKS PARALOOKS LEFTMAR)))
|
||||
(FSETLD LINE RIGHTMARGIN RIGHTMARGIN)
|
||||
(CL:UNLESS FONT
|
||||
|
||||
@@ -1216,7 +1231,7 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(FSETLD LINE LFMTSPEC FMTSPEC)
|
||||
(FSETLD LINE LPARALOOKS PARALOOKS)
|
||||
(CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY)
|
||||
|
||||
(* ;; "Used temporarily and cleared by \TEDIT.FORMATBOX; not an XPOINTER")
|
||||
@@ -1229,12 +1244,12 @@
|
||||
(* ;; "Finally translate to the left edge, perhsps a specialx if true hardcopy.")
|
||||
|
||||
(CL:WHEN [AND (EQ LINETYPE 'TRUEHARDCOPY)
|
||||
(FGETPARA FMTSPEC FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALX]
|
||||
(FGETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
(NOT (ZEROP (FGETPLOOKS PARALOOKS FMTSPECIALX]
|
||||
|
||||
(* ;; "Maybe SETQ instead of add ??")
|
||||
|
||||
(add WMARGIN (FGETPARA FMTSPEC FMTSPECIALX)))
|
||||
(add WMARGIN (FGETPLOOKS PARALOOKS FMTSPECIALX)))
|
||||
(add (FGETLD LINE LEFTMARGIN)
|
||||
WMARGIN)
|
||||
(add (FGETLD LINE RIGHTMARGIN)
|
||||
@@ -1253,7 +1268,10 @@
|
||||
(RETURN LINE])
|
||||
|
||||
(\TEDIT.FORMATLINE.SETUP.PARA
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 22-Nov-2024 11:14 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 15:08 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:01 by rmk")
|
||||
@@ -1264,57 +1282,59 @@
|
||||
(* ; "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 FMTSPEC 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 PARALOOKS of PC is stored in LINE.")
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;; "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 LASTPIECE))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE]
|
||||
(LET ([PLOOKS (PARALOOKS! (PPARALOOKS (OR PC (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE]
|
||||
SCALE)
|
||||
(SETQ PLOOKS (\TEDIT.APPLY.PARASTYLES PLOOKS PC TEXTOBJ))
|
||||
(SELECTQ LINETYPE
|
||||
(TRUEHARDCOPY (SETQ PLOOKS (\TEDIT.HCPYFMTSPEC PLOOKS IMAGESTREAM)))
|
||||
(TRUEDISPLAY (CL:UNLESS (FGETPARA PLOOKS FMTHARDCOPYSCALE)
|
||||
(FSETPARA PLOOKS FMTHARDCOPYSCALE 1)))
|
||||
(TRUEDISPLAY (CL:UNLESS (FGETPLOOKS PLOOKS FMTHARDCOPYSCALE)
|
||||
(FSETPLOOKS PLOOKS FMTHARDCOPYSCALE 1)))
|
||||
(HARDCOPYDISPLAY
|
||||
(* ;; "Coerce the image stream and FMTSPEC for HARDCOPYDISPLAY.")
|
||||
(* ;; "Coerce the image stream and PARALOOKS for HARDCOPYDISPLAY.")
|
||||
|
||||
[SETQ IMAGESTREAM (OR (FGETTOBJ TEXTOBJ DISPLAYHCPYDS)
|
||||
(FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM
|
||||
'{NODIRCORE}
|
||||
'POSTSCRIPT]
|
||||
(SETQ SCALE (DSPSCALE NIL IMAGESTREAM))
|
||||
[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
|
||||
])
|
||||
[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])
|
||||
(\TEDIT.THELP "BAD LINE TYPE" LINETYPE))
|
||||
(CL:UNLESS (OR (EQ PLOOKS *TEDIT-CACHED-FMTSPEC*)
|
||||
(NOT (FGETPARA PLOOKS FMTCHARSTYLES)))
|
||||
(CL:UNLESS (OR (EQ PLOOKS *TEDIT-CACHED-PARALOOKS*)
|
||||
(NOT (FGETPLOOKS 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-FMTSPEC* PLOOKS))
|
||||
(SETLD LINE LFMTSPEC PLOOKS)
|
||||
(SETQ *TEDIT-CACHED-PARALOOKS* PLOOKS))
|
||||
(SETLD LINE LPARALOOKS PLOOKS)
|
||||
IMAGESTREAM])
|
||||
|
||||
(\TEDIT.FORMATLINE.HORIZONTAL
|
||||
[LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 15-Mar-2024 19:35 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 3-Dec-2023 16:49 by rmk")
|
||||
(* ; "Edited 29-Oct-2023 18:24 by rmk")
|
||||
(* ; "Edited 2-Jul-2023 15:15 by rmk")
|
||||
@@ -1337,13 +1357,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* ((FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(SCALE (ffetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC)))
|
||||
(LET* ((PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(SCALE (FGETPLOOKS PARALOOKS FMTHARDCOPYSCALE)))
|
||||
|
||||
(* ;; "Distribute SPACELEFT according to QUAD. ")
|
||||
|
||||
(freplace (THISLINE TLSPACEFACTOR) of THISLINE with 1)
|
||||
(CL:WHEN (EQ 'JUSTIFIED (fetch (FMTSPEC QUAD) of FMTSPEC))
|
||||
(CL:WHEN (EQ 'JUSTIFIED (GETPLOOKS PARALOOKS QUAD))
|
||||
(\TEDIT.FORMATLINE.JUSTIFY LINE THISLINE PREVSP SPACELEFT LINETYPE))
|
||||
(\TEDIT.FORMATLINE.PURGE.SPACES PREVSP)
|
||||
|
||||
@@ -1370,7 +1390,7 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(SELECTQ (ffetch (FMTSPEC QUAD) of FMTSPEC)
|
||||
(SELECTQ (FGETPLOOKS PARALOOKS QUAD)
|
||||
(RIGHT (* ; "Move over to the right margin")
|
||||
(add (FGETLD LINE LX1 LINE)
|
||||
SPACELEFT)
|
||||
@@ -1384,7 +1404,9 @@
|
||||
NIL])
|
||||
|
||||
(\TEDIT.FORMATLINE.VERTICAL
|
||||
[LAMBDA (LINE TEXTOBJ) (* ; "Edited 29-Oct-2024 11:07 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 26-Oct-2024 10:26 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 07:26 by rmk")
|
||||
(* ; "Edited 17-Dec-2023 00:43 by rmk")
|
||||
@@ -1395,17 +1417,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 ((FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(LET ((PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(ASCENT (FGETLD LINE LTRUEASCENT))
|
||||
(DESCENT (FGETLD LINE LTRUEDESCENT)))
|
||||
(CL:WHEN (FGETLD LINE 1STLN LINE) (* ; "Set pre-paragraph leading")
|
||||
(add ASCENT (FGETPARA FMTSPEC LEADBEFORE)))
|
||||
(add ASCENT (FGETPLOOKS PARALOOKS LEADBEFORE)))
|
||||
(CL:WHEN (FGETLD LINE LSTLN) (* ; "Set post-paragraph leading")
|
||||
(add DESCENT (FGETPARA FMTSPEC LEADAFTER)))
|
||||
(add DESCENT (FGETPLOOKS PARALOOKS 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 (FGETPARA FMTSPEC LINELEAD))
|
||||
(add ASCENT (FGETPLOOKS PARALOOKS LINELEAD))
|
||||
(FSETLD LINE LASCENT ASCENT)
|
||||
(FSETLD LINE LDESCENT DESCENT)
|
||||
(FSETLD LINE LHEIGHT (IPLUS ASCENT DESCENT])
|
||||
@@ -1487,7 +1509,9 @@
|
||||
NATURALWIDTHS))))])
|
||||
|
||||
(\TEDIT.FORMATLINE.TABS
|
||||
[LAMBDA (TEXTOBJ FMTSPEC SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP)
|
||||
[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")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 18:29 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 20:49 by rmk")
|
||||
@@ -1520,8 +1544,8 @@
|
||||
(add TX LX1) (* ; "Margin relative")
|
||||
(PROG (NEXTTAB NEXTTABTYPE NEXTTABX DFLTTABX GRAIN (PRIORTABWIDTH 0)
|
||||
(THISTABWIDTH 0)
|
||||
(TABS (FGETPARA FMTSPEC FMTTABS))
|
||||
(DEFTAB (FGETPARA FMTSPEC FMTDEFAULTTAB)))
|
||||
(TABS (FGETPLOOKS PARALOOKS FMTTABS))
|
||||
(DEFTAB (FGETPLOOKS PARALOOKS 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")
|
||||
@@ -1639,7 +1663,10 @@
|
||||
finally (RETURN CS)))])
|
||||
|
||||
(\TEDIT.FORMATLINE.EMPTY
|
||||
[LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 22-Nov-2024 22:29 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 17-Nov-2024 16:00 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 14:51 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 14:51 by rmk")
|
||||
@@ -1666,17 +1693,17 @@
|
||||
(\TEDIT.FORMATLINE.SETUP.PARA TEXTOBJ NIL LINE (WINDOWPROP (\TEDIT.PRIMARYPANE TEXTOBJ)
|
||||
'DSP)
|
||||
'TRUEDISPLAY)
|
||||
(SETQ PLOOKS (FGETLD LINE LFMTSPEC))
|
||||
(SETQ PLOOKS (FGETLD LINE LPARALOOKS))
|
||||
|
||||
(* ;; "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 LASTPIECE))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE]
|
||||
[SETQ CLOOKS (PCHARLOOKS (OR (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE]
|
||||
(SETQ FONT (GETCLOOKS CLOOKS CLFONT))
|
||||
(SETQ TRUEASCENT (FONTPROP FONT 'ASCENT))
|
||||
(SETQ TRUEDESCENT (FONTPROP FONT 'DESCENT))
|
||||
(SETQ LM (IPLUS \TEDIT.LINEREGION.WIDTH (FGETTOBJ TEXTOBJ WLEFT)
|
||||
(FGETPARA PLOOKS 1STLEFTMAR)))
|
||||
(FGETPLOOKS PLOOKS 1STLEFTMAR)))
|
||||
(with LINEDESCRIPTOR LINE (SETQ LDUMMY T)
|
||||
(SETQ LCHAR1 CH#1)
|
||||
(SETQ LCHARLAST CH#1)
|
||||
@@ -1687,12 +1714,12 @@
|
||||
(SETQ LXLIM LM)
|
||||
(SETQ FORCED-END (CHARCODE EOL))
|
||||
(SETQ LHASPROT NIL)
|
||||
(SETQ LFMTSPEC PLOOKS)
|
||||
(SETQ LPARALOOKS PLOOKS)
|
||||
(SETQ LEFTMARGIN LM)
|
||||
(SETQ RIGHTMARGIN (CL:IF (ZEROP (FGETPARA PLOOKS RIGHTMAR))
|
||||
(SETQ RIGHTMARGIN (CL:IF (ZEROP (FGETPLOOKS PLOOKS RIGHTMAR))
|
||||
(IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT)
|
||||
\TEDIT.LINEREGION.WIDTH)
|
||||
(FGETPARA PLOOKS RIGHTMAR)))
|
||||
(FGETPLOOKS PLOOKS RIGHTMAR)))
|
||||
(SETQ LTRUEASCENT TRUEASCENT)
|
||||
(SETQ LTRUEDESCENT TRUEDESCENT)
|
||||
(SETQ LHEIGHT (IPLUS TRUEASCENT TRUEDESCENT)))
|
||||
@@ -1836,7 +1863,8 @@
|
||||
T)])
|
||||
|
||||
(\TEDIT.LINES.ABOVE
|
||||
[LAMBDA (TSTREAM CHN BOTTOMY) (* ; "Edited 24-Nov-2024 11:47 by rmk")
|
||||
[LAMBDA (TSTREAM CHN BOTTOMY) (* ; "Edited 30-Mar-2025 09:09 by rmk")
|
||||
(* ; "Edited 24-Nov-2024 11:47 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 12:37 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 16:02 by rmk")
|
||||
(* ; "Edited 2-Nov-2024 23:21 by rmk")
|
||||
@@ -1854,27 +1882,32 @@
|
||||
|
||||
(* ;; "We assume this is not called on an empty text (TEXTLEN = 0), since we wouldn't know what to return. Caller should check that.")
|
||||
|
||||
(* ;; "If CHN is a line, this creates all lines preceding it in its paragraph.")
|
||||
|
||||
(CL:WHEN (type? LINEDESCRIPTOR CHN)
|
||||
(SETQ BOTTOMY (FGETLD CHN YTOP))
|
||||
(SETQ CHN (SUB1 (FGETLD CHN LCHAR1))))
|
||||
(bind LTOP LBOT LINE HEIGHT CHNO (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ))
|
||||
first (CL:WHEN (IGREATERP CHN (TEXTLEN TEXTOBJ))
|
||||
(SETQ CHN (TEXTLEN TEXTOBJ)))
|
||||
(SETQ CHNO (\TEDIT.PREVIOUS.LINEBREAK TSTREAM CHN))
|
||||
(* ; "The end-of-line character")
|
||||
(SETQ LTOP (\TEDIT.FORMATLINE TSTREAM CHNO)) (* ; "A line containiing only the EOL")
|
||||
(* ; "The character after the EOL")
|
||||
(SETQ LTOP (\TEDIT.FORMATLINE TSTREAM CHNO)) (* ; "The line after the EOL")
|
||||
(SETQ LBOT LTOP)
|
||||
(SETQ CHNO (FGETLD LTOP LCHARLIM)) until (IGREATERP CHNO CHN)
|
||||
do (SETQ LINE (\TEDIT.FORMATLINE TSTREAM CHNO))
|
||||
(LINKLD LBOT LINE)
|
||||
(SETQ LBOT LINE)
|
||||
(SETQ CHNO (FGETLD LINE LCHARLIM)) finally
|
||||
(SETQ CHNO (FGETLD LTOP LCHARLIM)) (* ; "First char of second line")
|
||||
until (IGREATERP CHNO CHN) do (SETQ LINE (\TEDIT.FORMATLINE TSTREAM CHNO))
|
||||
(LINKLD LBOT LINE)
|
||||
(SETQ LBOT LINE)
|
||||
(SETQ CHNO (FGETLD LINE LCHARLIM))
|
||||
finally
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"We now have the line chain, but they aren't positioned. Set the YBOT of LBOT to BOTTOMY")
|
||||
|
||||
(CL:WHEN BOTTOMY
|
||||
(for L (YB _ BOTTOMY) backlines LBOT
|
||||
do (SETYBOT L YB)
|
||||
(add YB (FGETLD L LHEIGHT))))
|
||||
(RETURN (CONS LTOP LBOT])
|
||||
(CL:WHEN BOTTOMY
|
||||
(for L (YB _ BOTTOMY) backlines LBOT do (SETYBOT L YB)
|
||||
(add YB (FGETLD L LHEIGHT))))
|
||||
(RETURN (CONS LTOP LBOT])
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.LINELEADING.BELOW NIL)
|
||||
@@ -1919,7 +1952,7 @@
|
||||
(* ; "Consistency checking")
|
||||
|
||||
|
||||
(RPAQ? *TEDIT-CACHED-FMTSPEC* NIL)
|
||||
(RPAQ? *TEDIT-CACHED-PARALOOKS* NIL)
|
||||
|
||||
|
||||
|
||||
@@ -1927,12 +1960,14 @@
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-CACHED-FMTSPEC*)
|
||||
(GLOBALVARS *TEDIT-CACHED-PARALOOKS*)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.DISPLAYLINE
|
||||
[LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 13-Dec-2024 23:51 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 11-Dec-2024 23:14 by rmk")
|
||||
(* ; "Edited 31-Oct-2024 09:56 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 10:43 by rmk")
|
||||
@@ -2103,10 +2138,10 @@
|
||||
'INPUT
|
||||
'REPLACE) (* ;
|
||||
"Paint the cached image on the screen (this lessens flicker during update)")
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED) of (FGETLD LINE LFMTSPEC))
|
||||
(* ;
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED) (* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LFMTSPEC)
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LPARALOOKS)
|
||||
WINDOWDS LINE))
|
||||
(SELECTQ (FGETLD LINE LMARK)
|
||||
(GREY (* ;
|
||||
@@ -2121,6 +2156,8 @@
|
||||
|
||||
(\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")
|
||||
@@ -2128,20 +2165,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 FMTSPEC. TEXTOBJ only needed to get the hardcopy-display stream. ")
|
||||
(* ;; "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. ")
|
||||
|
||||
(bind TTX DOTWIDTH (FMTSPEC _ (GETLD LINE LFMTSPEC))
|
||||
(bind TTX DOTWIDTH (PARALOOKS _ (GETLD LINE LPARALOOKS))
|
||||
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 (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC)
|
||||
[HCUNSCALE (fetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC)
|
||||
[SETQ DOTWIDTH (CL:IF (GETPLOOKS PARALOOKS FMTHARDCOPY)
|
||||
[HCUNSCALE (FGETPLOOKS PARALOOKS FMTHARDCOPYSCALE)
|
||||
(CHARWIDTH (CHARCODE %.)
|
||||
(FONTCOPY (fetch CLFONT of CLOOKS)
|
||||
(FONTCOPY (GETCLOOKS CLOOKS CLFONT)
|
||||
'DEVICE
|
||||
(FGETTOBJ TEXTOBJ DISPLAYHCPYDS]
|
||||
(CHARWIDTH (CHARCODE %.)
|
||||
(fetch CLFONT of CLOOKS)))]
|
||||
(GETCLOOKS CLOOKS CLFONT)))]
|
||||
[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")
|
||||
@@ -2322,7 +2359,8 @@
|
||||
1)])
|
||||
|
||||
(\TEDIT.UPDATE.LINES
|
||||
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 1-Feb-2025 10:34 by rmk")
|
||||
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 30-Mar-2025 10:02 by rmk")
|
||||
(* ; "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")
|
||||
@@ -2357,7 +2395,7 @@
|
||||
(CL:UNLESS NCHARSCHANGED
|
||||
(SETQ NCHARSCHANGED (FGETTOBJ TEXTOBJ TEXTLEN)))]
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(for PANE VALIDS LASTVALID NEXTVALID LASTGAPLINE UPPERBITMAPLINES BITMAPLINES inpanes TEXTOBJ
|
||||
(for PANE VALIDS LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES inpanes TEXTOBJ
|
||||
when (SETQ VALIDS (\TEDIT.VALID.LINES PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON
|
||||
(FGETTOBJ TEXTOBJ STREAMHINT)))
|
||||
do
|
||||
@@ -2381,14 +2419,12 @@
|
||||
|
||||
(* ;; "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)))])
|
||||
(\TEDIT.SHIFTLINES LASTVALID PANE TEXTOBJ BITMAPLINES)))])
|
||||
|
||||
(\TEDIT.PANE.CREATELINES
|
||||
[LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 29-Nov-2024 09:14 by rmk")
|
||||
[LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 28-Mar-2025 20:55 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:52 by rmk")
|
||||
(* ; "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")
|
||||
@@ -2428,9 +2464,10 @@
|
||||
LDESCENT _ 0
|
||||
LTRUEASCENT _ 0
|
||||
LTRUEDESCENT _ 0
|
||||
LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC
|
||||
LPARALOOKS _ TEDIT.DEFAULT.FMTSPEC
|
||||
1STLN _ NIL
|
||||
LSTLN _ NIL))
|
||||
LSTLN _ NIL
|
||||
LFIRSTSEPR _ MAX.FIXP))
|
||||
(SETYBOT PREFIX (OR YBOT (PANEHEIGHT PANE)))
|
||||
(FSETPANEPROP (PANEPROPS PANE)
|
||||
PREFIXLINE PREFIX)
|
||||
@@ -2438,7 +2475,8 @@
|
||||
PREFIX])
|
||||
|
||||
(\TEDIT.SUFFIXLINE.CREATE
|
||||
[LAMBDA (PANE TEXTOBJ PREVLINE) (* ; "Edited 29-Nov-2024 10:54 by rmk")
|
||||
[LAMBDA (PANE TEXTOBJ PREVLINE) (* ; "Edited 28-Mar-2025 20:56 by rmk")
|
||||
(* ; "Edited 29-Nov-2024 10:54 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 10:22 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 14:25 by rmk")
|
||||
|
||||
@@ -2455,7 +2493,7 @@
|
||||
(CL:WHEN (FGETLD PREVLINE FORCED-END)
|
||||
(SETQ EMPTYLINE (create LINEDESCRIPTOR using SUFFIX LDUMMY _ NIL LCHARLIM _
|
||||
(FGETLD SUFFIX LCHAR1)
|
||||
FORCED-END _ NIL))
|
||||
FORCED-END _ NIL LFIRSTSEPR _ MAX.FIXP))
|
||||
(LINKLD PREVLINE EMPTYLINE)
|
||||
(LINKLD EMPTYLINE SUFFIX))
|
||||
SUFFIX])
|
||||
@@ -2543,6 +2581,8 @@
|
||||
|
||||
(\TEDIT.VALID.LINES
|
||||
[LAMBDA (PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON TSTREAM)
|
||||
(* ; "Edited 30-Mar-2025 09:12 by rmk")
|
||||
(* ; "Edited 27-Mar-2025 12:40 by rmk")
|
||||
(* ; "Edited 21-Jan-2025 15:22 by rmk")
|
||||
(* ; "Edited 6-Jan-2025 15:19 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 16:54 by rmk")
|
||||
@@ -2590,9 +2630,10 @@
|
||||
|
||||
(* ;; "Note that this is mostly an optimization to avoid unnecessary reformatting and redisplaying of still-valid lines in favor of bitbltting a block of their currently visible images. Smashing all lines to NIL and refilling each pane would also give the correct behavior, but slower. Intermediate would be smashing all lines below the last valid.")
|
||||
|
||||
(* ;; "LASTCHANGEDCHNO is in the before-change sequence. I.e., if FIRST is 5 and 6 were being deleted, then it is 10. But it doesn't correspond to the surviving line positions after they have been adjusted. It would have to be adjusted too.")
|
||||
|
||||
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
|
||||
(LASTCHANGEDCHNO (SUB1 (IPLUS FIRSTCHANGEDCHNO NCHARSCHANGED)))
|
||||
(PREFIXLINE (PANEPREFIX PANE))
|
||||
(SUFFIXLINE (PANESUFFIX PANE))
|
||||
(DELTA (SELECTQ REASON
|
||||
(INSERTION NCHARSCHANGED)
|
||||
@@ -2600,15 +2641,10 @@
|
||||
((CHANGED LOOKS)
|
||||
NIL)
|
||||
(\TEDIT.THELP "BAD REASONS FOR VALID LINES")))
|
||||
FIRSTVISIBLECHNO LASTVISIBLECHNO FIRSTCHANGEDLINE LASTCHANGEDLINE LASTVALIDLINE
|
||||
NEXTVALIDLINE)
|
||||
FIRSTCHANGEDLINE LASTCHANGEDLINE LASTVALIDLINE NEXTVALIDLINE LINESABOVE)
|
||||
(CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ)) (* ; "Empty document")
|
||||
(RETURN (CONS PREFIXLINE)))
|
||||
(CL:UNLESS SUFFIXLINE
|
||||
(\TEDIT.THELP "NO SUFFIXLINE")
|
||||
(RETURN NIL))
|
||||
(SETQ LASTVISIBLECHNO (SUB1 (FGETLD SUFFIXLINE LCHAR1)))
|
||||
(CL:WHEN (IGREATERP FIRSTCHANGEDCHNO LASTVISIBLECHNO)
|
||||
(RETURN (CONS (PANEPREFIX PANE))))
|
||||
(CL:WHEN (IGEQ FIRSTCHANGEDCHNO (FGETLD SUFFIXLINE LCHAR1))
|
||||
(* ;
|
||||
"Change after previously visible lines")
|
||||
(CL:UNLESS (ILEQ LASTCHANGEDCHNO (TEXTLEN TEXTOBJ))
|
||||
@@ -2620,17 +2656,13 @@
|
||||
|
||||
(\TEDIT.INSERTLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO)
|
||||
SUFFIXLINE))
|
||||
(SETQ FIRSTVISIBLECHNO (FGETLD PREFIXLINE LCHARLIM))
|
||||
(SETQ FIRSTCHANGEDLINE (find L inlines (FGETLD PREFIXLINE NEXTLINE)
|
||||
suchthat (FWITHINLINEP FIRSTCHANGEDCHNO L)))
|
||||
(CL:UNLESS FIRSTCHANGEDLINE (* ; "Changes are not visible")
|
||||
(SETQ FIRSTCHANGEDLINE (find L inlines (PANEPREFIX PANE) suchthat (FWITHINLINEP
|
||||
FIRSTCHANGEDCHNO L
|
||||
)))
|
||||
(CL:UNLESS FIRSTCHANGEDLINE (* ; "Change is below PANE")
|
||||
(RETURN NIL))
|
||||
|
||||
(* ;; "Change is visible in PANE, look for the last valid line (in PANE).")
|
||||
|
||||
(SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTVISIBLECHNO PANE TSTREAM))
|
||||
|
||||
(* ;; "Now for the after-change lines")
|
||||
(* ;; "Change starts above or inside PANE, Where does it end?")
|
||||
|
||||
(SETQ LASTCHANGEDLINE (find L inlines FIRSTCHANGEDLINE suchthat (FWITHINLINEP
|
||||
LASTCHANGEDCHNO L)))
|
||||
@@ -2640,6 +2672,10 @@
|
||||
"Last changed line is visible, its changes may cause character to shift to or from lower lines.")
|
||||
|
||||
(SETQ NEXTVALIDLINE (\TEDIT.NEXTVALIDLINE LASTCHANGEDLINE TSTREAM)))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM))
|
||||
(CL:WHEN NEXTVALIDLINE
|
||||
(FSETLD NEXTVALIDLINE PREVLINE NIL)
|
||||
(CL:WHEN DELTA
|
||||
@@ -2658,7 +2694,9 @@
|
||||
(RETURN (CONS LASTVALIDLINE NEXTVALIDLINE)))])
|
||||
|
||||
(\TEDIT.LASTVALIDLINE
|
||||
[LAMBDA (FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 29-Nov-2024 09:14 by rmk")
|
||||
[LAMBDA (FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 30-Mar-2025 10:00 by rmk")
|
||||
(* ; "Edited 18-Feb-2025 12:45 by rmk")
|
||||
(* ; "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")
|
||||
@@ -2675,43 +2713,29 @@
|
||||
|
||||
(* ;; "A line L is impervious to a change in L+1 if it has a forced end, or if L has at least one separator (space, tab) prior to its change point. The change point is FIRSTCHANGEDCHNO for the first line. If we have to go to earlier lines, then any separator anywhere on the line (at or before LCHARLAST) will stop the back-propagation.")
|
||||
|
||||
(LET* ((PREFIXLINE (PANEPREFIX PANE))
|
||||
(FIRSTPANECHAR (AND (FGETLD PREFIXLINE NEXTLINE)
|
||||
(FGETLD (FGETLD PREFIXLINE NEXTLINE)
|
||||
LCHAR1)))
|
||||
PREV)
|
||||
(if (bind (L _ FIRSTCHANGEDLINE)
|
||||
(LIMCHAR _ (SUB1 FIRSTCHANGEDCHNO)) while (SETQ PREV (FGETLD L PREVLINE))
|
||||
do
|
||||
(* ;; "The previous line is valid if its ending was forced, or if L has at least one space/tab earlier then the limit. Note that PREFIXLINE is always forced-end, it stops the iteration..")
|
||||
(if (ILESSP (FGETLD FIRSTCHANGEDLINE LFIRSTSEPR)
|
||||
FIRSTCHANGEDCHNO)
|
||||
then (FGETLD FIRSTCHANGEDLINE PREVLINE)
|
||||
elseif (for L (TOPLINE _ (PANETOPLINE PANE)) backlines (FGETLD FIRSTCHANGEDLINE PREVLINE)
|
||||
do
|
||||
(* ;; "Line with a forced end is valid")
|
||||
|
||||
(CL:WHEN (FGETLD PREV FORCED-END)
|
||||
(RETURN (if (NEQ PREFIXLINE PREV)
|
||||
then PREV
|
||||
elseif (EQ 1 FIRSTPANECHAR)
|
||||
then (* ; "PANE is at the top")
|
||||
PREFIXLINE)))
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (FGETLD L LCHAR1)))
|
||||
(CL:WHEN [find I from 1 to (IDIFFERENCE LIMCHAR (FGETLD L LCHAR1))
|
||||
suchthat (MEMB (BIN TSTREAM)
|
||||
(CHARCODE (SPACE TAB]
|
||||
(RETURN PREV))
|
||||
(SETQ L PREV)
|
||||
(SETQ LIMCHAR (FGETLD L LCHARLIM)) repeatwhile L)
|
||||
else
|
||||
(* ;; "None of the existing lines above FIRSTCHANGEDLINE are valid. We return a valid line that is positioned just above PANE such that everything past its LCHARLAST is valid. That line has no current bitmap and will not be displayed, but it signals where the gap begins.")
|
||||
(CL:WHEN (FGETLD L FORCED-END)
|
||||
(RETURN L))
|
||||
|
||||
(* ;;
|
||||
"Note that that line is not linked into the chain, PANEPREFIX doesn't know about it.")
|
||||
(* ;; "The prev of a line containing an internal sepr is valid")
|
||||
|
||||
(* ;; "We could go forward from the CAR or backwards from the CADR to find the valid line just above the pane. Maybe fewer lines backwards, if we're working at the bottom of a paragraph?")
|
||||
|
||||
(find L (PTOP _ (PANEHEIGHT PANE)) backlines (CDR (\TEDIT.LINES.ABOVE TSTREAM
|
||||
(SUB1 FIRSTPANECHAR)
|
||||
(FGETLD FIRSTCHANGEDLINE
|
||||
YTOP)))
|
||||
suchthat (IGREATERP (FGETLD L YBOT)
|
||||
PTOP])
|
||||
(CL:WHEN (ILESSP (FGETLD L LFIRSTSEPR)
|
||||
(FGETLD L LCHARLAST))
|
||||
(RETURN (FGETLD L PREVLINE))) finally (CL:WHEN (SETQ TOPLINE
|
||||
(CDR (\TEDIT.LINES.ABOVE
|
||||
TSTREAM TOPLINE)))
|
||||
(FSETLD (PANEPREFIX PANE)
|
||||
LCHARLIM
|
||||
(FGETLD TOPLINE LCHAR1))
|
||||
(LINKLD (PANEPREFIX PANE)
|
||||
TOPLINE)
|
||||
(RETURN (PANEPREFIX PANE)))])
|
||||
|
||||
(\TEDIT.NEXTVALIDLINE
|
||||
[LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 21-Jan-2025 15:27 by rmk")
|
||||
@@ -2787,7 +2811,9 @@
|
||||
NEWLINE])
|
||||
|
||||
(\TEDIT.LINE.BOTTOM
|
||||
[LAMBDA (PREVLINE LINE) (* ; "Edited 17-Nov-2024 00:38 by rmk")
|
||||
[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")
|
||||
(* ; "Edited 7-Nov-2024 16:57 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 15:45 by rmk")
|
||||
(* ; "Edited 16-Jun-2024 23:43 by rmk")
|
||||
@@ -2803,8 +2829,8 @@
|
||||
(LINEDESCRIPTOR! PREVLINE)
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(LET* ((PREVYBOT (FGETLD PREVLINE YBOT))
|
||||
(FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(BASETOBASE (GETPARA FMTSPEC FMTBASETOBASE))
|
||||
(PARALOOKS (FGETLD LINE LPARALOOKS))
|
||||
(BASETOBASE (GETPLOOKS PARALOOKS FMTBASETOBASE))
|
||||
NEWYBOT)
|
||||
[SETQ NEWYBOT (if (NOT BASETOBASE)
|
||||
then
|
||||
@@ -2816,9 +2842,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 (GETPARA (FGETLD PREVLINE LFMTSPEC)
|
||||
(IDIFFERENCE PREVYBOT (IPLUS (GETPLOOKS (FGETLD PREVLINE LPARALOOKS)
|
||||
LEADAFTER)
|
||||
(GETPARA FMTSPEC LEADBEFORE)
|
||||
(GETPLOOKS PARALOOKS LEADBEFORE)
|
||||
(FGETLD LINE LTRUEHEIGHT)))
|
||||
else
|
||||
(* ;; "Between lines inside a paragraph, make the baselines BASETOBASE apart. Oldcode subtracted paragraph leading")
|
||||
@@ -2859,21 +2885,21 @@
|
||||
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27981 30197 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 27991 . 30195)) (37602 118362 (
|
||||
\TEDIT.FORMATLINE 37612 . 72352) (\TEDIT.FORMATLINE.SETUP.PARA 72354 . 77177) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 77179 . 81575) (\TEDIT.FORMATLINE.VERTICAL 81577 . 83794) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 83796 . 89817) (\TEDIT.FORMATLINE.TABS 89819 . 97619) (\TEDIT.SCALE.TABS
|
||||
97621 . 98412) (\TEDIT.FORMATLINE.PURGE.SPACES 98414 . 99841) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
99843 . 100744) (\TEDIT.FORMATLINE.EMPTY 100746 . 105432) (\TEDIT.FORMATLINE.UPDATELOOKS 105434 .
|
||||
111556) (\TEDIT.FORMATLINE.LASTLEGAL 111558 . 115098) (\TEDIT.LINES.ABOVE 115100 . 118360)) (118479
|
||||
120394 (\TLVALIDATE 118489 . 120392)) (120588 141752 (\TEDIT.DISPLAYLINE 120598 . 134045) (
|
||||
\TEDIT.DISPLAYLINE.TABS 134047 . 136670) (\TEDIT.LINECACHE 136672 . 137400) (\TEDIT.CREATE.LINECACHE
|
||||
137402 . 138238) (\TEDIT.BLTCHAR 138240 . 140867) (\TEDIT.DIACRITIC.SHIFT 140869 . 141750)) (142367
|
||||
186102 (\TEDIT.BACKFORMAT 142377 . 144931) (\TEDIT.PREVIOUS.LINEBREAK 144933 . 147656) (
|
||||
\TEDIT.UPDATE.LINES 147658 . 152528) (\TEDIT.PANE.CREATELINES 152530 . 155522) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 155524 . 156899) (\TEDIT.LINES.BELOW 156901 . 161362) (\TEDIT.MEASURED.LINES
|
||||
161364 . 163264) (\TEDIT.VALID.LINES 163266 . 171527) (\TEDIT.LASTVALIDLINE 171529 . 176351) (
|
||||
\TEDIT.NEXTVALIDLINE 176353 . 177783) (\TEDIT.CLEARPANE.BELOW.LINE 177785 . 179891) (\TEDIT.INSERTLINE
|
||||
179893 . 181279) (\TEDIT.LINE.BOTTOM 181281 . 184277) (\TEDIT.SHOW.AT.BOTTOMP 184279 . 185389) (
|
||||
\TEDIT.SHOW.AT.TOPP 185391 . 186100)))))
|
||||
(FILEMAP (NIL (28178 30394 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 28188 . 30392)) (37799 121333 (
|
||||
\TEDIT.FORMATLINE 37809 . 73751) (\TEDIT.FORMATLINE.SETUP.PARA 73753 . 78919) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 78921 . 83494) (\TEDIT.FORMATLINE.VERTICAL 83496 . 85947) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 85949 . 91970) (\TEDIT.FORMATLINE.TABS 91972 . 100000) (\TEDIT.SCALE.TABS
|
||||
100002 . 100793) (\TEDIT.FORMATLINE.PURGE.SPACES 100795 . 102222) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
102224 . 103125) (\TEDIT.FORMATLINE.EMPTY 103127 . 108154) (\TEDIT.FORMATLINE.UPDATELOOKS 108156 .
|
||||
114278) (\TEDIT.FORMATLINE.LASTLEGAL 114280 . 117820) (\TEDIT.LINES.ABOVE 117822 . 121331)) (121450
|
||||
123365 (\TLVALIDATE 121460 . 123363)) (123563 145101 (\TEDIT.DISPLAYLINE 123573 . 137213) (
|
||||
\TEDIT.DISPLAYLINE.TABS 137215 . 140019) (\TEDIT.LINECACHE 140021 . 140749) (\TEDIT.CREATE.LINECACHE
|
||||
140751 . 141587) (\TEDIT.BLTCHAR 141589 . 144216) (\TEDIT.DIACRITIC.SHIFT 144218 . 145099)) (145716
|
||||
189246 (\TEDIT.BACKFORMAT 145726 . 148280) (\TEDIT.PREVIOUS.LINEBREAK 148282 . 151005) (
|
||||
\TEDIT.UPDATE.LINES 151007 . 155755) (\TEDIT.PANE.CREATELINES 155757 . 159008) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 159010 . 160516) (\TEDIT.LINES.BELOW 160518 . 164979) (\TEDIT.MEASURED.LINES
|
||||
164981 . 166881) (\TEDIT.VALID.LINES 166883 . 175396) (\TEDIT.LASTVALIDLINE 175398 . 179261) (
|
||||
\TEDIT.NEXTVALIDLINE 179263 . 180693) (\TEDIT.CLEARPANE.BELOW.LINE 180695 . 182801) (\TEDIT.INSERTLINE
|
||||
182803 . 184189) (\TEDIT.LINE.BOTTOM 184191 . 187421) (\TEDIT.SHOW.AT.BOTTOMP 187423 . 188533) (
|
||||
\TEDIT.SHOW.AT.TOPP 188535 . 189244)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Feb-2025 09:32:02" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;645 150146
|
||||
(FILECREATED "19-Mar-2025 16:27:02" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;674 154655
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.SCAN.LINE)
|
||||
:CHANGES-TO (FNS \TEDIT.SELPIECES.COPY \TEDIT.SELPIECES \TEDIT.RESET.EXTEND.PENDING.DELETE)
|
||||
(I.S.OPRS inselpieces)
|
||||
|
||||
:PREVIOUS-DATE "31-Jan-2025 12:45:17" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;644)
|
||||
:PREVIOUS-DATE "16-Mar-2025 10:06:15" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;665)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||
@@ -442,13 +443,13 @@
|
||||
(add START-OF-PIECE (PLEN PC])
|
||||
|
||||
(\TEDIT.WORD.BOUND
|
||||
[LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 16-Jul-2024 19:52 by rmk")
|
||||
[LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 13-Mar-2025 21:41 by rmk")
|
||||
(* ; "Edited 16-Jul-2024 19:52 by rmk")
|
||||
(* ; "Edited 27-Sep-2022 23:54 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 23:48 by rmk")
|
||||
(* ; "Edited 30-May-91 23:02 by jds")
|
||||
(* ; "Edited 25-Sep-2022 23:48 by rmk")
|
||||
(if (AND (FIXP PREVCH)
|
||||
(FIXP CH))
|
||||
then (LET [(READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ)
|
||||
then (LET [(READSA (fetch READSA of (OR (GETTOBJ TEXTOBJ TXTWTBL)
|
||||
TEDIT.WORDBOUND.READTABLE]
|
||||
(NEQ (\SYNCODE READSA PREVCH)
|
||||
(\SYNCODE READSA CH)))
|
||||
@@ -569,16 +570,13 @@
|
||||
(\TEDIT.FIXSEL CURSEL TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.SCAN.LINE
|
||||
[LAMBDA (LINE X Y NEWSEL SELOPERATION PANE BUTTON WORDSELFLG)
|
||||
[LAMBDA (LINE X NEWSEL SELOPERATION TEXTOBJ BUTTON WORDSELFLG)
|
||||
(* ; "Edited 18-Feb-2025 22:04 by rmk")
|
||||
(* ; "Edited 14-Feb-2025 09:47 by rmk")
|
||||
(* ; "Edited 3-Feb-2025 09:31 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 11:06 by rmk")
|
||||
(* ; "Edited 4-Dec-2024 12:06 by rmk")
|
||||
(* ; "Edited 30-Nov-2024 09:52 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 11:54 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:07 by rmk")
|
||||
(* ; "Edited 18-Oct-2024 22:42 by rmk")
|
||||
(* ; "Edited 17-Oct-2024 21:47 by rmk")
|
||||
(* ; "Edited 3-Oct-2024 23:31 by rmk")
|
||||
(* ; "Edited 6-Sep-2024 00:07 by rmk")
|
||||
(* ; "Edited 1-Aug-2024 17:13 by rmk")
|
||||
(* ; "Edited 20-Jun-2024 11:36 by rmk")
|
||||
@@ -589,26 +587,24 @@
|
||||
(* ; "Edited 9-Apr-2023 18:21 by rmk")
|
||||
(* ; "Edited 31-May-91 12:26 by jds")
|
||||
|
||||
(* ;; "Given that LINE meets the mouse-Y criterion, find the selection picked out by the mouse X coordinate. This may run to the right if the mouse-position is protected. This also expands to word selection in the current line, avoiding protected characters.")
|
||||
(* ;; "Find the selection in LINE picked out by the mouse X coordinate. This may run to the right if the mouse-position is protected. This also expands to word selection in the current line, avoiding protected characters.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Earlier versions had more complexity because it not ony figured out the character pointed at but also %"fixed%" the selection on the fly to avoid the more generic \TEDIT.FIXLINE.The generic fixline would scan through the lines of a tall window to find the line containing the selected CH#, and then apply \TEDIT.CHTOX to scan its (presumably cached) THISLINE to set up the X0 and XLIM. But not a noticeable delay for user interaction--not worth the complexity.")
|
||||
|
||||
(* ;; "The button pressed on an image object is decoded from the EXTENDFLG and WORDFLG.")
|
||||
|
||||
(LINEDESCRIPTOR! LINE)
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(SELECTION! NEWSEL)
|
||||
(FSETSEL NEWSEL SET NIL)
|
||||
(PROG ((TSTREAM (PANESTREAM PANE))
|
||||
(TEXTOBJ (PANETOBJ PANE))
|
||||
CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED)
|
||||
(PROG (CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED)
|
||||
(SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE))
|
||||
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) (* ;
|
||||
"Make sure the cache describes this line")
|
||||
(SETQ LINE (\TEDIT.FORMATLINE TSTREAM (GETLD LINE LCHAR1)
|
||||
(SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
|
||||
LINE))) (* ;
|
||||
"Convert X's display units to LINE's scale")
|
||||
(SETQ XLIM (GETLD LINE LX1)) (* ;
|
||||
(SETQ XLIM (FGETLD LINE LX1)) (* ;
|
||||
"Pretend the %"last%" character ended at the margin")
|
||||
(SETQ X (IMAX X XLIM))
|
||||
(SETQ CHNO (FGETLD LINE LCHAR1))
|
||||
@@ -618,11 +614,11 @@
|
||||
(* ;; "Step 1: Find the slot, character number, and ending TX for the character at the incoming mouse X position. ")
|
||||
|
||||
(CL:WHEN (SETQ PASTRIGHT (IGREATERP X (FGETLD LINE LXLIM)))
|
||||
(* ;
|
||||
"If not more than 20 past the end, put it inside the last character.")
|
||||
(CL:WHEN (IGREATERP (IDIFFERENCE X (FGETLD LINE LXLIM))
|
||||
30)
|
||||
(RETURN NIL))
|
||||
(* (* ;
|
||||
"If not more than 30 past the end, put it inside the last character.")
|
||||
(CL:WHEN (IGREATERP (IDIFFERENCE X
|
||||
(FGETLD LINE LXLIM)) 30)
|
||||
(RETURN NIL)))
|
||||
(SETQ X (SUB1 (FGETLD LINE LXLIM))))
|
||||
[SETQ CHARSLOT (for CS incharslots THISLINE
|
||||
do (if CHAR
|
||||
@@ -709,7 +705,8 @@
|
||||
(FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL]
|
||||
(FSETSEL NEWSEL CHLIM (IPLUS (FGETSEL NEWSEL CH#)
|
||||
(FGETSEL NEWSEL DCH)))
|
||||
(FSETSEL NEWSEL POINT (if (FGETLD LINE FORCED-END)
|
||||
(FSETSEL NEWSEL POINT (if (EQ (CHARCODE EOL)
|
||||
(CHAR CHARSLOT))
|
||||
then
|
||||
(* ;;
|
||||
"Always go to the left of an EOL, so caret stays on its line")
|
||||
@@ -838,6 +835,7 @@
|
||||
|
||||
(\TEDIT.XYTOSEL
|
||||
[LAMBDA (X Y NEWSEL TEXTOBJ SELOPERATION PANE BUTTON CURSEL REGIONTYPE)
|
||||
(* ; "Edited 13-Feb-2025 11:03 by rmk")
|
||||
(* ; "Edited 17-Dec-2024 10:10 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 12:00 by rmk")
|
||||
(* ; "Edited 30-Nov-2024 14:15 by rmk")
|
||||
@@ -874,7 +872,7 @@
|
||||
"Y is below the last line of the text: force selection past the very end of that line.")
|
||||
|
||||
(SETQ X (ADD1 (GETLD LINE LXLIM))))
|
||||
(CL:WHEN (AND (\TEDIT.SCAN.LINE LINE X Y NEWSEL SELOPERATION PANE BUTTON
|
||||
(CL:WHEN (AND (\TEDIT.SCAN.LINE LINE X NEWSEL SELOPERATION TEXTOBJ BUTTON
|
||||
(SELECTQ BUTTON
|
||||
(RIGHT (MEMB (FGETSEL CURSEL SELKIND)
|
||||
'(WORD PARA)))
|
||||
@@ -1135,7 +1133,8 @@
|
||||
SEL])
|
||||
|
||||
(\TEDIT.CHTOLINEX
|
||||
[LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 28-Nov-2024 14:41 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 6-Mar-2025 11:57 by rmk")
|
||||
(* ; "Edited 28-Nov-2024 14:41 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 15:58 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 17:12 by rmk")
|
||||
(* ; "Edited 10-May-2024 00:26 by rmk")
|
||||
@@ -1169,10 +1168,17 @@
|
||||
(IEQP CH# (FGETLD LINE LCHAR1)))
|
||||
then (FGETLD LINE LX1)
|
||||
else (for CHARSLOT (X _ (FGETLD LINE LX1))
|
||||
(CHNO _ (FGETLD LINE LCHAR1)) incharslots THISLINE unless (type? CHARLOOKS CHARW
|
||||
)
|
||||
(CHNO _ (FGETLD LINE LCHAR1)) incharslots THISLINE
|
||||
eachtime (CL:WHEN (AND CHAR (DIACRITICP CHAR))
|
||||
|
||||
(* ;; "If the diacritic CHARW is greater than the CHARW of the next slot, we should set the diacritic CHARW to (IDIFFERENCE CHARW (NEXT CHARW)). ")
|
||||
|
||||
(* ;; "i.e. (IMAX 0 (IDIFFERENCE CHARW (NEXT CHARW))")
|
||||
|
||||
(SETQ CHARW 0)) unless (type? CHARLOOKS CHARW)
|
||||
do
|
||||
(* ;; "Update the running X-position in the line, skiping look-slots")
|
||||
(* ;;
|
||||
"Update the running X-position in the line, skiping look-slots and skipping diacritics")
|
||||
|
||||
(CL:WHEN (IEQP CHNO CH#)
|
||||
(if AFTER
|
||||
@@ -1198,7 +1204,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 26-Nov-2024 23:44 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 19-Mar-2025 13:24 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:44 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 11:37 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 23:10 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 00:18 by rmk")
|
||||
@@ -1208,12 +1215,18 @@
|
||||
|
||||
(* ;; "Reset the 'Extend Pending Delete' status")
|
||||
|
||||
(\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ)
|
||||
'NORMAL)
|
||||
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
|
||||
(LET [(TEXTOBJ (CL:IF (type? TEXTOBJ TSTREAM)
|
||||
TSTREAM
|
||||
(GETTSTR TSTREAM TEXTOBJ))]
|
||||
(\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ)
|
||||
NIL TEXTOBJ)
|
||||
(\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ)
|
||||
'NORMAL)
|
||||
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
|
||||
|
||||
(\TEDIT.SET.SEL.LOOKS
|
||||
[LAMBDA (SEL OPERATION) (* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
[LAMBDA (SEL OPERATION) (* ; "Edited 28-Feb-2025 17:45 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 08:40 by rmk")
|
||||
(* ; "Edited 12-Oct-2023 22:36 by rmk")
|
||||
(* ; "Edited 23-May-2023 12:48 by rmk")
|
||||
@@ -1254,9 +1267,10 @@
|
||||
"For people who really want to see what's selected.")
|
||||
(FSETSEL SEL HOW BLACKSHADE)
|
||||
(FSETSEL SEL HOWHEIGHT 16384)
|
||||
(FSETSEL SEL HASCARET T)
|
||||
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
|
||||
SEL])
|
||||
(FSETSEL SEL HASCARET T))
|
||||
(NIL)
|
||||
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
|
||||
SEL])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1444,55 +1458,105 @@
|
||||
(\TEDIT.THELP "ILLEGAL POINT" (GETSEL SEL POINT))))])
|
||||
|
||||
(\TEDIT.SEL.L1
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 24-Apr-2024 08:34 by rmk")
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 9-Mar-2025 20:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 08:34 by rmk")
|
||||
(* ; "Edited 8-Apr-2024 23:42 by rmk")
|
||||
(* ; "Edited 16-Nov-2023 23:43 by rmk")
|
||||
|
||||
(* ;; "Returns L1 for PANE in SEL")
|
||||
|
||||
(CL:UNLESS PANE
|
||||
(SETQ PANE (FGETTOBJ TEXTOBJ SELPANE)))
|
||||
(for L in (GETSEL SEL L1) as P inpanes (PROGN TEXTOBJ) when (EQ P PANE) do (RETURN L])
|
||||
|
||||
(\TEDIT.SEL.LN
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 24-Apr-2024 08:34 by rmk")
|
||||
[LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 9-Mar-2025 20:00 by rmk")
|
||||
(* ; "Edited 24-Apr-2024 08:34 by rmk")
|
||||
(* ; "Edited 8-Apr-2024 23:41 by rmk")
|
||||
(* ; "Edited 16-Nov-2023 23:43 by rmk")
|
||||
|
||||
(* ;; "Returns LN for PANE in SEL")
|
||||
|
||||
(CL:UNLESS PANE
|
||||
(SETQ PANE (FGETTOBJ TEXTOBJ SELPANE)))
|
||||
(for L in (GETSEL SEL LN) as P inpanes (PROGN TEXTOBJ) when (EQ P PANE) do (RETURN L])
|
||||
|
||||
(\TEDIT.SEL.DELETEDCHARS
|
||||
[LAMBDA (SELTOFIX FIRSTCHAR LEN) (* ; "Edited 26-Nov-2024 22:31 by rmk")
|
||||
[LAMBDA (SELTOFIX FIRSTCHAR LEN) (* ; "Edited 6-Feb-2025 15:53 by rmk")
|
||||
(* ; "Edited 4-Feb-2025 23:05 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 22:31 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 12:09 by rmk")
|
||||
(* ; "Edited 20-Feb-2024 17:31 by rmk")
|
||||
(* ; "Edited 15-Feb-2024 23:39 by rmk")
|
||||
(* ; "Edited 14-Feb-2024 20:59 by rmk")
|
||||
|
||||
(* ;; "Adjust SELTOFIX to reflect character number translations after LEN characters starting at FIRSTCHAR have been removed.")
|
||||
(* ;; "Adjust SELTOFIX to reflect character number translations after LEN characters starting at FIRSTCHAR have been or will be removed.")
|
||||
|
||||
(CL:WHEN (type? SELECTION FIRSTCHAR)
|
||||
(SETQ LEN (FGETSEL FIRSTCHAR DCH))
|
||||
(SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#)))
|
||||
(CL:WHEN (IGEQ (FGETSEL SELTOFIX CHLIM)
|
||||
FIRSTCHAR)
|
||||
(LET ((LASTCHAR (IPLUS FIRSTCHAR LEN -1))
|
||||
(B (FGETSEL SELTOFIX CH#))
|
||||
(E (FGETSEL SELTOFIX CHLAST))
|
||||
(DCH (FGETSEL SELTOFIX DCH)))
|
||||
|
||||
(* ;; "Nothing to do if the deletion happened after the selection.")
|
||||
(* ;; "No overlap")
|
||||
|
||||
[LET ((LASTCHAR (IPLUS FIRSTCHAR LEN -1)))
|
||||
(if (ILESSP LASTCHAR (FGETSEL SELTOFIX CH#))
|
||||
then
|
||||
(* ;;
|
||||
"All deleted characters are in front of SELTOFIX, just move SELTOFIX forward")
|
||||
(* ;; " 1 FddL F gt E")
|
||||
|
||||
(add (FGETSEL SELTOFIX CH#)
|
||||
(IMINUS LEN))
|
||||
(add (FGETSEL SELTOFIX CHLIM)
|
||||
(IMINUS LEN))
|
||||
else
|
||||
(* ;; " SELTOFIX starts after the last pre-deletion character and is shortened so that it only covers its still-remaining characters. Because of IMAX, this reduces to a point selection if all of SELTOFIX's characters (and more) have been deleted.")
|
||||
(* ;; " B23E nothing")
|
||||
|
||||
(\TEDIT.UPDATE.SEL SELTOFIX FIRSTCHAR (IMAX 0 (IDIFFERENCE LASTCHAR
|
||||
(FGETSEL SELTOFIX CHLAST])])
|
||||
(* ;; " 2 FddL L lt B")
|
||||
|
||||
(* ;; " B123E B=B - LEN ")
|
||||
|
||||
(* ;; "Overlaps: NEWB=(MIN F B) = X+1 NEWDCH = (IMAX 0, E-L)")
|
||||
|
||||
(* ;; " 3 XFddL F leq B L lt E")
|
||||
|
||||
(* ;; " X [B23]45E 45E at F DCH=E-L X45E")
|
||||
|
||||
(* ;; " X45E E-L")
|
||||
|
||||
(* ;; " 4 XFdddddddL F leq B L geq E")
|
||||
|
||||
(* ;; " X[ B234E] ")
|
||||
|
||||
(* ;;
|
||||
" X point selection at F DCH=0 E-L lt 0 DCH-LEN < 0")
|
||||
|
||||
(* ;; " 5 X FddL F geq B L lt E")
|
||||
|
||||
(* ;; " XB2[3456]7E ")
|
||||
|
||||
(* ;; " XB27E B27E at B DCH = DCH - LEN ")
|
||||
|
||||
(* ;; " 6 X FddL F geq B L geq E")
|
||||
|
||||
(* ;; " XB2[3E ")
|
||||
|
||||
(* ;; " XB2 B2 at B ")
|
||||
|
||||
(if (IGREATERP FIRSTCHAR E)
|
||||
then (* ; "Case 1: Nothing")
|
||||
NIL
|
||||
elseif (ILESSP LASTCHAR B)
|
||||
then (* ; "Case 2: move back")
|
||||
(add (FGETSEL SELTOFIX CH#)
|
||||
(IMINUS LEN))
|
||||
(add (FGETSEL SELTOFIX CHLIM)
|
||||
(IMINUS LEN))
|
||||
else (* ; "Overlaps")
|
||||
(\TEDIT.UPDATE.SEL SELTOFIX (IMIN B FIRSTCHAR)
|
||||
[if (ILEQ FIRSTCHAR B)
|
||||
then (* ; "Cases 3 4")
|
||||
(IMAX 0 (IDIFFERENCE E LASTCHAR))
|
||||
elseif (ILEQ LASTCHAR E)
|
||||
then (* ; "Case 5")
|
||||
(IDIFFERENCE DCH LEN)
|
||||
else (* ; "Case 6")
|
||||
(IDIFFERENCE DCH (ADD1 (IDIFFERENCE E FIRSTCHAR]
|
||||
'LEFT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1777,7 +1841,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.SELPIECES
|
||||
[LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 26-Nov-2024 17:49 by rmk")
|
||||
[LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 19-Mar-2025 16:10 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 17:49 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 14:24 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 09:10 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 13:13 by rmk")
|
||||
@@ -1809,15 +1874,17 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ. ")
|
||||
(* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ.")
|
||||
|
||||
(* ;; " Returns NIL on an empty selection rather than the empty SELPIECES (SPLEN 0, NIL for pieces). Somehow SELPIECES.COPY gets screwed up. To be debugged. Meanwhile, callers hopefully test for NIL.")
|
||||
|
||||
(LET (FIRSTCHAR LEFTPC RIGHTPC)
|
||||
(if (type? SELECTION SEL/FIRSTCHAR)
|
||||
then (if (FGETSEL SEL/FIRSTCHAR SET)
|
||||
then (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#))
|
||||
[SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH))
|
||||
FIRSTCHAR
|
||||
(SUB1 (FGETSEL SEL/FIRSTCHAR CHLIM)))]
|
||||
[SETQ LASTCHAR (SUB1 (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH))
|
||||
FIRSTCHAR
|
||||
(FGETSEL SEL/FIRSTCHAR CHLIM))]
|
||||
else (SETQ FIRSTCHAR 0)
|
||||
(SETQ LASTCHAR -1))
|
||||
elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR)
|
||||
@@ -1840,7 +1907,9 @@
|
||||
SPLASTCHAR _ LASTCHAR))])
|
||||
|
||||
(\TEDIT.SELPIECES.COPY
|
||||
[LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ) (* ; "Edited 26-Nov-2024 23:31 by rmk")
|
||||
[LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ CHARLOOKS)
|
||||
(* ; "Edited 19-Mar-2025 16:26 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 23:31 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 15:38 by rmk")
|
||||
(* ; "Edited 11-Dec-2023 08:16 by rmk")
|
||||
(* ; "Edited 2-Jun-2023 11:21 by rmk")
|
||||
@@ -1854,13 +1923,14 @@
|
||||
|
||||
(CL:WHEN SELPIECES
|
||||
(CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ))
|
||||
(for PC NPC PREVPC NEWFIRSTPIECE inselpieces SELPIECES
|
||||
(for PC NPC PREVPC NEWFIRSTPIECE inselpieces (PROGN SELPIECES)
|
||||
do (SETQ NPC (\TEDIT.COPYPIECE PC FROMTEXTOBJ TOTEXTOBJ NIL OPERATION))
|
||||
(CL:UNLESS NPC (* ; "Was an object-copy disallowed?")
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Linke the new pieces together")
|
||||
|
||||
(CL:WHEN CHARLOOKS (FSETPC NPC PCHARLOOKS CHARLOOKS))
|
||||
(if PREVPC
|
||||
then (SETPC PREVPC NEXTPIECE NPC)
|
||||
else (SETQ NEWFIRSTPIECE NPC))
|
||||
@@ -1897,29 +1967,32 @@
|
||||
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
||||
|
||||
(\TEDIT.SELPIECES.CHARTRANSFORM
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "Edited 16-Mar-2025 10:03 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
(* ; "Edited 4-Oct-2024 08:41 by rmk")
|
||||
(* ; "Edited 28-Apr-2024 08:52 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:28 by rmk")
|
||||
(* ; "Edited 24-May-2023 13:04 by rmk")
|
||||
|
||||
(* ;; "This transforms the characters in SELPIECES according to CHARFN, skipping image objects unless OBJECTSTOO. The purpose is to allow for character transformations (e.g. case switching) without depending on strings (TEDIT.SELAS.STRING) and character insertion (\INSERTCH) as intermediaries. Strings can't hold image objects.")
|
||||
(* ;; "This transforms the characters in SELPIECES according to CHARFN, skipping image objects unless OBJECTSTOO. The purpose is to allow for character transformations (e.g. case switching) without depending on strings (TEDIT.SELAS.STRING) and character insertion (\INSERTCH) as intermediaries. Image objects would be lost if we had to go through strings.")
|
||||
|
||||
(* ;;
|
||||
"This smashes the pieces, use crosscopy \TEDIT.SELPIECES.COPY first to protect the document pieces.")
|
||||
|
||||
[for PC PCONTENTS inselpieces SELPIECES
|
||||
[for PC PCONTENTS (INDEX _ 0) inselpieces SELPIECES
|
||||
do (SETQ PCONTENTS (PCONTENTS PC))
|
||||
(SELECTC (PTYPE PC)
|
||||
(STRING.PTYPES (for I CH (STR _ PCONTENTS) from 1 while (SETQ CH (NTHCHARCODE STR I))
|
||||
do (RPLCHARCODE STR I (APPLY* CHARFN CH TEXTOBJ))))
|
||||
do (RPLCHARCODE STR I (APPLY* CHARFN CH (add INDEX 1)
|
||||
TEXTOBJ))))
|
||||
(FILE.PTYPES [LET [(STR (ALLOCSTRING (PLEN PC]
|
||||
|
||||
(* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this. If not, ALLOCSTRING will cause an error.")
|
||||
|
||||
[for I from 1 to (PLEN PC)
|
||||
do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE
|
||||
TEXTOBJ PC I]
|
||||
TEXTOBJ PC I)
|
||||
(add INDEX 1]
|
||||
(if (fetch (STRINGP FATSTRINGP) of STR)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -1930,15 +2003,15 @@
|
||||
(FSETPC PC PCONTENTS STR)
|
||||
(FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
|
||||
(PLEN PC])
|
||||
(OBJECT.PTYPE (CL:WHEN OBJECTSTOO
|
||||
(FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS TEXTOBJ))))
|
||||
(SUBSTREAM.PTYPE
|
||||
(\TEDIT.THELP "SUBSTREAM PIECES NOT IMPLEMENTED"))
|
||||
(OBJECT.PTYPE (add INDEX 1)
|
||||
(CL:WHEN OBJECTSTOO
|
||||
(FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX))))
|
||||
(\TEDIT.THELP "ILLEGAL PIECE TYPE" (PTYPE PC]
|
||||
SELPIECES])
|
||||
|
||||
(\TEDIT.SELPIECES.FROM.STRING
|
||||
[LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "Edited 20-Mar-2024 10:57 by rmk")
|
||||
[LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:57 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 13:00 by rmk")
|
||||
(* ; "Edited 28-Jan-2024 08:28 by rmk")
|
||||
(* ; "Edited 11-Dec-2023 08:12 by rmk")
|
||||
@@ -1953,7 +2026,7 @@
|
||||
(CL:UNLESS CHARLOOKS
|
||||
(SETQ CHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)))
|
||||
(CL:UNLESS PARALOOKS
|
||||
(SETQ PARALOOKS (FGETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(SETQ PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP))
|
||||
(SETQ CHECKFOREOL T))
|
||||
(LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1)
|
||||
@@ -2097,7 +2170,9 @@
|
||||
(FGETSEL SCRSEL CH#])
|
||||
|
||||
(TEDIT.SELPROP
|
||||
[LAMBDA X (* ; "Edited 31-Oct-2024 18:00 by rmk")
|
||||
[LAMBDA X (* ; "Edited 28-Feb-2025 17:14 by rmk")
|
||||
(* ; "Edited 6-Feb-2025 16:48 by rmk")
|
||||
(* ; "Edited 31-Oct-2024 18:00 by rmk")
|
||||
(* ; "Edited 23-Sep-2024 23:11 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 11:20 by rmk")
|
||||
(* ; "Edited 19-Aug-2024 13:55 by rmk")
|
||||
@@ -2118,8 +2193,6 @@
|
||||
'SELECTION]
|
||||
(PROP (ARG X 2))
|
||||
NEWVALUE)
|
||||
(CL:UNLESS (FGETSEL SEL SET)
|
||||
(ERROR "SELECTION NOT SET" SEL))
|
||||
(PROG1 (SELECTQ PROP
|
||||
(CH# (FGETSEL SEL CH#))
|
||||
(CHLIM (FGETSEL SEL CHLIM))
|
||||
@@ -2130,13 +2203,14 @@
|
||||
(FGETSEL SEL SELKIND))
|
||||
(CHLAST (if (EQ 0 (FGETSEL SEL DCH))
|
||||
then (FGETSEL SEL CH#)
|
||||
else (SUB1 (FGETSEL SEL CHLIM))))
|
||||
else (FGETSEL SEL CHLAST)))
|
||||
(POINTCH# (TEDIT.GETPOINT (FGETSEL SEL SELTEXTSTREAM)
|
||||
SEL))
|
||||
(SELOBJ (FGETSEL SEL SELOBJ))
|
||||
(TEXTSTREAM (FGETSEL SEL SELTEXTSTREAM))
|
||||
(SHADE (FGETSEL SEL HOW))
|
||||
(SHADEHEIGHT (FGETSEL SEL HOWHEIGHT))
|
||||
(SET (FGETSEL SEL SET))
|
||||
(\ILLEGAL.ARG PROP))
|
||||
(CL:WHEN (IGREATERP X 2)
|
||||
(SETQ NEWVALUE (ARG X 3))
|
||||
@@ -2153,9 +2227,12 @@
|
||||
(CHLAST (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE (ADD1 NEWVALUE)
|
||||
(FGETSEL SEL CH#))))
|
||||
(CHLIM (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE NEWVALUE (FGETSEL SEL CH#))))
|
||||
(SHADE (FSETSEL SEL HOW NEWVALUE))
|
||||
(SHADEHEIGHT (FSETSEL SEL HOWHEIGHT NEWVALUE))
|
||||
(SET (FSETSEL SEL SET NEWVALUE))
|
||||
(\ILLEGAL.ARG PROP))
|
||||
[\TEDIT.FIXSEL SEL (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (GETSEL SEL
|
||||
SELTEXTSTREAM]))])
|
||||
(CL:WHEN (FGETSEL SEL SELTEXTSTREAM)
|
||||
(\TEDIT.FIXSEL SEL (FGETSEL SEL SELTEXTSTREAM)))))])
|
||||
|
||||
(TEDIT.GETPOINT
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 31-Oct-2024 17:46 by rmk")
|
||||
@@ -2252,6 +2329,7 @@
|
||||
|
||||
(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")
|
||||
@@ -2312,6 +2390,7 @@
|
||||
(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.SHOWSEL
|
||||
@@ -2335,7 +2414,8 @@
|
||||
(\TEDIT.SHOWSEL SEL ONFLG TEXTOBJ))])
|
||||
|
||||
(TEDIT.SEL.AS.STRING
|
||||
[LAMBDA (TSTREAM SEL CODEFOROBJECT) (* ; "Edited 14-Jul-2024 00:12 by rmk")
|
||||
[LAMBDA (TSTREAM SEL/CH# LEN CODEFOROBJECT) (* ; "Edited 15-Feb-2025 12:47 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 00:12 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:05 by rmk")
|
||||
(* ; "Edited 27-Jan-2024 22:57 by rmk")
|
||||
(* ; "Edited 23-May-2023 12:36 by rmk")
|
||||
@@ -2348,27 +2428,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
|
||||
(SETQ SEL (GETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
|
||||
SEL)))
|
||||
(LET (RESULT (LEN (GETSEL SEL DCH)))
|
||||
(COND
|
||||
((ZEROP LEN) (* ;
|
||||
(CL:UNLESS SEL/CH#
|
||||
(SETQ SEL/CH# (GETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
SEL)))
|
||||
(LET (RESULT CH#)
|
||||
(if (type? SELECTION SEL/CH#)
|
||||
then (SETQ LEN (GETSEL SEL/CH# DCH))
|
||||
(SETQ CH# (GETSEL SEL/CH# CH#))
|
||||
else (SETQ CH# SEL/CH#))
|
||||
(if (ZEROP LEN)
|
||||
then (* ;
|
||||
"There is no selection, or it's zero-width. Return ''")
|
||||
(CONCAT ""))
|
||||
(T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE)))
|
||||
(CONCAT "")
|
||||
else (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE)))
|
||||
(* ; "The resulting string")
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (GETSEL SEL CH#)))
|
||||
(* ;
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)) (* ;
|
||||
"Starting point for the string is start of selection.")
|
||||
(for I C from 1 to LEN do (SETQ C (BIN TSTREAM))
|
||||
(CL:WHEN (AND (IMAGEOBJP C)
|
||||
CODEFOROBJECT)
|
||||
(for I C from 1 to LEN do (SETQ C (BIN TSTREAM))
|
||||
(CL:WHEN (AND (IMAGEOBJP C)
|
||||
CODEFOROBJECT)
|
||||
(* ;
|
||||
"RPLCHARCODE will cause an error on objects")
|
||||
(SETQ C CODEFOROBJECT))
|
||||
(RPLCHARCODE RESULT I C))
|
||||
RESULT])
|
||||
(SETQ C CODEFOROBJECT))
|
||||
(RPLCHARCODE RESULT I C))
|
||||
RESULT])
|
||||
|
||||
(TEDIT.SEL.AS.SEXPR
|
||||
[LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "Edited 29-Dec-2024 08:47 by rmk")
|
||||
@@ -2402,25 +2485,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 59336 (\TEDIT.EXTEND.SEL 24955 . 32043) (\TEDIT.SCAN.LINE
|
||||
32045 . 44125) (\TEDIT.SCAN.LINE.WORD 44127 . 49488) (\TEDIT.XYTOSEL 49490 . 56489) (\TEDIT.REGIONTYPE
|
||||
56491 . 57510) (\TEDIT.XYTOSEL.INLINEP 57512 . 57967) (\TEDIT.XYTOSEL.LINE 57969 . 59334)) (59337
|
||||
72499 (\TEDIT.FIXSEL 59347 . 68960) (\TEDIT.CHTOLINEX 68962 . 72497)) (72500 76037 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 72510 . 73483) (\TEDIT.SET.SEL.LOOKS 73485 . 76035)) (76038 92338 (
|
||||
\TEDIT.SHOWSEL 76048 . 80508) (\TEDIT.SHOWSEL.HILIGHT 80510 . 85131) (\TEDIT.UPDATE.SEL 85133 . 88632)
|
||||
(\TEDIT.CARETLINE 88634 . 89348) (\TEDIT.SEL.L1 89350 . 89856) (\TEDIT.SEL.LN 89858 . 90364) (
|
||||
\TEDIT.SEL.DELETEDCHARS 90366 . 92336)) (92339 97045 (\TEDIT.COPYSEL 92349 . 94815) (
|
||||
\TEDIT.SEL.CHANGED? 94817 . 97043)) (97076 109805 (\TEDIT.SELECT.OBJECT 97086 . 101592) (
|
||||
\TEDIT.SHOWSEL.OBJECT 101594 . 103756) (\TEDIT.CLIP.OBJECT 103758 . 105762) (\TEDIT.OPERATE.OBJECT
|
||||
105764 . 109803)) (109833 128062 (\TEDIT.SELPIECES 109843 . 113791) (\TEDIT.SELPIECES.COPY 113793 .
|
||||
115831) (\TEDIT.SELPIECES.CONCAT 115833 . 117712) (\TEDIT.SELPIECES.CHARTRANSFORM 117714 . 120672) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 120674 . 125697) (\TEDIT.SELPIECES.TO.STRING 125699 . 128060)) (128115
|
||||
149977 (TEDIT.XYTOCH 128125 . 130509) (TEDIT.SELPROP 130511 . 134267) (TEDIT.GETPOINT 134269 . 136189)
|
||||
(TEDIT.GETSEL 136191 . 136925) (TEDIT.GETSEL.PARA 136927 . 137876) (TEDIT.SCANSEL 137878 . 138826) (
|
||||
TEDIT.SET.SEL.LOOKS 138828 . 140207) (TEDIT.SETSEL 140209 . 144820) (TEDIT.SHOWSEL 144822 . 146102) (
|
||||
TEDIT.SEL.AS.STRING 146104 . 148355) (TEDIT.SEL.AS.SEXPR 148357 . 149643) (TEDIT.SELECTALL 149645 .
|
||||
149975)))))
|
||||
(FILEMAP (NIL (15676 17497 (\TEDIT.SELECTION.DEFPRINT 15686 . 17495)) (17534 19039 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17544 . 19037)) (19040 24892 (\TEDIT.SELECTED.PIECES 19050 . 20570) (
|
||||
\TEDIT.FIND.PROTECTED.END 20572 . 22241) (\TEDIT.FIND.PROTECTED.START 22243 . 24101) (
|
||||
\TEDIT.WORD.BOUND 24103 . 24890)) (25026 59225 (\TEDIT.EXTEND.SEL 25036 . 32124) (\TEDIT.SCAN.LINE
|
||||
32126 . 43904) (\TEDIT.SCAN.LINE.WORD 43906 . 49267) (\TEDIT.XYTOSEL 49269 . 56378) (\TEDIT.REGIONTYPE
|
||||
56380 . 57399) (\TEDIT.XYTOSEL.INLINEP 57401 . 57856) (\TEDIT.XYTOSEL.LINE 57858 . 59223)) (59226
|
||||
72850 (\TEDIT.FIXSEL 59236 . 68849) (\TEDIT.CHTOLINEX 68851 . 72848)) (72851 76834 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 72861 . 74170) (\TEDIT.SET.SEL.LOOKS 74172 . 76832)) (76835 95235 (
|
||||
\TEDIT.SHOWSEL 76845 . 81305) (\TEDIT.SHOWSEL.HILIGHT 81307 . 85928) (\TEDIT.UPDATE.SEL 85930 . 89429)
|
||||
(\TEDIT.CARETLINE 89431 . 90145) (\TEDIT.SEL.L1 90147 . 90830) (\TEDIT.SEL.LN 90832 . 91515) (
|
||||
\TEDIT.SEL.DELETEDCHARS 91517 . 95233)) (95236 99942 (\TEDIT.COPYSEL 95246 . 97712) (
|
||||
\TEDIT.SEL.CHANGED? 97714 . 99940)) (99973 112702 (\TEDIT.SELECT.OBJECT 99983 . 104489) (
|
||||
\TEDIT.SHOWSEL.OBJECT 104491 . 106653) (\TEDIT.CLIP.OBJECT 106655 . 108659) (\TEDIT.OPERATE.OBJECT
|
||||
108661 . 112700)) (112730 131910 (\TEDIT.SELPIECES 112740 . 117021) (\TEDIT.SELPIECES.COPY 117023 .
|
||||
119310) (\TEDIT.SELPIECES.CONCAT 119312 . 121191) (\TEDIT.SELPIECES.CHARTRANSFORM 121193 . 124402) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 124404 . 129545) (\TEDIT.SELPIECES.TO.STRING 129547 . 131908)) (131963
|
||||
154486 (TEDIT.XYTOCH 131973 . 134357) (TEDIT.SELPROP 134359 . 138389) (TEDIT.GETPOINT 138391 . 140311)
|
||||
(TEDIT.GETSEL 140313 . 141047) (TEDIT.GETSEL.PARA 141049 . 141998) (TEDIT.SCANSEL 142000 . 142948) (
|
||||
TEDIT.SET.SEL.LOOKS 142950 . 144329) (TEDIT.SETSEL 144331 . 149095) (TEDIT.SHOWSEL 149097 . 150377) (
|
||||
TEDIT.SEL.AS.STRING 150379 . 152864) (TEDIT.SEL.AS.SEXPR 152866 . 154152) (TEDIT.SELECTALL 154154 .
|
||||
154484)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Jan-2025 11:15:51" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;840 173255
|
||||
(FILECREATED "28-Mar-2025 18:32:27" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;872 187180
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPENTEXTSTREAM)
|
||||
:CHANGES-TO (FNS \TEDIT.NTHCHARCODE \TEDIT.TEXTBOUT \TEDIT.RPLCHARCODE)
|
||||
(VARS TEDIT-STREAMCOMS)
|
||||
|
||||
:PREVIOUS-DATE "12-Jan-2025 12:30:12" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;839)
|
||||
:PREVIOUS-DATE "26-Mar-2025 00:29:46" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;865)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||
@@ -57,6 +58,10 @@
|
||||
\TEDIT.TEXTSETEOF \TEDIT.TEXTSETFILEPTR \TEDIT.TEXTDSPXPOSITION \TEDIT.TEXTDSPYPOSITION
|
||||
\TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH
|
||||
\TEDIT.TEXTDSPSTRINGWIDTH \TEDIT.TEXTDSPLINEFEED)
|
||||
|
||||
(* ;; "Access by character")
|
||||
|
||||
(FNS \TEDIT.NTHCHARCODE \TEDIT.PIECE.NTHCHARCODE \TEDIT.RPLCHARCODE)
|
||||
(COMS
|
||||
(* ;; "Editing support")
|
||||
|
||||
@@ -137,7 +142,7 @@
|
||||
PCTB (* ; "The piece table")
|
||||
TEXTLEN (* ; "# of chars in the text")
|
||||
PRIMARYPANE (* ; "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC")
|
||||
LASTPIECE (* ;
|
||||
SUFFIXPIECE (* ;
|
||||
"The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
CHARFN (* ;
|
||||
"Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")
|
||||
@@ -159,8 +164,8 @@
|
||||
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
||||
SEL (* ;
|
||||
"The current selection within the text")
|
||||
NIL (* ;
|
||||
"Was: Scratch space for the selection code")
|
||||
LASTARROWX (* ;
|
||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code")
|
||||
NIL (* ;
|
||||
"Was MOVESEL: Source for the next MOVE of text")
|
||||
NIL (* ;
|
||||
@@ -189,7 +194,7 @@
|
||||
"Cache of line-related info, to speed up selection &c")
|
||||
(MENUFLG FLAG) (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu")
|
||||
FMTSPEC (* ;
|
||||
DEFAULTPARALOOKS (* ;
|
||||
"Default Formatting Spec to be used when formatting paragraphs")
|
||||
(FORMATTEDP FLAG) (* ;
|
||||
"Flag for paragraph formatting. T if this document is to contain paragraph formatting information.")
|
||||
@@ -227,7 +232,7 @@
|
||||
TXTCHARLOOKSLIST (* ;
|
||||
"List of all the CHARLOOKSs in the document, so they can be kept unique")
|
||||
TXTPARALOOKSLIST (* ;
|
||||
"List of all the FMTSPECs in the document, so they can be kept unique")
|
||||
"List of all the PARALOOKS in the document, so they can be kept unique")
|
||||
(TXTAPPENDONLY FLAG) (* ; "Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater")
|
||||
(TXTDON'TUPDATE FLAG) (* ; "T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.")
|
||||
TXTRAWINCLUDESTREAM (* ;
|
||||
@@ -238,13 +243,15 @@
|
||||
"Style sheet local to this document. Not currently saved as part of the file.")
|
||||
)
|
||||
[ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM)
|
||||
(CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM))
|
||||
(\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
|
||||
(freplace \XDIRTY OF DATUM WITH NEWVALUE))]
|
||||
(PROGN (FSETTOBJ DATUM LASTARROWX NIL)
|
||||
(CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY)
|
||||
of DATUM))
|
||||
(\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
|
||||
(freplace \XDIRTY OF DATUM WITH NEWVALUE))]
|
||||
SEL _ (create SELECTION)
|
||||
TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ 'TEXT THISLINE _
|
||||
(create THISLINE)
|
||||
FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
|
||||
(ACCESSFNS TEXTSTREAM
|
||||
(
|
||||
@@ -267,10 +274,10 @@
|
||||
"Runs from PLEN to 0: piece exhausted")
|
||||
(NIL) (* ; "Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ.")
|
||||
(CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM)
|
||||
(REPLACE (STREAM IMAGEDATA) of DATUM with NEWVALUE))
|
||||
(* ; "The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone.")
|
||||
(replace (STREAM IMAGEDATA) of DATUM with NEWVALUE))
|
||||
(* ; "THIS IS SOMEHOW INVOLVED IN STYLES, NOT SENSIBLE. REMOVE? The PARALOOKS that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone.")
|
||||
(APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM)
|
||||
(REPLACE (STREAM F4) OF DATUM with NEWVALUE))
|
||||
(replace (STREAM F4) OF DATUM with NEWVALUE))
|
||||
(* ; "Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting.")
|
||||
(STARTINGCOFFSET (fetch (STREAM F2) of DATUM)
|
||||
(replace (STREAM F2) of DATUM with NEWVALUE)))
|
||||
@@ -1017,7 +1024,8 @@
|
||||
(\TEDIT.THELP "UNKNOWN PIECE TYPE")))])
|
||||
|
||||
(\TEDIT.TEXTBOUT
|
||||
[LAMBDA (TSTREAM CHAR) (* ; "Edited 17-Nov-2024 10:05 by rmk")
|
||||
[LAMBDA (TSTREAM CHAR) (* ; "Edited 28-Mar-2025 10:13 by rmk")
|
||||
(* ; "Edited 17-Nov-2024 10:05 by rmk")
|
||||
(* ; "Edited 6-Sep-2024 13:06 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 14:50 by rmk")
|
||||
(* ; "Edited 13-Aug-2024 08:28 by rmk")
|
||||
@@ -1058,7 +1066,7 @@
|
||||
(ERROR "FILE NOT OPEN" TSTREAM)
|
||||
(RETURN))
|
||||
(if (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (TEDIT.RPLCHARCODE TSTREAM CHNO CHAR) (* ;
|
||||
then (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR) (* ;
|
||||
"Replace in the middle, add at the end")
|
||||
elseif (AND (\TEDIT.INSERTCH CHAR CHNO TEXTOBJ (MEMB CHAR (FGETTOBJ TEXTOBJ
|
||||
PARABREAKCHARS)))
|
||||
@@ -1229,6 +1237,8 @@
|
||||
(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")
|
||||
@@ -1303,7 +1313,7 @@
|
||||
(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)))
|
||||
@@ -1316,14 +1326,13 @@
|
||||
TEXTOBJ)
|
||||
TEXTOBJ)))
|
||||
(\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
|
||||
(\TEDIT.REOPENTEXTSTREAM TSTREAM)
|
||||
(SETQ WINDOW (if [AND (SETQ PRIMPANE (OPENWP (\TEDIT.PRIMARYPANE TSTREAM)))
|
||||
(OR (NULL WINDOW)
|
||||
(EQ WINDOW (CAR (WINDOWPROP PRIMPANE 'TYPED-REGION]
|
||||
then (* ; "Reuse the existing window/region")
|
||||
PRIMPANE
|
||||
else (\TEDIT.CREATEW WINDOW TSTREAM PROPS)))
|
||||
(\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS)
|
||||
(\TEDIT.REOPENTEXTSTREAM TSTREAM)
|
||||
else (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))
|
||||
else (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM PROPS))
|
||||
(SETQ TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ))
|
||||
(CL:WHEN TEXT (* ;
|
||||
@@ -1331,23 +1340,23 @@
|
||||
(SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS))
|
||||
(FSETTOBJ TEXTOBJ TXTFILE TEXT))
|
||||
|
||||
(* ;; "Get the window before populating pieces, so that the local promptwindow is availabe for messages and queries")
|
||||
(* ;; "If we swap the window before the pieces, the local promptwindow is availabe for messages and queries. Otherwise, those show up in the system prompt. But if we do it in the opposite order, we don't know how to estimate the width for the window region.")
|
||||
|
||||
(CL:WHEN WINDOW (* ;
|
||||
"If NIL, don't create a window. It's Tedit on call from TEDIT")
|
||||
(SETQ WINDOW (\TEDIT.CREATEW WINDOW TSTREAM PROPS)))
|
||||
(CL:WHEN TEXT
|
||||
|
||||
(* ;; "TEXT is a stream. The fresh TEXTSTREAM is updated to hold that text, ready for window and process attachments.")
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.PIECES TEXT TSTREAM START END PROPS))
|
||||
(\TEDIT.OPENTEXTSTREAM.PIECES TEXT TSTREAM START END PROPS))
|
||||
(CL:WHEN WINDOW (* ;
|
||||
"WINDOW is Tedit on call from TEDIT")
|
||||
(SETQ WINDOW (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))]
|
||||
|
||||
(* ;; "We now have all the pieces, even for TEXT=NIL (empty document) case.")
|
||||
(* ;; "We now have all the pieces, even for TEXT=NIL (empty document) case.")
|
||||
|
||||
(CL:WHEN WINDOW (* ; "Connect to the window")
|
||||
(\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS))
|
||||
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL TSTREAM)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM))
|
||||
(CL:WHEN WINDOW (* ; "Connect to the window")
|
||||
(\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS))
|
||||
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL TSTREAM)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM)
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)
|
||||
(TEDIT.PAGEFORMAT TEXTOBJ TEDIT.PAGE.FRAMES))
|
||||
(for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM))
|
||||
@@ -1357,7 +1366,8 @@
|
||||
TSTREAM))])
|
||||
|
||||
(COPYTEXTSTREAM
|
||||
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 12-Jan-2025 12:16 by rmk")
|
||||
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 8-Feb-2025 20:10 by rmk")
|
||||
(* ; "Edited 12-Jan-2025 12:16 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 12:27 by rmk")
|
||||
@@ -1387,7 +1397,7 @@
|
||||
(\TEDIT.INSERTPIECE NEWPC NIL NEWTEXTOBJ))
|
||||
(FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
|
||||
(FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||
(FSETTOBJ NEWTEXTOBJ FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(FSETTOBJ NEWTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL))
|
||||
(FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL))
|
||||
(FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET))
|
||||
@@ -1508,7 +1518,8 @@
|
||||
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 25-Nov-2024 14:33 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Feb-2025 08:56 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 14:33 by rmk")
|
||||
(* ; "Edited 20-Nov-2024 23:56 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 10:51 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:42 by rmk")
|
||||
@@ -1529,53 +1540,53 @@
|
||||
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
SELPROP)
|
||||
(SETQ SELPROP (GETTEXTPROP TEXTOBJ 'SEL))
|
||||
(FSETSEL SEL SET T)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(CL:UNLESS (EQ SELPROP 'DON'T)
|
||||
(FSETSEL SEL SELKIND 'CHAR) (* ; "Default, maybe reset below")
|
||||
(if (type? SELECTION SELPROP)
|
||||
then (* ;
|
||||
(CL:UNLESS (AND SEL (GETSEL SEL SET))
|
||||
(SETQ SELPROP (GETTEXTPROP TEXTOBJ 'SEL))
|
||||
(FSETSEL SEL SET T)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(CL:UNLESS (EQ SELPROP 'DON'T)
|
||||
(FSETSEL SEL SELKIND 'CHAR) (* ; "Default, maybe reset below")
|
||||
(if (type? SELECTION SELPROP)
|
||||
then (* ;
|
||||
"We came in with an explicit initial selection. Set it up.")
|
||||
(\TEDIT.COPYSEL SELPROP SEL)
|
||||
elseif (LISTP SELPROP)
|
||||
then
|
||||
(* ;; "Default to POINT selection")
|
||||
(\TEDIT.COPYSEL SELPROP SEL)
|
||||
elseif (LISTP SELPROP)
|
||||
then
|
||||
(* ;; "Default to POINT selection")
|
||||
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR SELPROP)
|
||||
(OR (CADR SELPROP)
|
||||
0)
|
||||
(OR (CADDR SELPROP)
|
||||
'LEFT))
|
||||
(FSETSEL SEL SELKIND 'CHAR)
|
||||
elseif (FIXP SELPROP)
|
||||
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
|
||||
elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
|
||||
then
|
||||
(* ;; "Default to after the last character")
|
||||
(\TEDIT.UPDATE.SEL SEL (CAR SELPROP)
|
||||
(OR (CADR SELPROP)
|
||||
0)
|
||||
(OR (CADDR SELPROP)
|
||||
'LEFT))
|
||||
(FSETSEL SEL SELKIND 'CHAR)
|
||||
elseif (FIXP SELPROP)
|
||||
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
|
||||
elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
|
||||
then
|
||||
(* ;; "Default to after the last character")
|
||||
|
||||
(\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
0
|
||||
'RIGHT)
|
||||
else
|
||||
(* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1, But UPDATE.SEL adds 1 when DCH=0. That's wrong for the initial caret, so brute-force fix it here. Maybe it's wrong in general?")
|
||||
(\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
0
|
||||
'RIGHT)
|
||||
else
|
||||
(* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1, But UPDATE.SEL adds 1 when DCH=0. That's wrong for the initial caret, so brute-force fix it here. Maybe it's wrong in general?")
|
||||
|
||||
(\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
|
||||
(FSETSEL SEL CHLIM 1))
|
||||
[FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET)
|
||||
then (* ;
|
||||
(\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
|
||||
(FSETSEL SEL CHLIM 1))
|
||||
[FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET)
|
||||
then (* ;
|
||||
"An initial selection implies initial caret looks.")
|
||||
(\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)
|
||||
else (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (GETTOBJ TEXTOBJ
|
||||
|
||||
DEFAULTCHARLOOKS
|
||||
]
|
||||
(CL:WHEN (OR (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(FGETTOBJ TEXTOBJ TXTAPPENDONLY)) (* ;
|
||||
(\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)
|
||||
else (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
|
||||
(GETTOBJ TEXTOBJ DEFAULTCHARLOOKS]
|
||||
(CL:WHEN (OR (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(FGETTOBJ TEXTOBJ TXTAPPENDONLY))
|
||||
(* ;
|
||||
"Don't blink for read-only, but do highlighting")
|
||||
(FSETSEL SEL HASCARET NIL))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
|
||||
(FSETSEL SEL HASCARET NIL))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)))
|
||||
SEL])
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.WINDOW
|
||||
@@ -1617,7 +1628,9 @@
|
||||
WINDOW])
|
||||
|
||||
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 29-Dec-2024 20:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Mar-2025 21:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:04 by rmk")
|
||||
(* ; "Edited 29-Dec-2024 20:37 by rmk")
|
||||
(* ; "Edited 20-Dec-2024 11:56 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 13:14 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 14:35 by rmk")
|
||||
@@ -1638,7 +1651,7 @@
|
||||
|
||||
(SETQ FONT (OR (GETTEXTPROP TEXTOBJ 'FONT)
|
||||
(FONTCREATE DEFAULTFONT)))
|
||||
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'LOOKS))
|
||||
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'CHARLOOKS))
|
||||
(SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
|
||||
(AND (type? CHARLOOKS FONT)
|
||||
FONT)
|
||||
@@ -1646,13 +1659,14 @@
|
||||
(SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ))
|
||||
(SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
|
||||
(OR (GETTEXTPROP TEXTOBJ 'PARALOOKS)
|
||||
(create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)
|
||||
)
|
||||
(create PARALOOKS using
|
||||
TEDIT.DEFAULT.FMTSPEC
|
||||
))
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ))
|
||||
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ FMTSPEC PARALOOKS])
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
|
||||
|
||||
(\TEDIT.OPENTEXTFILE
|
||||
[LAMBDA (TEXT PROPS) (* ; "Edited 21-Nov-2024 11:38 by rmk")
|
||||
@@ -1683,7 +1697,8 @@
|
||||
(ERROR TEXT " does not identify a Tedit document")))])
|
||||
|
||||
(\TEDIT.CREATE.TEXTSTREAM
|
||||
[LAMBDA (PROPS) (* ; "Edited 16-Mar-2024 09:52 by rmk")
|
||||
[LAMBDA (PROPS) (* ; "Edited 7-Feb-2025 08:09 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 09:52 by rmk")
|
||||
(* ; "Edited 21-Jan-2024 15:16 by rmk")
|
||||
(* ; "Edited 17-Sep-2023 00:38 by rmk")
|
||||
(* ; "Edited 12-Sep-2023 11:27 by rmk")
|
||||
@@ -1696,7 +1711,7 @@
|
||||
(SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
|
||||
(\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
|
||||
(\TEDIT.MAKEPCTB TEXTOBJ)
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
0)
|
||||
TSTREAM])
|
||||
|
||||
@@ -1971,7 +1986,8 @@
|
||||
(\TEDIT.DELETE TEXTOBJ TAILSEL)))])
|
||||
|
||||
(\TEDIT.TEXTGETFILEPTR
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-May-2024 21:14 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Feb-2025 08:12 by rmk")
|
||||
(* ; "Edited 7-May-2024 21:14 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 14:19 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 20:57 by rmk")
|
||||
@@ -1985,7 +2001,7 @@
|
||||
(PC (ffetch (TEXTSTREAM PIECE) of TSTREAM))
|
||||
PCCHARSLEFT)
|
||||
(if (OR (NULL PC)
|
||||
(\LASTPIECEP PC TEXTOBJ))
|
||||
(\SUFFIXPIECEP PC TEXTOBJ))
|
||||
then
|
||||
(* ;; "Not set or off the end")
|
||||
|
||||
@@ -1994,7 +2010,7 @@
|
||||
then
|
||||
(* ;; "Replace a lingering piece from a delete-everything?")
|
||||
|
||||
(freplace (TEXTSTREAM PIECE) of TSTREAM with (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(freplace (TEXTSTREAM PIECE) of TSTREAM with (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
0
|
||||
else (* ; "Somewhere inside the document")
|
||||
(SETQ PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))
|
||||
@@ -2104,13 +2120,18 @@
|
||||
THEN (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE])
|
||||
|
||||
(\TEDIT.TEXTLEFTMARGIN
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 17-Mar-2024 12:30 by rmk")
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 19-Feb-2025 13:39 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 17:13 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:30 by rmk")
|
||||
(* ; "Edited 31-May-91 14:03 by jds")
|
||||
(IPLUS 8 (fetch (FMTSPEC LEFTMAR) of (FGETTOBJ (TEXTOBJ TSTREAM)
|
||||
FMTSPEC])
|
||||
(IPLUS 8 (GETPLOOKS (FGETTOBJ (TEXTOBJ TSTREAM)
|
||||
DEFAULTPARALOOKS)
|
||||
LEFTMAR])
|
||||
|
||||
(\TEDIT.TEXTRIGHTMARGIN
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 28-Jun-2024 22:07 by rmk")
|
||||
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 19-Feb-2025 13:39 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:35 by rmk")
|
||||
(* ; "Edited 28-Jun-2024 22:07 by rmk")
|
||||
(* ; "Edited 21-Sep-2023 12:38 by rmk")
|
||||
(* ; "Edited 31-May-91 14:03 by jds")
|
||||
|
||||
@@ -2122,25 +2143,25 @@
|
||||
|
||||
(* ;; "If RIGHTMAR is 0 and there is no window (WRIGHT), estimate from the stream's linelength.")
|
||||
|
||||
(* ;; "If \TEDIT.MINIMAL.WINDOW.SETUP sets WRIGHT, maybe that's enough? I.e. the right margin is either the width of the window or calculated from the LINELENGTH. It wouldn't depend on the default FMTSPEC or the FMTSPEC of the current piece.")
|
||||
(* ;; "If \TEDIT.MINIMAL.WINDOW.SETUP sets WRIGHT, maybe that's enough? I.e. the right margin is either the width of the window or calculated from the LINELENGTH. It wouldn't depend on the default PARALOOKS or the PARALOOKS of the current piece.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(if (FGETTOBJ TEXTOBJ PRIMARYPANE)
|
||||
then (LET* ((FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
|
||||
(RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))
|
||||
then (LET* ((PARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
||||
(RIGHTMAR (FGETPLOOKS PARALOOKS RIGHTMAR))
|
||||
LEFTMAR NEWPOS)
|
||||
(CL:WHEN (ZEROP RIGHTMAR)
|
||||
(SETQ RIGHTMAR (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)))
|
||||
(SETQ RIGHTMAR (FGETTOBJ TEXTOBJ WRIGHT)))
|
||||
(CL:WHEN (AND XPOSITION (NEQ XPOSITION RIGHTMAR))
|
||||
(* ; "Changing the default FMTSPEC")
|
||||
(SETQ LEFTMAR (fetch (FMTSPEC LEFTMAR) of FMTSPEC))
|
||||
(* ; "Changing the default PARALOOKS")
|
||||
(SETQ LEFTMAR (FGETPLOOKS PARALOOKS LEFTMAR))
|
||||
(CL:WHEN (ILEQ RIGHTMAR LEFTMAR)
|
||||
(\ILLEGAL.ARG XPOSITION))
|
||||
(FSETTOBJ TEXTOBJ FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS (create FMTSPEC
|
||||
using FMTSPEC
|
||||
RIGHTMAR _
|
||||
XPOSITION)
|
||||
TEXTOBJ))
|
||||
(FSETTOBJ TEXTOBJ DEFAULTPARALOOKS
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS (create PARALOOKS
|
||||
using PARALOOKS RIGHTMAR _ XPOSITION
|
||||
)
|
||||
TEXTOBJ))
|
||||
(LINELENGTH (IQUOTIENT (IDIFFERENCE RIGHTMAR XPOSITION)
|
||||
(CHARWIDTH (CHARCODE A)
|
||||
TSTREAM))
|
||||
@@ -2178,6 +2199,190 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "Access by character")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.NTHCHARCODE
|
||||
[LAMBDA (TSTREAM N) (* ; "Edited 28-Mar-2025 18:31 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:09 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 13:06 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 1-Feb-2024 09:50 by rmk")
|
||||
(* ; "Edited 8-Nov-2023 08:41 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 15:23 by rmk")
|
||||
|
||||
(* ;; "Returns the Nth character of TEXTOBJ. First character is N=1, NIL if out of bounds. If TSTREAM is a selection, treats it as a substring, N is relative to that.")
|
||||
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
START-OF-PIECE)
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(CL:WHEN (AND (IGEQ N 1)
|
||||
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(\TEDIT.PIECE.NTHCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||
(IDIFFERENCE (ADD1 N)
|
||||
START-OF-PIECE)))])
|
||||
|
||||
(\TEDIT.PIECE.NTHCHARCODE
|
||||
[LAMBDA (TEXTOBJ PC OFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 08:46 by rmk")
|
||||
(* ; "Edited 22-Mar-2024 00:02 by rmk")
|
||||
(* ; "Edited 1-Feb-2024 09:55 by rmk")
|
||||
(* ; "Edited 6-Jan-2024 16:36 by rmk")
|
||||
(* ; "Edited 29-Dec-2023 11:55 by rmk")
|
||||
(* ; "Edited 8-Dec-2023 22:54 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 15:57 by rmk")
|
||||
(* ; "Edited 8-Nov-2023 08:43 by rmk")
|
||||
(* ; "Edited 5-Nov-2023 08:17 by rmk")
|
||||
|
||||
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.")
|
||||
|
||||
(CL:WHEN (AND (IGEQ OFFSET 1)
|
||||
(ILEQ OFFSET (PLEN PC)))
|
||||
[LET ((PCONTENTS (PCONTENTS PC))
|
||||
FILEPOS)
|
||||
(SELECTC (PTYPE PC)
|
||||
(STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET))
|
||||
(THINFILE.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(SUB1 OFFSET)))
|
||||
(PROG1 (BIN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(FATFILE1.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(SUB1 OFFSET)))
|
||||
(PROG1 (create WORD
|
||||
HIBYTE _ (PCHARSET PC)
|
||||
LOBYTE _ (BIN PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(FATFILE2.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(UNFOLD (SUB1 OFFSET)
|
||||
2)))
|
||||
(PROG1 (\WIN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
[\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(ITIMES (SUB1 OFFSET)
|
||||
(PBYTESPERCHAR PC]
|
||||
(PROG1 (UTF8.INCCODEFN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(OBJECT.PTYPE PCONTENTS)
|
||||
(SUBSTREAM.PTYPE (* ; "A substream stored as an object")
|
||||
(\TEDIT.THELP 'SUBSTREAM?)
|
||||
(BIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
|
||||
(PROGN
|
||||
(* ;; "For pieces not listed because they require more work. Assumes the function updates COFFSET and that multi-byte characters are safe: don't cross buffer boundaries.")
|
||||
|
||||
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
|
||||
|
||||
(\TEDIT.RPLCHARCODE
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||
|
||||
(* ;; "Replaces the Nth charcode (or object) in TSTREAM with NEWCHARCODE (or object) with NEWCHARLOOKS. This is accomplished by isolating the target character into a length 1 piece, then converting that into a string (or object) piece containing NEWCHAR.")
|
||||
|
||||
(* ;; "If DONTDISPLAY, this doesn't update the display. ")
|
||||
|
||||
(* ;; "NOTE: this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(CL:UNLESS (\TEDIT.READONLY TSTREAM)
|
||||
(PROG ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
|
||||
PC OFFSET START-OF-PIECE OLDCHAR PARALAST)
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(replace (STREAM BINABLE) of TSTREAM with NIL)
|
||||
(SETQ PC (\TEDIT.CHTOPC N TEXTOBJ T))
|
||||
(SETQ OFFSET (ADD1 (IDIFFERENCE N START-OF-PIECE)))
|
||||
(* ; "Change is at OFFSET 1")
|
||||
(SETQ PARALAST (MEMB NEWCHARCODE (FGETTOBJ TEXTOBJ PARABREAKCHARS)))
|
||||
[if (AND (SMALLP NEWCHARCODE)
|
||||
(MEMB (PTYPE PC)
|
||||
STRING.PTYPES)
|
||||
(OR (NULL NEWCHARLOOKS)
|
||||
(EQ NEWCHARLOOKS (PLOOKS PC)))
|
||||
(NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(NOT PARALAST))
|
||||
then
|
||||
(* ;;
|
||||
"Fast case: Smash a new character code into an existing string piece with same looks. ")
|
||||
|
||||
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
|
||||
OFFSET))
|
||||
(RPLCHARCODE (PCONTENTS PC)
|
||||
OFFSET NEWCHARCODE) (* ;
|
||||
"May upgrade string from thin to fat")
|
||||
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
||||
(IGREATERP NEWCHARCODE 255))
|
||||
(FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
(FSETPC PC PBYTELEN (UNFOLD (PLEN PC)
|
||||
2)))
|
||||
elseif [AND (IMAGEOBJP NEWCHARCODE)
|
||||
(EQ OBJECT.PTYPE (PTYPE PC))
|
||||
(OR (NULL NEWCHARLOOKS)
|
||||
(EQ NEWCHARLOOKS (PLOOKS PC]
|
||||
then (SETQ OLDCHAR (POBJ PC)) (* ; "We know PLEN is 1")
|
||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||
else
|
||||
(* ;;
|
||||
"The PC that contained character N becomes the suffix of characters after N, ")
|
||||
|
||||
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
|
||||
|
||||
(* ;;
|
||||
"Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))) (* ;
|
||||
"Original PC holds the suffix, new PC ends with change position.")
|
||||
(CL:UNLESS (EQ OFFSET 1)
|
||||
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
|
||||
TEXTOBJ))) (* ;
|
||||
"Chop off the prefix. PC is now the singleton target ")
|
||||
|
||||
(* ;; "N is now isolated into a one-character new piece which we smash. ")
|
||||
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC 1))
|
||||
(if (IMAGEOBJP NEWCHARCODE)
|
||||
then (FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||
(FSETPC PC PTYPE OBJECT.PTYPE)
|
||||
(FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects")
|
||||
(FSETPC PC PBYTELEN NIL)
|
||||
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
|
||||
(* ;
|
||||
"Use the extend-string in INSERTCH for repeated calls?")
|
||||
(if (IGREATERP NEWCHARCODE 255)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
(FSETPC PC PBYTELEN 2)
|
||||
else (FSETPC PC PTYPE THINSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE T)
|
||||
(FSETPC PC PBYTESPERCHAR 1)
|
||||
(FSETPC PC PBYTELEN 1)
|
||||
(FSETPC PC PCHARSET 0)))
|
||||
(FSETPC PC PFPOS NIL)
|
||||
(CL:WHEN NEWCHARLOOKS
|
||||
(FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS)
|
||||
(\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
|
||||
NEWCHARLOOKS)
|
||||
TEXTOBJ)
|
||||
NEWCHARLOOKS)))]
|
||||
(CL:WHEN PARALAST (FSETPC PC PPARALAST T))
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
|
||||
OLDCHAR))
|
||||
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED N 1))
|
||||
(RETURN TSTREAM)))])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Editing support")
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -2208,7 +2413,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.DELETE.SELPIECES
|
||||
[LAMBDA (TEXTOBJ FIRSTCHAR LEN) (* ; "Edited 26-Nov-2024 22:31 by rmk")
|
||||
[LAMBDA (TEXTOBJ FIRSTCHAR LEN DONTCHECK) (* ; "Edited 5-Feb-2025 23:33 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 22:31 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:34 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 09:09 by rmk")
|
||||
(* ; "Edited 7-May-2024 21:14 by rmk")
|
||||
@@ -2228,10 +2434,10 @@
|
||||
(CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'START TEXTOBJ)
|
||||
(LET (SELPIECES PREVPC)
|
||||
(CL:WHEN (AND (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
|
||||
(CL:WHEN [AND (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
|
||||
TEXTOBJ))
|
||||
(for PC inselpieces (PROGN SELPIECES) always (OBJECT.ALLOWS PC
|
||||
'DELETE TEXTOBJ)))
|
||||
(OR DONTCHECK (for PC inselpieces (PROGN SELPIECES)
|
||||
always (OBJECT.ALLOWS PC 'DELETE TEXTOBJ]
|
||||
(SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST)))
|
||||
(\TEDIT.DELETEPIECES SELPIECES TEXTOBJ)
|
||||
|
||||
@@ -2257,7 +2463,8 @@
|
||||
T)))])
|
||||
|
||||
(\TEDIT.INSERTCH
|
||||
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 22-Nov-2024 13:48 by rmk")
|
||||
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 26-Mar-2025 00:29 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 13:48 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 12:32 by rmk")
|
||||
(* ; "Edited 13-Aug-2024 08:30 by rmk")
|
||||
(* ; "Edited 18-May-2024 19:04 by rmk")
|
||||
@@ -2347,12 +2554,11 @@
|
||||
(FSETPC PREVPC PBYTELEN ILEN)
|
||||
(FSETPC PREVPC PBINABLE T)
|
||||
(FSETPC PREVPC PCHARSET 0))
|
||||
(FATSTRING.PTYPE
|
||||
(FATSTRING.PTYPE (* ; "PCHARSET is not relevant")
|
||||
(FSETPC PREVPC PBYTESPERCHAR 2)
|
||||
(FSETPC PREVPC PBYTELEN (UNFOLD ILEN 2))
|
||||
(FSETPC PREVPC PBINABLE NIL)
|
||||
(FSETPC PREVPC PCHARSET \NORUNCODE))
|
||||
NIL)
|
||||
(FSETPC PREVPC PBINABLE NIL))
|
||||
(\TEDIT.THELP "Unexpected PTYPE"))
|
||||
(\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))
|
||||
|
||||
(* ;; "The insertion is done and the pieces are properly integrated into the stream. ")
|
||||
@@ -2698,7 +2904,9 @@
|
||||
(CADR PTAIL])
|
||||
|
||||
(\TEDIT.TEXTPROP
|
||||
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 22-Dec-2024 00:23 by rmk")
|
||||
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 16-Feb-2025 23:27 by rmk")
|
||||
(* ; "Edited 15-Feb-2025 14:02 by rmk")
|
||||
(* ; "Edited 22-Dec-2024 00:23 by rmk")
|
||||
(* ; "Edited 23-Nov-2024 09:47 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 11:53 by rmk")
|
||||
(* ; "Edited 18-Nov-2024 16:37 by rmk")
|
||||
@@ -2740,7 +2948,7 @@
|
||||
(DON'TUPDATE (PROG1 (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)
|
||||
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NEWVALUE))))
|
||||
(NOTSPLITTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
||||
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE T))))
|
||||
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE NEWVALUE))))
|
||||
(DIRTY (PROG1 (FGETTOBJ TEXTOBJ \XDIRTY)
|
||||
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ \DIRTY NEWVALUE))))
|
||||
(LENGTH (PROG1 (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
@@ -2768,6 +2976,11 @@
|
||||
(fetch FULLFILENAME of (FGETTOBJ TEXTOBJ TXTFILE)))
|
||||
(CL:WHEN (AND SETNEWVALUE (NEQ NEWVALUE NIL))
|
||||
(ERROR "FILENAME cannot be changed"))))
|
||||
(FILESTREAM (PROG1 (FGETTOBJ TEXTOBJ TXTFILE)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(CL:WHEN (AND NEWVALUE (NOT (type? STREAM NEWVALUE)))
|
||||
(\ILLEGAL.ARG NEWVALUE))
|
||||
(FSETTOBJ TEXTOBJ TXTFILE NEWVALUE))))
|
||||
(PAGEFORMAT (PROG1 (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(CL:UNLESS (type? PAGEREGION NEWVALUE)
|
||||
@@ -2856,31 +3069,32 @@
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (36869 67470 (\TEDIT.TEXTBIN 36879 . 47629) (\TEDIT.TEXTPEEKBIN 47631 . 53181) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53183 . 58856) (\TEDIT.TEXTBOUT 58858 . 63260) (\TEDIT.INSTALL.FILEBUFFER 63262
|
||||
. 67468)) (68368 72416 (\TEDIT.TEXTOUTCHARFN 68378 . 69934) (\TEDIT.TEXTINCCODEFN 69936 . 70675) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70677 . 71269) (\TEDIT.TEXTFORMATBYTESTREAM 71271 . 71974) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 71976 . 72414)) (72463 83763 (OPENTEXTSTREAM 72473 . 79331) (
|
||||
COPYTEXTSTREAM 79333 . 82986) (TEDIT.STREAMCHANGEDP 82988 . 83290) (TXTFILE 83292 . 83761)) (83764
|
||||
113041 (\TEDIT.REOPENTEXTSTREAM 83774 . 85126) (\TEDIT.OPENTEXTSTREAM.PIECES 85128 . 89558) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 89560 . 90662) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 90664 . 95599) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 95601 . 98282) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98284 . 100933) (
|
||||
\TEDIT.OPENTEXTFILE 100935 . 102648) (\TEDIT.CREATE.TEXTSTREAM 102650 . 103584) (\TEDIT.REOPEN.STREAM
|
||||
103586 . 105922) (\TEDIT.TEXTINIT 105924 . 113039)) (113079 114267 (\TEDIT.TTYBOUT 113089 . 114265)) (
|
||||
114385 132762 (\TEDIT.TEXTCLOSEF 114395 . 115719) (\TEDIT.TEXTDSPFONT 115721 . 116691) (
|
||||
\TEDIT.TEXTEOFP 116693 . 118448) (\TEDIT.TEXTGETEOFPTR 118450 . 118773) (\TEDIT.TEXTSETEOFPTR 118775
|
||||
. 119865) (\TEDIT.TEXTGETFILEPTR 119867 . 122589) (\TEDIT.TEXTSETFILEINFO 122591 . 123099) (
|
||||
\TEDIT.TEXTOPENF 123101 . 124032) (\TEDIT.TEXTSETEOF 124034 . 124650) (\TEDIT.TEXTSETFILEPTR 124652 .
|
||||
126693) (\TEDIT.TEXTDSPXPOSITION 126695 . 127712) (\TEDIT.TEXTDSPYPOSITION 127714 . 128455) (
|
||||
\TEDIT.TEXTLEFTMARGIN 128457 . 128834) (\TEDIT.TEXTRIGHTMARGIN 128836 . 131911) (
|
||||
\TEDIT.TEXTDSPCHARWIDTH 131913 . 132217) (\TEDIT.TEXTDSPSTRINGWIDTH 132219 . 132525) (
|
||||
\TEDIT.TEXTDSPLINEFEED 132527 . 132760)) (133809 154460 (\TEDIT.DELETE.SELPIECES 133819 . 137246) (
|
||||
\TEDIT.INSERTCH 137248 . 145042) (\TEDIT.INSERTCH.HISTORY 145044 . 148508) (\TEDIT.INSERTEOL 148510 .
|
||||
150335) (\TEDIT.INSERTCH.INSERTION 150337 . 153174) (\TEDIT.INSERTCH.EXTEND 153176 . 154458)) (154461
|
||||
155965 (\TEDIT.NEXTCHANGEABLE.CHNO 154471 . 155186) (\TEDIT.LASTCHANGEABLE.CHNO 155188 . 155963)) (
|
||||
155966 157670 (\SETUPGETCH 155976 . 157668)) (157728 162186 (\TEDIT.INSTALL.PIECE 157738 . 162184)) (
|
||||
162224 170436 (TEXTPROP 162234 . 162581) (GETTEXTPROP 162583 . 162827) (PUTTEXTPROP 162829 . 163086) (
|
||||
GETTEXTPROPS 163088 . 163532) (PUTTEXTPROPS 163534 . 164438) (\TEDIT.TEXTPROP 164440 . 170434)) (
|
||||
170437 172507 (\TEDIT.TEXTOBJ.PROPNAMES 170447 . 171399) (\TEDIT.TEXTOBJ.PROPFETCHFN 171401 . 171917)
|
||||
(\TEDIT.TEXTOBJ.PROPSTOREFN 171919 . 172505)))))
|
||||
(FILEMAP (NIL (37315 68029 (\TEDIT.TEXTBIN 37325 . 48075) (\TEDIT.TEXTPEEKBIN 48077 . 53627) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53629 . 59302) (\TEDIT.TEXTBOUT 59304 . 63819) (\TEDIT.INSTALL.FILEBUFFER 63821
|
||||
. 68027)) (68927 72975 (\TEDIT.TEXTOUTCHARFN 68937 . 70493) (\TEDIT.TEXTINCCODEFN 70495 . 71234) (
|
||||
\TEDIT.TEXTBACKCCODEFN 71236 . 71828) (\TEDIT.TEXTFORMATBYTESTREAM 71830 . 72533) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72535 . 72973)) (73022 84543 (OPENTEXTSTREAM 73032 . 79984) (
|
||||
COPYTEXTSTREAM 79986 . 83766) (TEDIT.STREAMCHANGEDP 83768 . 84070) (TXTFILE 84072 . 84541)) (84544
|
||||
114404 (\TEDIT.REOPENTEXTSTREAM 84554 . 85906) (\TEDIT.OPENTEXTSTREAM.PIECES 85908 . 90338) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 90340 . 91442) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91444 . 96530) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 96532 . 99213) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99215 . 102185) (
|
||||
\TEDIT.OPENTEXTFILE 102187 . 103900) (\TEDIT.CREATE.TEXTSTREAM 103902 . 104947) (\TEDIT.REOPEN.STREAM
|
||||
104949 . 107285) (\TEDIT.TEXTINIT 107287 . 114402)) (114442 115630 (\TEDIT.TTYBOUT 114452 . 115628)) (
|
||||
115748 134540 (\TEDIT.TEXTCLOSEF 115758 . 117082) (\TEDIT.TEXTDSPFONT 117084 . 118054) (
|
||||
\TEDIT.TEXTEOFP 118056 . 119811) (\TEDIT.TEXTGETEOFPTR 119813 . 120136) (\TEDIT.TEXTSETEOFPTR 120138
|
||||
. 121228) (\TEDIT.TEXTGETFILEPTR 121230 . 124065) (\TEDIT.TEXTSETFILEINFO 124067 . 124575) (
|
||||
\TEDIT.TEXTOPENF 124577 . 125508) (\TEDIT.TEXTSETEOF 125510 . 126126) (\TEDIT.TEXTSETFILEPTR 126128 .
|
||||
128169) (\TEDIT.TEXTDSPXPOSITION 128171 . 129188) (\TEDIT.TEXTDSPYPOSITION 129190 . 129931) (
|
||||
\TEDIT.TEXTLEFTMARGIN 129933 . 130524) (\TEDIT.TEXTRIGHTMARGIN 130526 . 133689) (
|
||||
\TEDIT.TEXTDSPCHARWIDTH 133691 . 133995) (\TEDIT.TEXTDSPSTRINGWIDTH 133997 . 134303) (
|
||||
\TEDIT.TEXTDSPLINEFEED 134305 . 134538)) (134578 145928 (\TEDIT.NTHCHARCODE 134588 . 135938) (
|
||||
\TEDIT.PIECE.NTHCHARCODE 135940 . 139741) (\TEDIT.RPLCHARCODE 139743 . 145926)) (146975 167848 (
|
||||
\TEDIT.DELETE.SELPIECES 146985 . 150498) (\TEDIT.INSERTCH 150500 . 158430) (\TEDIT.INSERTCH.HISTORY
|
||||
158432 . 161896) (\TEDIT.INSERTEOL 161898 . 163723) (\TEDIT.INSERTCH.INSERTION 163725 . 166562) (
|
||||
\TEDIT.INSERTCH.EXTEND 166564 . 167846)) (167849 169353 (\TEDIT.NEXTCHANGEABLE.CHNO 167859 . 168574) (
|
||||
\TEDIT.LASTCHANGEABLE.CHNO 168576 . 169351)) (169354 171058 (\SETUPGETCH 169364 . 171056)) (171116
|
||||
175574 (\TEDIT.INSTALL.PIECE 171126 . 175572)) (175612 184361 (TEXTPROP 175622 . 175969) (GETTEXTPROP
|
||||
175971 . 176215) (PUTTEXTPROP 176217 . 176474) (GETTEXTPROPS 176476 . 176920) (PUTTEXTPROPS 176922 .
|
||||
177826) (\TEDIT.TEXTPROP 177828 . 184359)) (184362 186432 (\TEDIT.TEXTOBJ.PROPNAMES 184372 . 185324) (
|
||||
\TEDIT.TEXTOBJ.PROPFETCHFN 185326 . 185842) (\TEDIT.TEXTOBJ.PROPSTOREFN 185844 . 186430)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
234
library/tedit/TEDIT-STYLES
Normal file
234
library/tedit/TEDIT-STYLES
Normal file
@@ -0,0 +1,234 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2025 13:31:28" {WMEDLEY}<library>tedit>TEDIT-STYLES.;4 12550
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES)
|
||||
|
||||
:PREVIOUS-DATE "12-Feb-2025 12:18:37" {WMEDLEY}<library>tedit>TEDIT-STYLES.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STYLESCOMS)
|
||||
|
||||
(RPAQQ TEDIT-STYLESCOMS
|
||||
( (* ; "Style-sheet support")
|
||||
(FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET
|
||||
TEDIT.PUSH.STYLESHEET TEDIT.ADD.STYLESHEET)
|
||||
|
||||
(* ;; "*TEDIT-PARASTYLE-CACHE* is an ALIST of original char/para looks to styled char/para looks. It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles.")
|
||||
|
||||
|
||||
(* ;; "*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are. Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries. Mostly, this'll be NIL and not interesting.")
|
||||
|
||||
|
||||
(* ;; "*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET")
|
||||
|
||||
(INITVARS (TEDIT.STYLES))
|
||||
|
||||
(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")
|
||||
|
||||
(GLOBALVARS TEDIT.STYLES)
|
||||
(INITVARS (*TEDIT-PARASTYLE-CACHE*)
|
||||
(*TEDIT-CURRENTPARA-CACHE*)
|
||||
(*TEDIT-STYLESHEET-SAVE-LIST*))
|
||||
(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)))
|
||||
|
||||
|
||||
|
||||
(* ; "Style-sheet support")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.APPLY.STYLES
|
||||
[LAMBDA (LOOKS PC TSTREAM) (* ; "Edited 19-Feb-2025 13:31 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:07 by rmk")
|
||||
(* ; "Edited 12-Nov-2023 16:08 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 21:45 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:28 by rmk")
|
||||
(* ; "Edited 11-Sep-2022 14:45 by rmk")
|
||||
(* ;
|
||||
"Edited 4-Jul-93 01:02 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Given a set of looks, return the looks with the proper styles expanded out.")
|
||||
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*))
|
||||
(CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(STYLE (GETCLOOKS LOOKS CLSTYLE))
|
||||
(STYLE-SHEET (OR (FGETTOBJ TEXTOBJ TXTSTYLESHEET)
|
||||
TEDIT.STYLES))
|
||||
NOSTYLE CHARSTYLES CHARSTYLE IN-PARA)
|
||||
(SETQ STYLE (COND
|
||||
((NULL STYLE) (* ;
|
||||
"STYLE of NIL means don't bother. Just use the looks we got.")
|
||||
(SETQ NOSTYLE T)
|
||||
LOOKS)
|
||||
((AND (SETQ CHARSTYLES (AND (GETTSTR TSTREAM CURRENTPARALOOKS)
|
||||
(GETPLOOKS (GETTSTR TSTREAM CURRENTPARALOOKS
|
||||
)
|
||||
FMTCHARSTYLES)))
|
||||
(SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES)))
|
||||
(* ;
|
||||
"If the paragraph we're in has character styles, and this is one of them, use it.")
|
||||
(SETQ IN-PARA T)
|
||||
CHARSTYLE)
|
||||
((CDR (SASSOC STYLE STYLE-SHEET)))
|
||||
((AND (LITATOM STYLE)
|
||||
(DEFINEDP STYLE)) (* ;
|
||||
"Call the guy's function to find the new looks")
|
||||
(APPLY* STYLE LOOKS PC TEXTOBJ))
|
||||
(T (* ;
|
||||
"If all else fails, return the original set of looks")
|
||||
(SETQ NOSTYLE T)
|
||||
LOOKS)))
|
||||
(SETQ STYLE (COND
|
||||
((LISTP STYLE)
|
||||
(\TEDIT.PARSE.CHARLOOKS.LIST (APPEND STYLE '(STYLE NIL))
|
||||
LOOKS TEXTOBJ))
|
||||
(T STYLE)))
|
||||
|
||||
(* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.")
|
||||
|
||||
[OR NOSTYLE (CL:IF IN-PARA
|
||||
(push *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE))
|
||||
(push *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))]
|
||||
STYLE])
|
||||
|
||||
(\TEDIT.APPLY.PARASTYLES
|
||||
[LAMBDA (PARALOOKS PC TEXTOBJ) (* ; "Edited 19-Feb-2025 13:31 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:07 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 14:48 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 11:06 by rmk")
|
||||
(* ; "Edited 4-Mar-2023 22:23 by rmk")
|
||||
(* ; "Edited 25-Sep-2022 13:26 by rmk")
|
||||
(* ;
|
||||
"Edited 3-Jul-93 23:15 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Given a set of looks, return the looks with the proper styles expanded out.")
|
||||
|
||||
(\TEDIT.CHECK (type? PARALOOKS PARALOOKS)) (* ; "Incoming thing has to be a LOOKS.")
|
||||
(OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*))
|
||||
(LET* [NOSTYLE (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ)
|
||||
TEDIT.STYLES))
|
||||
(STYLE (COND
|
||||
((NULL (GETPLOOKS PARALOOKS FMTSTYLE))
|
||||
(SETQ NOSTYLE T)
|
||||
PARALOOKS)
|
||||
((CDR (SASSOC (GETPLOOKS PARALOOKS FMTSTYLE)
|
||||
STYLE-SHEET)))
|
||||
((AND (LITATOM (GETPLOOKS PARALOOKS FMTSTYLE))
|
||||
(DEFINEDP (GETPLOOKS PARALOOKS FMTSTYLE)))
|
||||
(* ;
|
||||
"Call the guy's function to find the new looks")
|
||||
(APPLY* (GETPLOOKS PARALOOKS FMTSTYLE)
|
||||
PARALOOKS PC TEXTOBJ))
|
||||
(T (SETQ NOSTYLE T)
|
||||
PARALOOKS]
|
||||
(CL:WHEN (LISTP STYLE)
|
||||
(SETQ STYLE (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL))
|
||||
PARALOOKS TEXTOBJ)))
|
||||
(CL:UNLESS NOSTYLE
|
||||
(push *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE)))
|
||||
STYLE])
|
||||
|
||||
(TEDIT.STYLESHEET
|
||||
[LAMBDA (SHEET TEXTSTREAM) (* ;
|
||||
"Edited 3-Jul-93 23:19 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Put a new stylesheet into force. This REPLACES any existing style sheets, and forgets any pushed sheets.")
|
||||
|
||||
(LET [(TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM]
|
||||
(COND
|
||||
(TEXTOBJ (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(replace (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ with SHEET))
|
||||
(T
|
||||
(* ;; "No specific document given; change the global style sheet TEDIT.STYLES")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES SHEET)
|
||||
(SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
|
||||
|
||||
(TEDIT.POP.STYLESHEET
|
||||
[LAMBDA NIL (* ;
|
||||
"Edited 3-Jul-93 17:42 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Go back to an earlier stylesheet, by popping the stack of saved sheets. You can't pop back to no sheet -- you'll always bottom out at the original style sheet.")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (OR (CL:POP *TEDIT-STYLESHEET-SAVE-LIST*)
|
||||
TEDIT.STYLES])
|
||||
|
||||
(TEDIT.PUSH.STYLESHEET
|
||||
[LAMBDA (SHEET) (* ;
|
||||
"Edited 3-Jul-93 17:40 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Add more style definitions to the current style sheet, and remember how to get back to the old one. Think of this as PUSHING onto a stack of stylesheets, with the new sheet being a composition of SHEET and the existing styles. ")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
|
||||
(CL:PUSH TEDIT.STYLES *TEDIT-STYLESHEET-SAVE-LIST*])
|
||||
|
||||
(TEDIT.ADD.STYLESHEET
|
||||
[LAMBDA (SHEET) (* ;
|
||||
"Edited 3-Jul-93 17:38 by sybalskY:MV:ENVOS")
|
||||
|
||||
(* ;; "Add more style definitions to the current style sheet. This ADDS entries, without remembering that there was an earlier sheet. ")
|
||||
|
||||
(SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ;
|
||||
"Clear the cache, to force reformatting")
|
||||
(SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES))
|
||||
(SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-PARASTYLE-CACHE* is an ALIST of original char/para looks to styled char/para looks. It is used to cache stylings, and is reset when the main stylesheet changes, and when we change paragraph looks, given paras that have private char styles."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-CURRENTPARA-CACHE* is NIL if we're not in a para that has private char styles, or is the PARALOOKS (styled!) for that para, if we are. Used to decide when we have to flush *TEDIT-PARASTYLE-CACHE* at paragraph boundaries. Mostly, this'll be NIL and not interesting."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET"
|
||||
)
|
||||
|
||||
|
||||
(RPAQ? TEDIT.STYLES )
|
||||
|
||||
|
||||
|
||||
(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.STYLES)
|
||||
)
|
||||
|
||||
(RPAQ? *TEDIT-PARASTYLE-CACHE* )
|
||||
|
||||
(RPAQ? *TEDIT-CURRENTPARA-CACHE* )
|
||||
|
||||
(RPAQ? *TEDIT-STYLESHEET-SAVE-LIST* )
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1980 11244 (\TEDIT.APPLY.STYLES 1990 . 5638) (\TEDIT.APPLY.PARASTYLES 5640 . 8118) (
|
||||
TEDIT.STYLESHEET 8120 . 9187) (TEDIT.POP.STYLESHEET 9189 . 9857) (TEDIT.PUSH.STYLESHEET 9859 . 10599)
|
||||
(TEDIT.ADD.STYLESHEET 10601 . 11242)))))
|
||||
STOP
|
||||
BIN
library/tedit/TEDIT-STYLES.LCOM
Normal file
BIN
library/tedit/TEDIT-STYLES.LCOM
Normal file
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Jan-2025 23:45:04" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;166 92474
|
||||
(FILECREATED "28-Mar-2025 14:23:07" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;176 94631
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TFBRAVO.READ.CHARLOOKS \TFBRAVO.FONT.FROM.CHARLOOKS TEDITFROMBRAVO
|
||||
\TFBRAVO.USER.CM.LOOKS)
|
||||
:CHANGES-TO (FNS TEDITFROMBRAVO)
|
||||
|
||||
:PREVIOUS-DATE "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163)
|
||||
:PREVIOUS-DATE "19-Feb-2025 12:18:40" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;175)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||
@@ -73,10 +72,10 @@
|
||||
(RECORD BRAVOFONT (BFFONTNUM BRFAMILY BRSIZE BRWEIGHT BRSLOPE))
|
||||
|
||||
(RECORD PARA (PARAFMTSPEC RUNS FORMATPTRS)
|
||||
(ACCESSFNS (PARATABDEFS (fetch (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC)
|
||||
of DATUM))
|
||||
(replace (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC)
|
||||
of DATUM) with NEWVALUE))))
|
||||
(ACCESSFNS (PARATABDEFS (GETPLOOKS (fetch (PARA PARAFMTSPEC) of DATUM)
|
||||
FMTUSERINFO)
|
||||
(FSETPLOOKS (fetch (PARA PARAFMTSPEC) of DATUM)
|
||||
FMTUSERINFO NEWVALUE))))
|
||||
|
||||
(RECORD RUN (RUNLENGTH RUNLOOKS RUNSTART RUNLAST)
|
||||
(ACCESSFNS (RUNTABS (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of DATUM))
|
||||
@@ -171,7 +170,10 @@
|
||||
(RETURN T])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 2-Jan-2025 22:22 by rmk")
|
||||
[LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 28-Mar-2025 14:16 by rmk")
|
||||
(* ; "Edited 19-Feb-2025 12:13 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:03 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 22:22 by rmk")
|
||||
(* ; "Edited 17-Jan-2024 12:11 by rmk")
|
||||
(* ; "Edited 26-Nov-2023 00:29 by rmk")
|
||||
(* ; "Edited 14-Nov-2023 17:09 by rmk")
|
||||
@@ -184,13 +186,13 @@
|
||||
(* ;;; "Top level entry for conversion from a Bravo file to a textstream. The textstream is returned, %"Writing%" here means sticking it in the textstream, not saving to a Tedit file. Assumes that a stream BFILE is positioned at the first byte to be included.")
|
||||
|
||||
(RESETLST
|
||||
(CL:UNLESS TEXTSTREAM
|
||||
(SETQ TEXTSTREAM (OPENTEXTSTREAM NIL))) (* ;
|
||||
(CL:UNLESS TSTREAM
|
||||
(SETQ TSTREAM (OPENTEXTSTREAM NIL))) (* ;
|
||||
" Produce the USER.CM's alist of default values")
|
||||
(bind PARA NEXTFMTSPEC USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST START (BSTREAM _ BFILE
|
||||
)
|
||||
(TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare (SPECVARS USER.CM.FMTSPEC USER.CM.CHARLOOKS
|
||||
USER.CM.ALIST)
|
||||
(bind PARA NEXTPARALOOKS USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST START
|
||||
(BSTREAM _ BFILE)
|
||||
(TEXTOBJ _ (TEXTOBJ TSTREAM)) declare (SPECVARS USER.CM.PARALOOKS USER.CM.CHARLOOKS
|
||||
USER.CM.ALIST)
|
||||
first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ))
|
||||
(* ; "Go for plain text")
|
||||
(RETURN))
|
||||
@@ -203,18 +205,20 @@
|
||||
(PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT)
|
||||
[RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
`(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE]
|
||||
(SETQ NEXTFMTSPEC USER.CM.FMTSPEC) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(SETQ NEXTPARALOOKS USER.CM.PARALOOKS) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(* ;
|
||||
"Profiles and headings have to back up")
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA NEXTFMTSPEC
|
||||
BSTREAM TEXTOBJ))
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA
|
||||
NEXTPARALOOKS BSTREAM
|
||||
TEXTOBJ))
|
||||
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTPARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
|
||||
(* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text")
|
||||
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (GETPARA NEXTFMTSPEC FMTPARATYPE))
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (GETPLOOKS NEXTPARALOOKS
|
||||
FMTPARATYPE))
|
||||
(\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA
|
||||
TEXTOBJ START))
|
||||
(\TFBRAVO.INSERT.PARA PARA BSTREAM TEXTOBJ))
|
||||
@@ -223,13 +227,13 @@
|
||||
(* ;; "Named tab information is collected in the userinfo fields, but then ignored.")
|
||||
|
||||
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
do (SETPARA PARALOOKS FMTUSERINFO NIL))
|
||||
do (SETPLOOKS PARALOOKS FMTUSERINFO NIL))
|
||||
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
|
||||
do (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
|
||||
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ)
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TSTREAM)
|
||||
(TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
|
||||
(RETURN TEXTSTREAM)))])
|
||||
(RETURN TSTREAM)))])
|
||||
)
|
||||
|
||||
(ADDTOVAR TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO))
|
||||
@@ -286,22 +290,23 @@
|
||||
(RETURN USER.CM])
|
||||
|
||||
(\TFBRAVO.USER.CM.LOOKS
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 2-Jan-2025 11:06 by rmk")
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 8-Feb-2025 22:13 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 11:06 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 18:47 by rmk")
|
||||
(* ; "Edited 16-Aug-2023 21:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2023 17:15 by rmk")
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST))
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
|
||||
(SETQ USER.CM.CHARLOOKS (create CHARLOOKS
|
||||
CLOFFSET _ 0))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS (\TFBRAVO.GETFONT 0 BRFAMILY)
|
||||
(\TFBRAVO.GETFONT 0 BRSIZE))
|
||||
(\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ)
|
||||
(SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ))
|
||||
(SETQ USER.CM.FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.FMTSPEC TEXTOBJ))
|
||||
(SETQ USER.CM.PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.PARALOOKS TEXTOBJ))
|
||||
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS USER.CM.CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS USER.CM.PARALOOKS])
|
||||
|
||||
(\TFBRAVO.READ.USER.CM
|
||||
[LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk")
|
||||
@@ -382,7 +387,8 @@
|
||||
(GO LLP)))])
|
||||
|
||||
(\TFBRAVO.INIT.PARALOOKS
|
||||
[LAMBDA (ALIST) (* ; "Edited 4-Aug-2024 22:17 by rmk")
|
||||
[LAMBDA (ALIST) (* ; "Edited 8-Feb-2025 22:09 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 22:17 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:36 by rmk")
|
||||
(* ; "Edited 13-Aug-2023 11:27 by rmk")
|
||||
(* ; "Edited 8-Aug-2023 23:51 by rmk")
|
||||
@@ -391,12 +397,12 @@
|
||||
|
||||
(* ;; "creates the default paragraph looks from the USER.CM. The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points. ")
|
||||
|
||||
(LET ((INITFMTSPEC (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)))
|
||||
(LET ((INITPARALOOKS (create PARALOOKS using TEDIT.DEFAULT.FMTSPEC)))
|
||||
|
||||
(* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60. I'm going with 36.")
|
||||
|
||||
(with FMTSPEC INITFMTSPEC (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
|
||||
85))
|
||||
(with PARALOOKS INITPARALOOKS (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST))
|
||||
85))
|
||||
(SETQ 1STLEFTMAR (OR (CADR (ASSOC 'FirstLineLeftMargin ALIST))
|
||||
LEFTMAR))
|
||||
(SETQ RIGHTMAR (OR (CADR (ASSOC 'RightMargin ALIST))
|
||||
@@ -410,7 +416,7 @@
|
||||
DEFAULTTAB))
|
||||
(SETQ FMTSPECIALX 0)
|
||||
(SETQ FMTSPECIALY 0))
|
||||
INITFMTSPEC])
|
||||
INITPARALOOKS])
|
||||
|
||||
(\TFBRAVO.INIT.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:03 by rmk")
|
||||
@@ -497,7 +503,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.PARSE.PARA
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (OLDPARALOOKS BSTREAM TEXTOBJ) (* ; "Edited 8-Feb-2025 23:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 14-Nov-2023 13:03 by rmk")
|
||||
(* ; "Edited 7-Nov-2023 21:53 by rmk")
|
||||
(* ; "Edited 21-Aug-2023 23:41 by rmk")
|
||||
@@ -505,17 +512,17 @@
|
||||
(* ; "Edited 16-Aug-2023 21:28 by rmk")
|
||||
(* ; "Edited 13-Jun-2021 09:46 by rmk:")
|
||||
|
||||
(* ;; "OLDFMTSPEC are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run. Leaves the input file pointer at the end of the trailer, after the CR.")
|
||||
(* ;; "OLDPARALOOKS are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run. Leaves the input file pointer at the end of the trailer, after the CR.")
|
||||
|
||||
(* ;; "^Z marks the end of a Bravo-looks paragraph which may have internal CR's that mark the end of Tedit paragraphs. The Bravo runs with different charlooks want to end up in different pieces all within the same paragraph.")
|
||||
|
||||
(* ;;
|
||||
"The carriage return that ends the trailer is its own final run, the trailer itself is skipped.")
|
||||
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC))
|
||||
(LET (BYTE PLEN ^ZPTR ENDCHAR FMTSPEC RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
|
||||
BSTREAM))
|
||||
(FMTSPEC USER.CM.FMTSPEC))
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS))
|
||||
(LET (BYTE PLEN ^ZPTR ENDCHAR PARALOOKS RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR
|
||||
BSTREAM))
|
||||
(PARALOOKS USER.CM.PARALOOKS))
|
||||
|
||||
(* ;; "BYTE=NIL at EOF, no terminating ^Z")
|
||||
|
||||
@@ -544,17 +551,19 @@
|
||||
(NIL T)
|
||||
NIL))
|
||||
(SELCHARQ BYTE
|
||||
(^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS OLDFMTSPEC BSTREAM TEXTOBJ))
|
||||
(^Z (SETQ PARALOOKS (\TFBRAVO.READ.PARALOOKS OLDPARALOOKS BSTREAM TEXTOBJ))
|
||||
(SETQ RUNS (\TFBRAVO.CREATE.RUNS BSTREAM PSTART PLEN)))
|
||||
(NIL)
|
||||
(\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF"))
|
||||
(create PARA
|
||||
PARAFMTSPEC _ FMTSPEC
|
||||
PARAFMTSPEC _ PARALOOKS
|
||||
RUNS _ RUNS
|
||||
FORMATPTRS _ FORMATPTRS])
|
||||
|
||||
(\TFBRAVO.READ.PARALOOKS
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 19-Dec-2024 23:42 by rmk")
|
||||
[LAMBDA (OLDPARALOOKS BSTREAM) (* ; "Edited 19-Feb-2025 12:14 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:04 by rmk")
|
||||
(* ; "Edited 19-Dec-2024 23:42 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 21:59 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:39 by rmk")
|
||||
@@ -566,46 +575,48 @@
|
||||
(* ; "Edited 13-Aug-2023 19:58 by rmk")
|
||||
(* ; "Edited 3-Aug-2023 00:20 by rmk")
|
||||
(* ; "Edited 31-May-91 15:26 by jds")
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
(DECLARE (USEDFREE USER.CM.PARALOOKS))
|
||||
|
||||
(* ;;
|
||||
"Decodes bravo paragraph looks into a TEDIT FMTSPEC. OLDFMTSPEC is used just for its tabs.")
|
||||
"Decodes bravo paragraph looks into a TEDIT PARALOOKS. OLDPARALOOKS is used just for its tabs.")
|
||||
|
||||
(\DTEST OLDFMTSPEC 'FMTSPEC)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC
|
||||
(PARALOOKS! OLDPARALOOKS)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPLOOKS USER.CM.PARALOOKS
|
||||
FMTDEFAULTTAB))
|
||||
(NEWFMTSPEC _ (create FMTSPEC using USER.CM.FMTSPEC))
|
||||
first (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC FMTPARATYPE))
|
||||
(NEWPARALOOKS _ (create PARALOOKS using USER.CM.PARALOOKS))
|
||||
first (CL:UNLESS (EQ 'PROFILE (FGETPLOOKS OLDPARALOOKS FMTPARATYPE))
|
||||
|
||||
(* ;; "It appears that heading-tabs don't carry over to other paragraphs. Although maybe the default interval-tab does?")
|
||||
|
||||
(SETQ TABDEFAULT (OR (FGETPARA OLDFMTSPEC FMTDEFAULTTAB)
|
||||
(FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
|
||||
(SETQ TABDEFAULT (OR (FGETPLOOKS OLDPARALOOKS FMTDEFAULTTAB)
|
||||
(FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
|
||||
|
||||
(* ;; "We don't put the NAMEDTABS in the TABSPEC since we don't know which ones will be activated by any particular run. ")
|
||||
|
||||
(SETQ NAMEDTABS (COPY (FGETPARA OLDFMTSPEC FMTUSERINFO))))
|
||||
(SETQ NAMEDTABS (COPY (FGETPLOOKS OLDPARALOOKS FMTUSERINFO))))
|
||||
do (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(l (SETQ LMFLAG T)
|
||||
(FSETPARA NEWFMTSPEC LEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)))
|
||||
(FSETPLOOKS NEWPARALOOKS LEFTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(d (SETQ 1LMFLAG T)
|
||||
(FSETPARA NEWFMTSPEC 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)
|
||||
))
|
||||
(z (FSETPARA NEWFMTSPEC RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)))
|
||||
(x (FSETPARA NEWFMTSPEC LINELEAD (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(e (FSETPARA NEWFMTSPEC LEADAFTER 0)
|
||||
(FSETPARA NEWFMTSPEC LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(z (FSETPLOOKS NEWPARALOOKS RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(x (FSETPLOOKS NEWPARALOOKS LINELEAD (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(e (FSETPLOOKS NEWPARALOOKS LEADAFTER 0)
|
||||
(FSETPLOOKS NEWPARALOOKS LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(y (* ; "vertical tabs are supported")
|
||||
(FSETPARA NEWFMTSPEC FMTSPECIALX 0)
|
||||
(FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTSPECIALX 0)
|
||||
(FSETPLOOKS NEWPARALOOKS FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (FSETPLOOKS NEWPARALOOKS FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(w 'HardcopyMode)
|
||||
(j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED))
|
||||
(c (FSETPARA NEWFMTSPEC QUAD 'CENTERED))
|
||||
(j (FSETPLOOKS NEWPARALOOKS QUAD 'JUSTIFIED))
|
||||
(c (FSETPLOOKS NEWPARALOOKS QUAD 'CENTERED))
|
||||
(q
|
||||
(* ;; "Profiles are marked here but then interpreted at the top")
|
||||
|
||||
(FSETPARA NEWFMTSPEC FMTPARATYPE 'PROFILE))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTPARATYPE 'PROFILE))
|
||||
(%( (* ; "Collect the named tabs")
|
||||
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position")
|
||||
|
||||
@@ -636,13 +647,13 @@
|
||||
((CR \)
|
||||
(CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;
|
||||
"If there was a Left margin but no firstline left then default it")
|
||||
(FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR)))
|
||||
(FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT)
|
||||
(FSETPARA NEWFMTSPEC FMTUSERINFO (DREVERSE NAMEDTABS))
|
||||
(FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (FGETPLOOKS NEWPARALOOKS LEFTMAR)))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB TABDEFAULT)
|
||||
(FSETPLOOKS NEWPARALOOKS FMTUSERINFO (DREVERSE NAMEDTABS))
|
||||
(CL:WHEN (EQ COMMAND (CHARCODE CR)) (* ;
|
||||
"Read the \ separator, but leave the terminating CR")
|
||||
(\BACKFILEPTR BSTREAM))
|
||||
(RETURN NEWFMTSPEC))
|
||||
(RETURN NEWPARALOOKS))
|
||||
(\TEDIT.THELP (CHARACTER COMMAND)
|
||||
'" is not a legal Bravo paragraph-format character"])
|
||||
|
||||
@@ -797,7 +808,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.HANDLE.HEADING
|
||||
[LAMBDA (BSTREAM TEXTOBJ HEADINGSTART) (* ; "Edited 20-Aug-2023 20:11 by rmk")
|
||||
[LAMBDA (BSTREAM TEXTOBJ HEADINGSTART) (* ; "Edited 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:05 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 20:11 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 10:37 by rmk")
|
||||
(* ; "Edited 12-Aug-2023 12:25 by rmk")
|
||||
(* ; "Edited 9-Aug-2023 23:37 by rmk")
|
||||
@@ -807,31 +820,33 @@
|
||||
|
||||
(* ;; "Called from \TFBRAVO.PARSE.PROFILE.PARA. The heading is a paragraph beginning at the current position, presumably just a line with a looks trailer. Its paralooks have to be marked with special heading properties--heading type and special X and Y locations.")
|
||||
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
(LET (HEADINGDESC HEADINGPARA HEADINGFMTSPEC) (* ;
|
||||
(DECLARE (USEDFREE USER.CM.PARALOOKS))
|
||||
(LET (HEADINGDESC HEADINGPARA HEADINGPARALOOKS) (* ;
|
||||
"skip over the trailer of the profile para")
|
||||
(SETFILEPTR BSTREAM HEADINGSTART)
|
||||
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.FMTSPEC BSTREAM TEXTOBJ))
|
||||
(SETQ HEADINGFMTSPEC (fetch (PARA PARAFMTSPEC) of HEADINGPARA))
|
||||
(replace (FMTSPEC FMTPARATYPE) of HEADINGFMTSPEC with 'PAGEHEADING)
|
||||
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.PARALOOKS BSTREAM TEXTOBJ))
|
||||
(SETQ HEADINGPARALOOKS (fetch (PARA PARAFMTSPEC) of HEADINGPARA))
|
||||
(SETPLOOKS HEADINGPARALOOKS FMTPARATYPE 'PAGEHEADING)
|
||||
|
||||
(* ;; "This is where the vertical tab info is placed for the heading, remove the special x and y and use them as the position for the descriptor")
|
||||
|
||||
(SETQ HEADINGDESC (LIST (GENSYM 'PageHeading)
|
||||
(OR (fetch (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC)
|
||||
(OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALX)
|
||||
0)
|
||||
(OR (fetch (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC)
|
||||
(OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALY)
|
||||
0)))
|
||||
(replace (FMTSPEC FMTPARASUBTYPE) of HEADINGFMTSPEC with (CAR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC with (CADR HEADINGDESC))
|
||||
(replace (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC with (CADDR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTPARASUBTYPE (CAR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTSPECIALX (CADR HEADINGDESC))
|
||||
(FSETPLOOKS HEADINGPARALOOKS FMTSPECIALY (CADDR HEADINGDESC))
|
||||
(* ;
|
||||
"now write out the heading paragraph")
|
||||
(\TFBRAVO.INSERT.PARA HEADINGPARA BSTREAM TEXTOBJ MAX.FIXP)
|
||||
HEADINGDESC])
|
||||
|
||||
(\TFBRAVO.PARSE.PROFILE.PARA
|
||||
[LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START) (* ; "Edited 22-Sep-2023 20:02 by rmk")
|
||||
[LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START) (* ; "Edited 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:27 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 20:02 by rmk")
|
||||
(* ; "Edited 19-Aug-2023 23:33 by rmk")
|
||||
(* ; "Edited 17-Aug-2023 14:51 by rmk")
|
||||
(* ; "Edited 10-Aug-2023 10:37 by rmk")
|
||||
@@ -929,8 +944,8 @@
|
||||
(PROGN (* ;
|
||||
"Not a profile line, presumably a mistaken q.")
|
||||
(SETFILEPTR BSTREAM END)
|
||||
(replace (FMTSPEC FMTPARATYPE) of (fetch (PARA PARAFMTSPEC) of PARAGRAPH)
|
||||
with NIL)
|
||||
(FSETPLOOKS (fetch (PARA PARAFMTSPEC) of PARAGRAPH)
|
||||
FMTPARATYPE NIL)
|
||||
(RETURN NIL] repeatuntil [EQ (CAR LINE)
|
||||
(CONSTANT (CHARACTER (CHARCODE ^Z]
|
||||
finally (CL:WHEN ROMAN
|
||||
@@ -951,17 +966,20 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.INSERT.PARA
|
||||
[LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "Edited 20-Aug-2023 16:13 by rmk")
|
||||
[LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "Edited 8-Feb-2025 23:06 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 16:13 by rmk")
|
||||
|
||||
(* ;; "Inserts pieces into TEXTOBJ that correspond to the runs in PARA. PARA may be broken up at internal CR's to get spacing and tabs right.")
|
||||
|
||||
(for P PFMTSPEC in (\TFBRAVO.SPLIT.PARA PARA)
|
||||
do (SETQ PFMTSPEC (fetch (PARA PARAFMTSPEC) of P))
|
||||
(for RUN in (fetch (PARA RUNS) of P) do (SETQ PFMTSPEC (\TFBRAVO.RUN.TABSPEC RUN PFMTSPEC))
|
||||
(\TFBRAVO.INSERT.RUN RUN BSTREAM PFMTSPEC TEXTOBJ])
|
||||
(for P PARALOOKS in (\TFBRAVO.SPLIT.PARA PARA)
|
||||
do (SETQ PARALOOKS (fetch (PARA PARAFMTSPEC) of P))
|
||||
(for RUN in (fetch (PARA RUNS) of P) do (SETQ PARALOOKS (\TFBRAVO.RUN.TABSPEC RUN PARALOOKS
|
||||
))
|
||||
(\TFBRAVO.INSERT.RUN RUN BSTREAM PARALOOKS TEXTOBJ])
|
||||
|
||||
(\TFBRAVO.INSERT.RUN
|
||||
[LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ) (* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 8-Feb-2025 23:08 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Jan-2024 18:28 by rmk")
|
||||
(* ; "Edited 29-Dec-2023 11:50 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 12:11 by rmk")
|
||||
@@ -971,7 +989,7 @@
|
||||
|
||||
(* ;; "A Bravo run can include many CR's each of which should end a separate TEDIT paragraph. Unless we want to think of those as paragraph internal meta-CRs ?")
|
||||
|
||||
(* ;; "PARAFMTSPEC is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs. It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC")
|
||||
(* ;; "PARALOOKS is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs. It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC")
|
||||
|
||||
(CL:WHEN (IGREATERP (fetch (RUN RUNLENGTH) of RUN)
|
||||
0) (* ; "No need for an empty piece")
|
||||
@@ -982,7 +1000,7 @@
|
||||
PLEN _ NCHARS
|
||||
PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN)
|
||||
TEXTOBJ)
|
||||
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)
|
||||
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)
|
||||
PPARALAST _ (fetch (RUN RUNLAST) of RUN)))
|
||||
(if (STRINGP RUNSTART)
|
||||
then
|
||||
@@ -1010,10 +1028,12 @@
|
||||
PC))])
|
||||
|
||||
(\TFBRAVO.SPLIT.PARA
|
||||
[LAMBDA (PARA) (* ; "Edited 9-Sep-2023 21:35 by rmk")
|
||||
[LAMBDA (PARA) (* ; "Edited 19-Feb-2025 12:15 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:12 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:35 by rmk")
|
||||
(* ; "Edited 22-Aug-2023 23:45 by rmk")
|
||||
|
||||
(* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs. All of them share the same basic FMTSPEC, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.")
|
||||
(* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs. All of them share the same basic PARALOOKS, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.")
|
||||
|
||||
(* ;; "However, we leave alone a paragraph with a special location, since we don't know how to arrange the positions of the later sub-paragraphs.")
|
||||
|
||||
@@ -1021,7 +1041,7 @@
|
||||
|
||||
(* ;; "This smashes PARA's runs.")
|
||||
|
||||
(LET ((PARAFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(LET ((PARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
NEWPARAS)
|
||||
|
||||
(* ;;
|
||||
@@ -1029,9 +1049,9 @@
|
||||
|
||||
(SETQ NEWPARAS
|
||||
(if [AND (fetch (PARA FORMATPTRS) of PARA)
|
||||
(FMEMB (fetch (FMTSPEC FMTSPECIALX) of PARAFMTSPEC)
|
||||
(FMEMB (GETPLOOKS PARALOOKS FMTSPECIALX)
|
||||
'(0 NIL))
|
||||
(FMEMB (fetch (FMTSPEC FMTSPECIALY) of PARAFMTSPEC)
|
||||
(FMEMB (GETPLOOKS PARALOOKS FMTSPECIALY)
|
||||
'(0 NIL]
|
||||
then [for PTR POS RUN FIRSTRUN NEWRUNLENGTH (RUNS _ (fetch (PARA RUNS) of PARA))
|
||||
in (fetch (PARA FORMATPTRS) of PARA) eachtime (SETQ POS (CDR PTR))
|
||||
@@ -1062,7 +1082,7 @@
|
||||
NEWRUNLENGTH)))
|
||||
(replace (RUN RUNLENGTH) of RUN with NEWRUNLENGTH))
|
||||
|
||||
(* ;; "Fill in RUNS here, FMTSPEC below. No more FORMATPTRS")
|
||||
(* ;; "Fill in RUNS here, PARALOOKS below. No more FORMATPTRS")
|
||||
|
||||
(create PARA
|
||||
RUNS _ FIRSTRUN)
|
||||
@@ -1072,19 +1092,18 @@
|
||||
(* ;; "The first paragraph has LEADAFTER=0, all the others have 1STLEFTMAR=LEFTMAR and LEADAFTER=LEADBEFORE=0, except that the last one keeps the original LEADAFTER. Tabs are retained across all the runs.")
|
||||
|
||||
(replace (PARA PARAFMTSPEC) of (CAR $$VAL)
|
||||
with (create FMTSPEC using PARAFMTSPEC LEADAFTER _ 0))
|
||||
(for PTAIL (NEWFMTSPEC _ (create FMTSPEC
|
||||
using PARAFMTSPEC 1STLEFTMAR _
|
||||
(fetch (FMTSPEC LEFTMAR) of PARAFMTSPEC
|
||||
)
|
||||
LEADBEFORE _ 0 LEADAFTER _ 0))
|
||||
with (create PARALOOKS using PARALOOKS LEADAFTER _ 0))
|
||||
(for PTAIL (NEWPARALOOKS _ (create PARALOOKS
|
||||
using PARALOOKS 1STLEFTMAR _
|
||||
(GETPLOOKS PARALOOKS LEFTMAR)
|
||||
LEADBEFORE _ 0 LEADAFTER _ 0))
|
||||
on (CDR $$VAL)
|
||||
do (replace (PARA PARAFMTSPEC) of (CAR PTAIL)
|
||||
with (CL:IF (CDR PTAIL)
|
||||
NEWFMTSPEC
|
||||
(create FMTSPEC using NEWFMTSPEC LEADAFTER _
|
||||
(fetch (FMTSPEC LEADAFTER)
|
||||
of PARAFMTSPEC)))]
|
||||
NEWPARALOOKS
|
||||
(create PARALOOKS using NEWPARALOOKS LEADAFTER _
|
||||
(GETPLOOKS PARALOOKS LEADAFTER)
|
||||
))]
|
||||
else (CONS PARA)))
|
||||
|
||||
(* ;; "If t0 is the first tab specfied for a run, tx is the last tab of the previous run, and t(x+1) is defined, then change t0 to t(x+1).")
|
||||
@@ -1109,31 +1128,33 @@
|
||||
NEWPARAS])
|
||||
|
||||
(\TFBRAVO.RUN.TABSPEC
|
||||
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 27-Aug-2024 22:02 by rmk")
|
||||
[LAMBDA (RUN PARALOOKS) (* ; "Edited 19-Feb-2025 12:16 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:15 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 22:02 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:30 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:42 by rmk")
|
||||
(* ; "Edited 22-Aug-2023 16:54 by rmk")
|
||||
(* ; "Edited 19-Aug-2023 15:47 by rmk")
|
||||
|
||||
(* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARAFMTSPEC. This returns a FMTSPEC for this run that only includes the named tabs that this run calls for.")
|
||||
(* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARALOOKS. This returns a PARALOOKS for this run that only includes the named tabs that this run calls for.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "For the first run, the PARAFMTSPEC is the unspecialized run for the paragraph, with empty TABSPEC. Each subsequent run is given the FMTSPEC for the last run, so the tabs that were selected there are known. This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think). (Or perhaps as setting the next tabs TABX as the interval?)")
|
||||
(* ;; "For the first run, the PARALOOKS is the unspecialized run for the paragraph, with empty TABSPEC. Each subsequent run is given the PARALOOKS for the last run, so the tabs that were selected there are known. This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think). (Or perhaps as setting the next tabs TABX as the interval?)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs. ")
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1. t0 doesn't match.")
|
||||
|
||||
(DECLARE (USEDFREE USER.CM.FMTSPEC))
|
||||
(LET ([LASTTAB (CAR (LAST (FGETPARA PARAFMTSPEC FMTTABS]
|
||||
(TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
|
||||
(TABDEFAULT (OR (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)
|
||||
(FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
|
||||
(DECLARE (USEDFREE USER.CM.PARALOOKS))
|
||||
(LET ([LASTTAB (CAR (LAST (GETPLOOKS PARALOOKS FMTTABS]
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (OR (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)
|
||||
(FGETPLOOKS USER.CM.PARALOOKS FMTDEFAULTTAB)))
|
||||
(RUNTABS (fetch (RUN RUNTABS) of RUN))
|
||||
TAB TABS)
|
||||
(CL:WHEN (AND TABDEFS (NULL RUNTABS))
|
||||
@@ -1164,9 +1185,9 @@
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
TABS)))
|
||||
PARAFMTSPEC])
|
||||
PARALOOKS])
|
||||
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:04 by rmk")
|
||||
@@ -1360,7 +1381,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ADD.NAMEDTAB
|
||||
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 4-Aug-2024 18:05 by rmk")
|
||||
[LAMBDA (RUN PARALOOKS TEXTOBJ) (* ; "Edited 19-Feb-2025 12:17 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:19 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 18:05 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 21:29 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:44 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 18:42 by rmk")
|
||||
@@ -1371,7 +1394,7 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs. ")
|
||||
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -1379,8 +1402,8 @@
|
||||
|
||||
(NOTUSED)
|
||||
(LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN))
|
||||
(TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB))
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))
|
||||
(TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN))
|
||||
TAB TABNAMES TABS)
|
||||
(SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS))
|
||||
@@ -1403,11 +1426,11 @@
|
||||
"No name and 0, make it be the default. How else would we decide where the second tab goes?")
|
||||
|
||||
(SETQ TABDEFAULT (fetch (TAB TABX) of (CDAR TABDEFS]
|
||||
(CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)))
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT
|
||||
FMTTABS _ TABS))
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)))
|
||||
PARAFMTSPEC])
|
||||
(CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)))
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS
|
||||
_ TABS))
|
||||
(\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)))
|
||||
PARALOOKS])
|
||||
|
||||
(\TFBRAVO.COPY.NAMEDTAB
|
||||
[LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58")
|
||||
@@ -1480,18 +1503,18 @@
|
||||
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6772 13224 (TEDIT.BRAVOFILE? 6782 . 8512) (TEDITFROMBRAVO 8514 . 13222)) (13335 28811 (
|
||||
\TFBRAVO.GET.USER.CM 13345 . 16155) (\TFBRAVO.USER.CM.LOOKS 16157 . 17364) (\TFBRAVO.READ.USER.CM
|
||||
17366 . 21936) (\TFBRAVO.INIT.PARALOOKS 21938 . 23924) (\TFBRAVO.INIT.PAGEFORMAT 23926 . 24806) (
|
||||
\TFBRAVO.GETPARAMS 24808 . 27662) (\TFBRAVO.FIND.LAST.TRAILER 27664 . 28809)) (28853 48956 (
|
||||
\TFBRAVO.PARSE.PARA 28863 . 32663) (\TFBRAVO.READ.PARALOOKS 32665 . 39087) (\TFBRAVO.CREATE.RUNS 39089
|
||||
. 40477) (\TFBRAVO.READ.CHARLOOKS 40479 . 45508) (\TFBRAVO.FONT.FROM.CHARLOOKS 45510 . 47057) (
|
||||
\TFBRAVO.READNUM? 47059 . 48954)) (48993 59744 (\TFBRAVO.HANDLE.HEADING 49003 . 51635) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 51637 . 59742)) (59787 81236 (\TFBRAVO.INSERT.PARA 59797 . 60450) (
|
||||
\TFBRAVO.INSERT.RUN 60452 . 63649) (\TFBRAVO.SPLIT.PARA 63651 . 70893) (\TFBRAVO.RUN.TABSPEC 70895 .
|
||||
75541) (\TFBRAVO.INSTALL.PAGEFORMAT 75543 . 81234)) (81237 85380 (\TFBRAVO.ASSERT 81247 . 81777) (
|
||||
\TEST.CHARACTER.LOOKS 81779 . 83665) (\TEST.PARAGRAPH.LOOKS 83667 . 85378)) (85865 92308 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 85875 . 89266) (\TFBRAVO.COPY.NAMEDTAB 89268 . 89716) (\TFBRAVO.PUT.NAMEDTAB
|
||||
89718 . 89998) (\TFBRAVO.GET.NAMEDTAB 90000 . 90377) (\NAMEDTABNYET 90379 . 90539) (\NAMEDTABSIZE
|
||||
90541 . 91056) (\NAMEDTABPREPRINT 91058 . 91256) (\TEDIT.NAMEDTAB.INIT 91258 . 92306)))))
|
||||
(FILEMAP (NIL (6570 13446 (TEDIT.BRAVOFILE? 6580 . 8310) (TEDITFROMBRAVO 8312 . 13444)) (13557 29284 (
|
||||
\TFBRAVO.GET.USER.CM 13567 . 16377) (\TFBRAVO.USER.CM.LOOKS 16379 . 17714) (\TFBRAVO.READ.USER.CM
|
||||
17716 . 22286) (\TFBRAVO.INIT.PARALOOKS 22288 . 24397) (\TFBRAVO.INIT.PAGEFORMAT 24399 . 25279) (
|
||||
\TFBRAVO.GETPARAMS 25281 . 28135) (\TFBRAVO.FIND.LAST.TRAILER 28137 . 29282)) (29326 50024 (
|
||||
\TFBRAVO.PARSE.PARA 29336 . 33263) (\TFBRAVO.READ.PARALOOKS 33265 . 40155) (\TFBRAVO.CREATE.RUNS 40157
|
||||
. 41545) (\TFBRAVO.READ.CHARLOOKS 41547 . 46576) (\TFBRAVO.FONT.FROM.CHARLOOKS 46578 . 48125) (
|
||||
\TFBRAVO.READNUM? 48127 . 50022)) (50061 61102 (\TFBRAVO.HANDLE.HEADING 50071 . 52798) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 52800 . 61100)) (61145 83181 (\TFBRAVO.INSERT.PARA 61155 . 61996) (
|
||||
\TFBRAVO.INSERT.RUN 61998 . 65300) (\TFBRAVO.SPLIT.PARA 65302 . 72617) (\TFBRAVO.RUN.TABSPEC 72619 .
|
||||
77486) (\TFBRAVO.INSTALL.PAGEFORMAT 77488 . 83179)) (83182 87325 (\TFBRAVO.ASSERT 83192 . 83722) (
|
||||
\TEST.CHARACTER.LOOKS 83724 . 85610) (\TEST.PARAGRAPH.LOOKS 85612 . 87323)) (87810 94465 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 87820 . 91423) (\TFBRAVO.COPY.NAMEDTAB 91425 . 91873) (\TFBRAVO.PUT.NAMEDTAB
|
||||
91875 . 92155) (\TFBRAVO.GET.NAMEDTAB 92157 . 92534) (\NAMEDTABNYET 92536 . 92696) (\NAMEDTABSIZE
|
||||
92698 . 93213) (\NAMEDTABPREPRINT 93215 . 93413) (\TEDIT.NAMEDTAB.INIT 93415 . 94463)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2025 10:36:25" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;748 231614
|
||||
(FILECREATED "31-Mar-2025 22:43:28" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;790 237200
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.SHIFTLINES \TEDIT.SCROLLUP \TEDIT.SCROLLDOWN)
|
||||
:CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION)
|
||||
|
||||
:PREVIOUS-DATE " 7-Jan-2025 23:47:15" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;747)
|
||||
:PREVIOUS-DATE "31-Mar-2025 12:04:14" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;789)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
||||
@@ -25,8 +25,8 @@
|
||||
(INITRECORDS TEDITCARET PANEPROPS)
|
||||
(FILES ATTACHEDWINDOW)
|
||||
(FNS TEDIT.DEFER.UPDATES)
|
||||
(FNS \TEDIT.CREATEW \TEDIT.WINDOW.SETUP \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE
|
||||
\TEDIT.FILL.PANES)
|
||||
(FNS \TEDIT.WINDOW.CREATE \TEDIT.WINDOW.GETREGION \TEDIT.WINDOW.SETUP
|
||||
\TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE \TEDIT.FILL.PANES)
|
||||
(FNS \TEDIT.CURSORMOVEDFN \TEDIT.CURSOROUTFN \TEDIT.ACTIVE.WINDOWP \TEDIT.EXPANDFN
|
||||
\TEDIT.MAINW \TEDIT.MAINSTREAM \TEDIT.PRIMARYPANE \TEDIT.PANELIST \TEDIT.NEWREGIONFN
|
||||
\TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN \TEDIT.PANEREGION)
|
||||
@@ -58,7 +58,7 @@
|
||||
(TEDIT.PROMPTWINDOW.HEIGHT NIL))
|
||||
(GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT))
|
||||
(COMS (* ; "Title creation and update")
|
||||
(FNS \TEXTSTREAM.TITLE \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEXTSTREAM.FILENAME
|
||||
(FNS \TEDIT.FILENAME \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEDIT.LIKELY.FILENAME
|
||||
\TEDIT.UPDATE.TITLE))
|
||||
(COMS (* ; "Screen updating utilities")
|
||||
(FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.RESHAPEFN \TEDIT.REPAINTFN)
|
||||
@@ -85,7 +85,9 @@
|
||||
|
||||
Unformatted% Get
|
||||
))
|
||||
Include Find Looks Substitute
|
||||
Include Find Looks Substitute
|
||||
(Buttons 'Buttons
|
||||
"Display action buttons")
|
||||
Quit
|
||||
(Expanded% Menu 'Expanded% Menu
|
||||
NIL
|
||||
@@ -354,8 +356,9 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.CREATEW
|
||||
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 1-Jul-2024 22:55 by rmk")
|
||||
(\TEDIT.WINDOW.CREATE
|
||||
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 18-Feb-2025 09:49 by rmk")
|
||||
(* ; "Edited 1-Jul-2024 22:55 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 23:16 by rmk")
|
||||
(* ; "Edited 5-May-2024 21:54 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 09:57 by rmk")
|
||||
@@ -413,18 +416,12 @@
|
||||
(SETQ REGION (if (REGIONP WINDOW)
|
||||
then (PROG1 (COPY WINDOW)
|
||||
(SETQ WINDOW NIL))
|
||||
else (GRAB-TYPED-REGION REGIONTYPE)))
|
||||
(CL:UNLESS REGION
|
||||
(CLRPROMPT) (* ; "System promptwindow")
|
||||
(printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
|
||||
" window region")
|
||||
(CL:WHEN FILE
|
||||
(printout PROMPTWINDOW " for " T " " (FULLNAME FILE)))
|
||||
(TERPRI PROMPTWINDOW)
|
||||
(SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32)
|
||||
REGIONTYPE)) (* ;
|
||||
elseif (GRAB-TYPED-REGION REGIONTYPE)
|
||||
else (SETQ REGION (\TEDIT.WINDOW.GETREGION TSTREAM REGIONTYPE PHEIGHT))
|
||||
(* ;
|
||||
"We don't want the default to keep shrinking")
|
||||
(SETQ PREPROMPT (create REGION using REGION)))
|
||||
(SETQ PREPROMPT (create REGION using REGION))
|
||||
REGION))
|
||||
(add (fetch (REGION HEIGHT) of REGION)
|
||||
(IMINUS PHEIGHT))
|
||||
(SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS))
|
||||
@@ -432,6 +429,11 @@
|
||||
(* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.")
|
||||
|
||||
(REGISTER-TYPED-REGION REGION REGIONTYPE WINDOW))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "We now have the main window")
|
||||
|
||||
(WINDOWPROP WINDOW 'TEDITCREATED (OR PREPROMPT T))
|
||||
(CL:UNLESS [OR PWINDOW (EQ PROMPTPROP 'DON'T)
|
||||
(SETQ PWINDOW (WINDOWP (CAR (WINDOWPROP WINDOW 'PROMPTWINDOW]
|
||||
@@ -454,6 +456,53 @@
|
||||
(WINDOWPROP WINDOW 'TITLE TITLE)
|
||||
WINDOW])
|
||||
|
||||
(\TEDIT.WINDOW.GETREGION
|
||||
[LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 31-Mar-2025 22:43 by rmk")
|
||||
(* ; "Edited 24-Mar-2025 11:29 by rmk")
|
||||
(* ; "Edited 18-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 19-Feb-2025 16:48 by rmk")
|
||||
(* ; "Edited 18-Feb-2025 10:09 by rmk")
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
WIDTH HEIGHT)
|
||||
(CLRPROMPT) (* ; "System promptwindow")
|
||||
(printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
|
||||
" window region")
|
||||
(CL:WHEN (TXTFILE TSTREAM)
|
||||
(printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
|
||||
(TERPRI PROMPTWINDOW)
|
||||
(if (IGREATERP (TEXTLEN TEXTOBJ)
|
||||
0)
|
||||
then
|
||||
(* ;; "Explict user properties cover everything, otherwise allow for extra stuff")
|
||||
|
||||
[SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
|
||||
(for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
largest (GETPLOOKS PARALOOKS RIGHTMAR)
|
||||
finally (CL:UNLESS (AND $$EXTREME (IGREATERP $$EXTREME 0))
|
||||
(SETQ $$EXTREME (TIMES 6 PTSPERINCH)))
|
||||
(* ; "36 for right margin selection")
|
||||
(RETURN (IPLUS $$EXTREME \TEDIT.LINEREGION.WIDTH 36
|
||||
(ADD1 (TIMES 2 WBorder)
|
||||
1)
|
||||
(CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
||||
0
|
||||
\TEDIT.OP.WIDTH)]
|
||||
[SETQ HEIGHT (if (GETTEXTPROP TEXTOBJ 'OPENHEIGHT)
|
||||
elseif (ZEROP (TEXTLEN TEXTOBJ))
|
||||
then 50
|
||||
else (for I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
|
||||
(CHNO _ 1) from 1 to 20 while (ILEQ CHNO TEXTLEN)
|
||||
sum (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO))
|
||||
(SETQ CHNO (FGETLD L LCHARLIM))
|
||||
(FGETLD L LHEIGHT)
|
||||
finally (RETURN (IPLUS $$VAL PHEIGHT (ADD1 (TIMES 2 WBorder)
|
||||
)
|
||||
(FONTPROP WindowTitleDisplayStream
|
||||
'HEIGHT]
|
||||
(GETBOXREGION WIDTH HEIGHT)
|
||||
else (GETREGION (IMAX 200 (ADD1 (TIMES 2 WBorder)))
|
||||
(IMAX 100 (ADD1 (TIMES 2 WBorder])
|
||||
|
||||
(\TEDIT.WINDOW.SETUP
|
||||
[LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 25-Nov-2024 20:10 by rmk")
|
||||
(* ; "Edited 21-Nov-2024 21:12 by rmk")
|
||||
@@ -961,48 +1010,51 @@
|
||||
LEFT _ 0)))))])
|
||||
|
||||
(\TEDIT.SHRINK.ICONCREATE
|
||||
[LAMBDA (W ICON ICON-POSITION) (* ; "Edited 15-Mar-2024 18:28 by rmk")
|
||||
[LAMBDA (W ICON ICON-POSITION) (* ; "Edited 14-Mar-2025 12:35 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 18:28 by rmk")
|
||||
(* ; "Edited 20-Dec-2023 23:44 by rmk")
|
||||
(* ; "Edited 10-Apr-2023 09:44 by rmk")
|
||||
(* ; "Edited 25-Apr-88 23:53 by jds")
|
||||
|
||||
(* ;; "Create the icon that represents this window.")
|
||||
|
||||
[PROG [(ICON (WINDOWPROP W 'ICON))
|
||||
(ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
|
||||
(SHRINKFN (WINDOWPROP W 'SHRINKFN]
|
||||
(COND
|
||||
((NOT (fetch (TEXTWINDOW WTEXTOBJ) of W)) (* ;
|
||||
"This isn't really a TEdit window any more. Don't do anything")
|
||||
NIL)
|
||||
((TEDITMENUP W) (* ;
|
||||
[LET ((ICON (WINDOWPROP W 'ICON))
|
||||
(ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
|
||||
(SHRINKFN (WINDOWPROP W 'SHRINKFN))
|
||||
(TSTREAM (TEXTSTREAM W T)))
|
||||
(CL:WHEN TSTREAM
|
||||
[if (GETTOBJ (GETTSTR TSTREAM TEXTOBJ)
|
||||
MENUFLG)
|
||||
then (* ;
|
||||
"This is a text menu, and shrinks without trace.")
|
||||
NIL)
|
||||
((OR (IGREATERP (FLENGTH SHRINKFN)
|
||||
3)
|
||||
(AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
|
||||
(IGREATERP (FLENGTH SHRINKFN)
|
||||
2))) (* ;
|
||||
NIL
|
||||
elseif (OR (IGREATERP (FLENGTH SHRINKFN)
|
||||
3)
|
||||
(AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
|
||||
(IGREATERP (FLENGTH SHRINKFN)
|
||||
2)))
|
||||
then (* ;
|
||||
"There are other functions that expect to handle this. Don't bother.")
|
||||
NIL)
|
||||
((OR [AND ICONTITLE (EQUAL ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W]
|
||||
(AND (NOT ICONTITLE)
|
||||
ICON))
|
||||
|
||||
(* ;;
|
||||
NIL
|
||||
else (OR (AND ICONTITLE (STRING.EQUAL ICONTITLE (\TEDIT.FILENAME TSTREAM)))
|
||||
(AND (NOT ICONTITLE)
|
||||
ICON))
|
||||
then
|
||||
(* ;;
|
||||
"we built this and the title is the same, or he has already put an icon on this. Do nothing")
|
||||
|
||||
NIL)
|
||||
(ICON
|
||||
(* ;; "There's an existing icon window; change the title in it")
|
||||
NIL
|
||||
else (SETQ ICONTITLE (\TEDIT.FILENAME TSTREAM))
|
||||
(WINDOWPROP W 'TEDIT.ICON.TITLE ICONTITLE)
|
||||
(if ICON
|
||||
then
|
||||
(* ;; "There's an existing icon window; change the title in it")
|
||||
|
||||
[WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM
|
||||
W]
|
||||
(ICONTITLE ICONTITLE NIL NIL ICON))
|
||||
(T (* ; "install a new icon")
|
||||
[WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W]
|
||||
(WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT
|
||||
ICON-POSITION T NIL 'FILE]
|
||||
(ICONTITLE ICONTITLE NIL NIL ICON)
|
||||
else (* ; "install a new icon")
|
||||
(WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE
|
||||
TEDIT.ICON.FONT ICON-POSITION T NIL
|
||||
'FILE])]
|
||||
(WINDOWPROP W 'ICON])
|
||||
|
||||
(\TEDIT.SHRINKFN
|
||||
@@ -1060,7 +1112,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.BUTTONEVENTFN
|
||||
[LAMBDA (PANE) (* ; "Edited 6-Dec-2024 11:33 by rmk")
|
||||
[LAMBDA (PANE) (* ; "Edited 13-Feb-2025 11:53 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 11:33 by rmk")
|
||||
(* ; "Edited 1-Dec-2024 12:03 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 20:21 by rmk")
|
||||
(* ; "Edited 3-Nov-2024 07:19 by rmk")
|
||||
@@ -1106,9 +1159,7 @@
|
||||
TEXTOBJ)
|
||||
(\TEDIT.BUTTONEVENTFN.INACTIVE TEXTOBJ
|
||||
PANE)
|
||||
(\TEDIT.PANE.SPLIT TEXTOBJ PANE)
|
||||
(NOT (\TEDIT.XYTOSEL.INLINEP X Y PANE
|
||||
TEXTOBJ)))
|
||||
(\TEDIT.PANE.SPLIT TEXTOBJ PANE))
|
||||
(RETURN))
|
||||
|
||||
(* ;; "")
|
||||
@@ -1135,6 +1186,7 @@
|
||||
(SETQ NEWSEL (\TEDIT.COPYSEL CURSEL))
|
||||
(* ;
|
||||
"Gets line-chains and consistent initial looks")
|
||||
(FSETTOBJ TEXTOBJ LASTARROWX NIL)
|
||||
eachtime (BLOCK) (* ; "Give other processes a chance")
|
||||
(GETMOUSESTATE) (* ;
|
||||
"And get the new mouse and key info")
|
||||
@@ -1517,7 +1569,8 @@
|
||||
then (TEDIT.INSERT TSTREAM I])
|
||||
|
||||
(\TEDIT.FOREIGN.COPY
|
||||
[LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP) (* ; "Edited 27-Aug-2024 13:38 by rmk")
|
||||
[LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP) (* ; "Edited 28-Mar-2025 12:51 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 13:38 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 09:26 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 13:37 by rmk")
|
||||
(* ; "Edited 22-Apr-2024 23:47 by rmk")
|
||||
@@ -1537,7 +1590,7 @@
|
||||
(* ;; "Have to go character by character because COPYINSERT does (PRIN2 BKSYSBUF), which creates undesired string quotes.")
|
||||
|
||||
(for CHNO CH from (FGETSEL SOURCESEL CH#) to (SUB1 (FGETSEL SOURCESEL CHLIM))
|
||||
while (SETQ CH (TEDIT.NTHCHARCODE SOURCESTREAM CHNO))
|
||||
while (SETQ CH (\TEDIT.NTHCHARCODE SOURCESTREAM CHNO))
|
||||
do
|
||||
(* ;; "Maybe should apply the preprintfn ?")
|
||||
|
||||
@@ -2081,18 +2134,19 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEXTSTREAM.TITLE
|
||||
[LAMBDA (STREAM) (* ; "Edited 18-Oct-2023 00:02 by rmk")
|
||||
(\TEDIT.FILENAME
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 11:44 by rmk")
|
||||
(* ; "Edited 18-Oct-2023 00:02 by rmk")
|
||||
(* ; "Edited 24-Aug-2021 23:25 by rmk:")
|
||||
|
||||
(* ;; "returns a string with which you can talk to the user about this stream. e.g. for Get and Put prompts")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ STREAM))
|
||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
TXTFILE)
|
||||
(SETQ TXTFILE (FGETTOBJ TEXTOBJ TXTFILE))
|
||||
(OR (CL:TYPECASE TXTFILE
|
||||
(STRINGP TXTFILE)
|
||||
(STREAM (fetch (STREAM FULLNAME) of TXTFILE))
|
||||
(STREAM (FULLNAME TXTFILE))
|
||||
(LITATOM TXTFILE)
|
||||
(T TXTFILE))
|
||||
""])
|
||||
@@ -2166,8 +2220,9 @@
|
||||
(WINDOWPROP W 'TITLE TITLE))
|
||||
TITLE)))])
|
||||
|
||||
(\TEXTSTREAM.FILENAME
|
||||
[LAMBDA (TEXTSTREAM UNFORMATTED?) (* ; "Edited 18-Jan-2024 09:03 by rmk")
|
||||
(\TEDIT.LIKELY.FILENAME
|
||||
[LAMBDA (TSTREAM UNFORMATTED?) (* ; "Edited 14-Mar-2025 11:46 by rmk")
|
||||
(* ; "Edited 18-Jan-2024 09:03 by rmk")
|
||||
(* ; "Edited 29-Dec-2023 00:33 by rmk")
|
||||
(* ; "Edited 18-Dec-2023 14:06 by rmk")
|
||||
(* ; "Edited 30-May-91 23:34 by jds")
|
||||
@@ -2178,14 +2233,14 @@
|
||||
|
||||
(* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed.")
|
||||
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(DEFAULTEXT (CL:IF UNFORMATTED?
|
||||
'TXT
|
||||
'TEDIT))
|
||||
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
EXT)
|
||||
(CL:WHEN (type? STREAM TXTFILE)
|
||||
(SETQ TXTFILE (fetch FULLFILENAME of TXTFILE))
|
||||
(SETQ TXTFILE (fetch (STREAM FULLFILENAME) of TXTFILE))
|
||||
[SETQ EXT (U-CASE (FILENAMEFIELD TXTFILE 'EXTENSION]
|
||||
(if (OR (NULL EXT)
|
||||
(EQ EXT 'BRAVO))
|
||||
@@ -2196,7 +2251,10 @@
|
||||
(PACKFILENAME 'EXTENSION EXT 'VERSION NIL 'BODY TXTFILE))])
|
||||
|
||||
(\TEDIT.UPDATE.TITLE
|
||||
[LAMBDA (TEXTOBJ FILENAME) (* ; "Edited 13-Dec-2024 08:59 by rmk")
|
||||
[LAMBDA (TEXTOBJ FILENAME) (* ; "Edited 21-Mar-2025 23:41 by rmk")
|
||||
(* ; "Edited 15-Mar-2025 00:32 by rmk")
|
||||
(* ; "Edited 8-Mar-2025 12:00 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 08:59 by rmk")
|
||||
(* ; "Edited 22-Oct-2024 11:44 by rmk")
|
||||
(* ; "Edited 28-Aug-2024 15:50 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 13:11 by rmk")
|
||||
@@ -2206,20 +2264,27 @@
|
||||
|
||||
(* ;; "find and set the title to reflect a new filename, and update the file fields of any attached menu too.")
|
||||
|
||||
(LET ((TITLE (\TEXTSTREAM.TITLE TEXTOBJ))
|
||||
MENUSTREAM PC STATEFN)
|
||||
(LET ((TITLE (\TEDIT.FILENAME TEXTOBJ))
|
||||
MENUSTREAM SETSTATEFN FIELD FIELDS)
|
||||
(\TEDIT.WINDOW.TITLE TEXTOBJ NIL (\TEDIT.DEFAULT.TITLE (OR FILENAME TITLE)))
|
||||
(SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ))
|
||||
(SETQ MENUSTREAM (TEDIT.MENUSTREAM TEXTOBJ))
|
||||
(CL:WHEN (AND MENUSTREAM (LITATOM TITLE)) (* ;
|
||||
"if we have a filename then put it in the GET and PUT fields of the menu")
|
||||
"if we have a filename then put it in the GETFILE and PUTFILE fields of the menu")
|
||||
(SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE))
|
||||
(for BUTTON SETSTATEFN in (MB.GET '(GET PUT)
|
||||
MENUSTREAM
|
||||
'(OBJECT STARTPC)) when (SETQ SETSTATEFN
|
||||
(IMAGEOBJPROP (CAR BUTTON)
|
||||
'SETSTATEFN))
|
||||
do (APPLY* SETSTATEFN (CADR BUTTON)
|
||||
FILENAME MENUSTREAM)))])
|
||||
[SETQ FIELDS (MB.GET '(GETFILE PUTFILE)
|
||||
MENUSTREAM
|
||||
'(OBJECT STARTPC]
|
||||
(CL:WHEN [AND (SETQ FIELD (LISTGET FIELDS 'GETFILE))
|
||||
(SETQ SETSTATEFN (IMAGEOBJPROP (CAR FIELD)
|
||||
'SETSTATEFN]
|
||||
(APPLY* SETSTATEFN (CADR FIELD)
|
||||
FILENAME MENUSTREAM))
|
||||
(CL:WHEN [AND (SETQ FIELD (LISTGET FIELDS 'PUTFILE))
|
||||
(SETQ SETSTATEFN (IMAGEOBJPROP (CAR FIELD)
|
||||
'SETSTATEFN]
|
||||
(APPLY* SETSTATEFN (CADR FIELD)
|
||||
FILENAME MENUSTREAM))
|
||||
(\TEDIT.FILL.PANES MENUSTREAM))])
|
||||
)
|
||||
|
||||
|
||||
@@ -2229,7 +2294,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.DEACTIVATE.WINDOW
|
||||
[LAMBDA (PANE) (* ; "Edited 29-Nov-2024 13:10 by rmk")
|
||||
[LAMBDA (PANE) (* ; "Edited 14-Mar-2025 16:22 by rmk")
|
||||
(* ; "Edited 18-Feb-2025 23:56 by rmk")
|
||||
(* ; "Edited 29-Nov-2024 13:10 by rmk")
|
||||
(* ; "Edited 1-Jul-2024 17:42 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:20 by rmk")
|
||||
(* ; "Edited 12-May-2024 17:19 by rmk")
|
||||
@@ -2246,7 +2313,7 @@
|
||||
(* ;; "If the session is or can be finished, deactivate this Tedit window and process, and all attached Tedit menus. This disconnects the window and process from the textstream, which persists. This is not used to unsplit panes. The actual window-closing is done by setting the flag EDITFINISHEDFLG to T and giving control to the edit process. The flag causes the command loop to exit.")
|
||||
|
||||
(PROG* [(TSTREAM (TEXTSTREAM PANE T))
|
||||
(TEXTOBJ (AND TSTREAM (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM]
|
||||
(TEXTOBJ (AND TSTREAM (GETTSTR TSTREAM TEXTOBJ]
|
||||
(CL:UNLESS TEXTOBJ (* ;
|
||||
"Return NIL if not an editing window (rather than error?)")
|
||||
(RETURN))
|
||||
@@ -2261,7 +2328,7 @@
|
||||
(CLEARW (GETTOBJ TEXTOBJ PROMPTWINDOW)))
|
||||
(\TEDIT.SETCARET (TEXTSEL TEXTOBJ)
|
||||
PANE TEXTOBJ 'OFF) (* ;
|
||||
"Before the window is closed, make SURE that the caret is down, or the window will reappear.")
|
||||
"Before the window is closed, make sure that the caret is down, or the window will reappear.")
|
||||
(CL:WHEN (AND (\TEDIT.WINDOW.TITLE TEXTOBJ)
|
||||
(OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW))
|
||||
(OPENWP PANE)
|
||||
@@ -2285,13 +2352,14 @@
|
||||
(WINDOWDELPROP PANE 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW))
|
||||
(* ; "To avoid a loop")
|
||||
(WINDOWPROP PANE 'SCROLLFN NIL)
|
||||
(WINDOWPROP PANE 'AFTERMOVEFN NIL)
|
||||
(WINDOWDELPROP PANE 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN))
|
||||
(\TEDIT.INTERRUPT.SETUP (WINDOWPROP PANE 'PROCESS)
|
||||
T) (* ; "Restore any disarmed interrupts.")
|
||||
(for MENUW in (ATTACHEDWINDOWS PANE) when (TEDITMENUP MENUW)
|
||||
(for MENUW MTEXTOBJ in (ATTACHEDWINDOWS PANE) when (AND (SETQ MTEXTOBJ (TEXTOBJ MENUW T))
|
||||
(FGETTOBJ MTEXTOBJ MENUFLG))
|
||||
do (* ; "Detach all the TEDITMENU windows.")
|
||||
(SETTOBJ (TEXTOBJ MENUW)
|
||||
EDITFINISHEDFLG T) (* ;
|
||||
(SETTOBJ MTEXTOBJ EDITFINISHEDFLG T) (* ;
|
||||
"Mark it finished so it closes itself")
|
||||
(WINDOWPROP MENUW 'TEDITMENU NIL) (* ;
|
||||
"And mark it no longer a menu window")
|
||||
@@ -3462,7 +3530,11 @@
|
||||
(UPDATE/MENU/IMAGE MENU])
|
||||
|
||||
(TEDIT.DEFAULT.MENUFN
|
||||
[LAMBDA (PANE) (* ; "Edited 7-Jan-2025 23:46 by rmk")
|
||||
[LAMBDA (PANE) (* ; "Edited 17-Mar-2025 17:28 by rmk")
|
||||
(* ; "Edited 14-Mar-2025 16:40 by rmk")
|
||||
(* ; "Edited 12-Feb-2025 16:26 by rmk")
|
||||
(* ; "Edited 9-Feb-2025 21:28 by rmk")
|
||||
(* ; "Edited 7-Jan-2025 23:46 by rmk")
|
||||
(* ; "Edited 27-Jul-2024 20:24 by rmk")
|
||||
(* ; "Edited 30-Jun-2024 12:38 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 11:59 by rmk")
|
||||
@@ -3489,7 +3561,7 @@
|
||||
THISMENU ITEM)
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ EDITOPACTIVE)
|
||||
|
||||
(* ;; "We're busy doing something, tell him to wait")
|
||||
(* ;; "We're busy doing something, tell him to wait. Unfortunately, this string will overwrite whatever may be in the Tedit promptwindow (e.g. a GETINPUT calling TTYINPROMPTFORWORD for a meta-F command), obscuring what the user has already typed. Maybe an interface that tests to see if the promptwindow is in use, and enlarges it with an extra line above the current type-in?")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (CL:IF (EQ T (FGETTOBJ TEXTOBJ EDITOPACTIVE))
|
||||
"Edit"
|
||||
@@ -3497,15 +3569,14 @@
|
||||
" operation in progress; please wait")
|
||||
T)
|
||||
(RETURN NIL))
|
||||
(SETQ THISMENU (COND
|
||||
(WMENU)
|
||||
((SETQ WMENU (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS))
|
||||
(PROG1 (SETQ WMENU (\TEDIT.CREATEMENU WMENU))
|
||||
(WINDOWPROP PANE 'TEDIT.MENU WMENU)))
|
||||
(TEDIT.DEFAULT.MENU)))
|
||||
(SETQ ITEM (MENU THISMENU))
|
||||
(SETQ THISMENU (if WMENU
|
||||
elseif (SETQ WMENU (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS))
|
||||
then (PROG1 (SETQ WMENU (\TEDIT.CREATEMENU WMENU))
|
||||
(WINDOWPROP PANE 'TEDIT.MENU WMENU))
|
||||
else TEDIT.DEFAULT.MENU))
|
||||
(SETQ ITEM (CAR (MENU THISMENU)))
|
||||
(ERSETQ (RESETLST
|
||||
[SELECTQ (CAR ITEM)
|
||||
[SELECTQ ITEM
|
||||
((Put |Put Formatted Document|)
|
||||
(TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT)))
|
||||
(Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T))
|
||||
@@ -3524,7 +3595,7 @@
|
||||
(TEDIT.SUBSTITUTE TEXTOBJ)))
|
||||
(Find (* ;
|
||||
"Case sensitive search, with * and # wildcards")
|
||||
(\TEDIT.KEY.FIND TSTREAM TEXTOBJ))
|
||||
(\TEDIT.KEY.FIND TSTREAM))
|
||||
(Looks (* ;
|
||||
"He wants to set the font for the current selection")
|
||||
(\TEDIT.LOOKS TEXTOBJ))
|
||||
@@ -3541,14 +3612,13 @@
|
||||
(\TEDIT.PARAMENU.START TEXTOBJ))
|
||||
(Page% Layout (* ; "Open the page-layout menu")
|
||||
(\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
|
||||
(\TEDIT.PRIMARYPANE TEXTOBJ)
|
||||
"Page Layout Menu" 150 'PAGE))
|
||||
(CL:WHEN (CAR ITEM) (* ;
|
||||
TSTREAM "Page Layout Menu" 150 'PAGE))
|
||||
(Buttons (TEDIT.BUTTONS.BUILD))
|
||||
(CL:WHEN ITEM (* ;
|
||||
"Apply a user-supplied function to the text stream")
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ T)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(APPLY* (CAR ITEM)
|
||||
(fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))])])
|
||||
(APPLY* ITEM (TEXTSTREAM PANE)))])])
|
||||
|
||||
(TEDIT.REMOVE.MENUITEM
|
||||
[LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06")
|
||||
@@ -3617,11 +3687,12 @@
|
||||
(RPAQ TEDIT.DEFAULT.MENU
|
||||
[\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text))
|
||||
(Get 'Get NIL (SUBITEMS |Get Formatted Document| Unformatted% Get))
|
||||
Include Find Looks Substitute Quit (Expanded% Menu 'Expanded% Menu NIL
|
||||
(SUBITEMS Expanded% Menu
|
||||
Character% Looks
|
||||
Paragraph% Formatting
|
||||
Page% Layout])
|
||||
Include Find Looks Substitute (Buttons 'Buttons "Display action buttons")
|
||||
Quit
|
||||
(Expanded% Menu 'Expanded% Menu NIL (SUBITEMS Expanded% Menu
|
||||
Character% Looks
|
||||
Paragraph% Formatting
|
||||
Page% Layout])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -3652,37 +3723,38 @@
|
||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
||||
TEDIT.ICON.TITLE.REGION))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (18448 19344 (TEDIT.DEFER.UPDATES 18458 . 19342)) (19345 42387 (\TEDIT.CREATEW 19355 .
|
||||
26070) (\TEDIT.WINDOW.SETUP 26072 . 30185) (\TEDIT.MINIMAL.WINDOW.SETUP 30187 . 38389) (
|
||||
\TEDIT.CLEARPANE 38391 . 39108) (\TEDIT.FILL.PANES 39110 . 42385)) (42388 65102 (\TEDIT.CURSORMOVEDFN
|
||||
42398 . 47271) (\TEDIT.CURSOROUTFN 47273 . 47718) (\TEDIT.ACTIVE.WINDOWP 47720 . 48771) (
|
||||
\TEDIT.EXPANDFN 48773 . 49336) (\TEDIT.MAINW 49338 . 50618) (\TEDIT.MAINSTREAM 50620 . 50887) (
|
||||
\TEDIT.PRIMARYPANE 50889 . 51659) (\TEDIT.PANELIST 51661 . 52157) (\TEDIT.NEWREGIONFN 52159 . 54675) (
|
||||
\TEDIT.SET.WINDOW.EXTENT 54677 . 59931) (\TEDIT.SHRINK.ICONCREATE 59933 . 62473) (\TEDIT.SHRINKFN
|
||||
62475 . 62884) (\TEDIT.PANEREGION 62886 . 65100)) (65134 96589 (\TEDIT.BUTTONEVENTFN 65144 . 77697) (
|
||||
\TEDIT.BUTTONEVENTFN.DOOPERATION 77699 . 84422) (\TEDIT.BUTTONEVENTFN.GETOPERATION 84424 . 86266) (
|
||||
\TEDIT.BUTTONEVENTFN.CURSEL.INIT 86268 . 89505) (\TEDIT.BUTTONEVENTFN.INACTIVE 89507 . 91849) (
|
||||
\TEDIT.BUTTONEVENTFN.INTITLE 91851 . 93686) (\TEDIT.COPYINSERTFN 93688 . 94820) (\TEDIT.FOREIGN.COPY
|
||||
94822 . 96587)) (96590 113699 (\TEDIT.PANE.SPLIT 96600 . 101079) (\TEDIT.SPLITW 101081 . 108540) (
|
||||
\TEDIT.UNSPLITW 108542 . 112356) (\TEDIT.LINKPANES 112358 . 113121) (\TEDIT.UNLINKPANE 113123 . 113697
|
||||
)) (115056 115947 (TEDITWINDOWP 115066 . 115945)) (115984 119087 (TEDIT.GETINPUT 115994 . 118437) (
|
||||
\TEDIT.MAKEFILENAME 118439 . 119085)) (119136 127437 (TEDIT.PROMPTWINDOW 119146 . 119460) (
|
||||
TEDIT.PROMPTPRINT 119462 . 122089) (TEDIT.PROMPTCLEAR 122091 . 123810) (TEDIT.PROMPTFLASH 123812 .
|
||||
125744) (\TEDIT.PROMPT.PAGEFULLFN 125746 . 127435)) (127675 136501 (\TEXTSTREAM.TITLE 127685 . 128375)
|
||||
(\TEDIT.DEFAULT.TITLE 128377 . 130756) (\TEDIT.WINDOW.TITLE 130758 . 132927) (\TEXTSTREAM.FILENAME
|
||||
132929 . 134599) (\TEDIT.UPDATE.TITLE 134601 . 136499)) (136544 144747 (TEDIT.DEACTIVATE.WINDOW 136554
|
||||
. 142347) (\TEDIT.RESHAPEFN 142349 . 144519) (\TEDIT.REPAINTFN 144521 . 144745)) (144748 187127 (
|
||||
\TEDIT.SCROLLFN 144758 . 147003) (\TEDIT.SCROLLCH.TOP 147005 . 149116) (\TEDIT.SCROLLCH.BOTTOM 149118
|
||||
. 153448) (\TEDIT.SCROLLUP 153450 . 159067) (\TEDIT.TOPLINE.YTOP 159069 . 160738) (\TEDIT.SCROLLDOWN
|
||||
160740 . 167670) (\TEDIT.SCROLL.CARET 167672 . 170510) (\TEDIT.VISIBLECARETP 170512 . 172806) (
|
||||
\TEDIT.VISIBLECHARP 172808 . 173899) (\TEDIT.BITMAPLINES 173901 . 177821) (\TEDIT.SETPANE.TOPLINE
|
||||
177823 . 178614) (\TEDIT.SHIFTLINES 178616 . 187125)) (187128 197997 (\TEDIT.ONSCREEN? 187138 . 191689
|
||||
) (\TEDIT.ONSCREEN.REGION 191691 . 195342) (\TEDIT.AFTERMOVEFN 195344 . 196241) (OFFSCREENP 196243 .
|
||||
197995)) (198039 200656 (\TEDIT.PROCIDLEFN 198049 . 199586) (\TEDIT.PROCENTRYFN 199588 . 200033) (
|
||||
\TEDIT.PROCEXITFN 200035 . 200654)) (200735 213889 (\TEDIT.DOWNCARET 200745 . 201538) (
|
||||
\TEDIT.FLASHCARET 201540 . 203651) (\TEDIT.UPCARET 203653 . 204757) (TEDIT.NORMALIZECARET 204759 .
|
||||
207977) (\TEDIT.SETCARET 207979 . 213259) (\TEDIT.CARET 213261 . 213887)) (213923 225584 (
|
||||
TEDIT.ADD.MENUITEM 213933 . 216224) (TEDIT.DEFAULT.MENUFN 216226 . 222796) (TEDIT.REMOVE.MENUITEM
|
||||
222798 . 223795) (\TEDIT.CREATEMENU 223797 . 224362) (\TEDIT.MENU.WHENHELDFN 224364 . 225269) (
|
||||
\TEDIT.MENU.WHENSELECTEDFN 225271 . 225582)))))
|
||||
(FILEMAP (NIL (18637 19533 (TEDIT.DEFER.UPDATES 18647 . 19531)) (19534 45844 (\TEDIT.WINDOW.CREATE
|
||||
19544 . 26156) (\TEDIT.WINDOW.GETREGION 26158 . 29527) (\TEDIT.WINDOW.SETUP 29529 . 33642) (
|
||||
\TEDIT.MINIMAL.WINDOW.SETUP 33644 . 41846) (\TEDIT.CLEARPANE 41848 . 42565) (\TEDIT.FILL.PANES 42567
|
||||
. 45842)) (45845 68752 (\TEDIT.CURSORMOVEDFN 45855 . 50728) (\TEDIT.CURSOROUTFN 50730 . 51175) (
|
||||
\TEDIT.ACTIVE.WINDOWP 51177 . 52228) (\TEDIT.EXPANDFN 52230 . 52793) (\TEDIT.MAINW 52795 . 54075) (
|
||||
\TEDIT.MAINSTREAM 54077 . 54344) (\TEDIT.PRIMARYPANE 54346 . 55116) (\TEDIT.PANELIST 55118 . 55614) (
|
||||
\TEDIT.NEWREGIONFN 55616 . 58132) (\TEDIT.SET.WINDOW.EXTENT 58134 . 63388) (\TEDIT.SHRINK.ICONCREATE
|
||||
63390 . 66123) (\TEDIT.SHRINKFN 66125 . 66534) (\TEDIT.PANEREGION 66536 . 68750)) (68784 100358 (
|
||||
\TEDIT.BUTTONEVENTFN 68794 . 81356) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81358 . 88081) (
|
||||
\TEDIT.BUTTONEVENTFN.GETOPERATION 88083 . 89925) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89927 . 93164) (
|
||||
\TEDIT.BUTTONEVENTFN.INACTIVE 93166 . 95508) (\TEDIT.BUTTONEVENTFN.INTITLE 95510 . 97345) (
|
||||
\TEDIT.COPYINSERTFN 97347 . 98479) (\TEDIT.FOREIGN.COPY 98481 . 100356)) (100359 117468 (
|
||||
\TEDIT.PANE.SPLIT 100369 . 104848) (\TEDIT.SPLITW 104850 . 112309) (\TEDIT.UNSPLITW 112311 . 116125) (
|
||||
\TEDIT.LINKPANES 116127 . 116890) (\TEDIT.UNLINKPANE 116892 . 117466)) (118825 119716 (TEDITWINDOWP
|
||||
118835 . 119714)) (119753 122856 (TEDIT.GETINPUT 119763 . 122206) (\TEDIT.MAKEFILENAME 122208 . 122854
|
||||
)) (122905 131206 (TEDIT.PROMPTWINDOW 122915 . 123229) (TEDIT.PROMPTPRINT 123231 . 125858) (
|
||||
TEDIT.PROMPTCLEAR 125860 . 127579) (TEDIT.PROMPTFLASH 127581 . 129513) (\TEDIT.PROMPT.PAGEFULLFN
|
||||
129515 . 131204)) (131444 141085 (\TEDIT.FILENAME 131454 . 132226) (\TEDIT.DEFAULT.TITLE 132228 .
|
||||
134607) (\TEDIT.WINDOW.TITLE 134609 . 136778) (\TEDIT.LIKELY.FILENAME 136780 . 138567) (
|
||||
\TEDIT.UPDATE.TITLE 138569 . 141083)) (141128 149656 (TEDIT.DEACTIVATE.WINDOW 141138 . 147256) (
|
||||
\TEDIT.RESHAPEFN 147258 . 149428) (\TEDIT.REPAINTFN 149430 . 149654)) (149657 192036 (\TEDIT.SCROLLFN
|
||||
149667 . 151912) (\TEDIT.SCROLLCH.TOP 151914 . 154025) (\TEDIT.SCROLLCH.BOTTOM 154027 . 158357) (
|
||||
\TEDIT.SCROLLUP 158359 . 163976) (\TEDIT.TOPLINE.YTOP 163978 . 165647) (\TEDIT.SCROLLDOWN 165649 .
|
||||
172579) (\TEDIT.SCROLL.CARET 172581 . 175419) (\TEDIT.VISIBLECARETP 175421 . 177715) (
|
||||
\TEDIT.VISIBLECHARP 177717 . 178808) (\TEDIT.BITMAPLINES 178810 . 182730) (\TEDIT.SETPANE.TOPLINE
|
||||
182732 . 183523) (\TEDIT.SHIFTLINES 183525 . 192034)) (192037 202906 (\TEDIT.ONSCREEN? 192047 . 196598
|
||||
) (\TEDIT.ONSCREEN.REGION 196600 . 200251) (\TEDIT.AFTERMOVEFN 200253 . 201150) (OFFSCREENP 201152 .
|
||||
202904)) (202948 205565 (\TEDIT.PROCIDLEFN 202958 . 204495) (\TEDIT.PROCENTRYFN 204497 . 204942) (
|
||||
\TEDIT.PROCEXITFN 204944 . 205563)) (205644 218798 (\TEDIT.DOWNCARET 205654 . 206447) (
|
||||
\TEDIT.FLASHCARET 206449 . 208560) (\TEDIT.UPCARET 208562 . 209666) (TEDIT.NORMALIZECARET 209668 .
|
||||
212886) (\TEDIT.SETCARET 212888 . 218168) (\TEDIT.CARET 218170 . 218796)) (218832 231159 (
|
||||
TEDIT.ADD.MENUITEM 218842 . 221133) (TEDIT.DEFAULT.MENUFN 221135 . 228371) (TEDIT.REMOVE.MENUITEM
|
||||
228373 . 229370) (\TEDIT.CREATEMENU 229372 . 229937) (\TEDIT.MENU.WHENHELDFN 229939 . 230844) (
|
||||
\TEDIT.MENU.WHENSELECTEDFN 230846 . 231157)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Jan-2025 12:38:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;197 53250
|
||||
(FILECREATED "28-Mar-2025 17:12:59"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;209 53312
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "14-Dec-2024 11:45:45" {WMEDLEY}<library>TEDIT>tedit-exports.all;196)
|
||||
:PREVIOUS-DATE "16-Mar-2025 00:20:08" {WMEDLEY}<library>TEDIT>tedit-exports.all;208)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
@@ -18,7 +18,7 @@ PRINT))))))))
|
||||
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
||||
(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
|
||||
\TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 5-Jan-2025 23:34:12"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:10:12"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -44,8 +44,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
||||
DLEN) of SLOT with DWNL)))
|
||||
(PUTPROPS \FINDSLOT MACRO ((BTNODE ITEM) (find S inslots BTNODE suchthat (EQ ITEM (ffetch (BTSLOT DOWN
|
||||
) of S)))))
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ)) PC
|
||||
)))
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE)) PC)))
|
||||
(I.S.OPR (QUOTE inslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$BTBODY) (QUOTE (bind $$BTBODY _ BODY
|
||||
$$BTEND declare (LOCALVARS $$BTBODY $$BTEND) first (SETQ I.V. (\FIRSTSLOT $$BTBODY)) (SETQ $$BTEND (
|
||||
\LASTSLOT $$BTBODY)) repeatuntil (EQ I.V. $$BTEND) by (\ADDBASE I.V. \BTREEWORDSPERSLOT))))) T)
|
||||
@@ -53,7 +52,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
||||
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
|
||||
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:12:27"))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 20:56:54"))
|
||||
(DATATYPE SELECTION ((* ;;
|
||||
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
|
||||
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
||||
@@ -119,7 +118,7 @@ $$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE
|
||||
(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
|
||||
(GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION
|
||||
TEDIT.DELETESELECTION)
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 1-Jan-2025 12:33:54"))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "19-Mar-2025 16:27:02"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
@@ -149,8 +148,9 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
|
||||
"A cached textstream that this line took its text from. Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity."
|
||||
) NIL (* ;
|
||||
"Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ"
|
||||
) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC (
|
||||
* ; "The format spec for this line's paragraph (eventually)") (NIL FLAG) (* ;
|
||||
) LFIRSTSEPR (* ;
|
||||
"Character position of the first separator on the line, for detecting the last valid line.")
|
||||
LPARALOOKS (* ; "The paragraph looks for this line's paragraph (eventually)") (NIL FLAG) (* ;
|
||||
"Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ;
|
||||
"Was FORCED-END flag") (NIL FLAG) (* ;
|
||||
"Was DELETED: T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)"
|
||||
@@ -262,7 +262,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
|
||||
THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.)
|
||||
eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.))
|
||||
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 11:56:35"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 17:12:44"))
|
||||
(DATATYPE PIECE ((* ;
|
||||
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
|
||||
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
|
||||
@@ -287,7 +287,7 @@ DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFA
|
||||
"This is where TEdit stores its state information, and internal data about the text being edited.")
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
||||
"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
|
||||
) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
) SUFFIXPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
CHARFN (* ;
|
||||
"Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")
|
||||
HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
|
||||
@@ -302,10 +302,11 @@ HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
|
||||
"Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES."
|
||||
) DS (* ;
|
||||
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
||||
SEL (* ; "The current selection within the text") NIL (* ; "Was: Scratch space for the selection code"
|
||||
) NIL (* ; "Was MOVESEL: Source for the next MOVE of text") NIL (* ;
|
||||
"Was SHIFTEDSEL: Source for the next COPY") NIL (* ; "Was DELETESEL: Text to be deleted imminently")
|
||||
WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||
SEL (* ; "The current selection within the text") LASTARROWX (* ;
|
||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code") NIL (* ;
|
||||
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
|
||||
NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||
"Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ;
|
||||
"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG)
|
||||
(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
|
||||
@@ -315,7 +316,7 @@ WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") W
|
||||
"Font to be used for inserted text.") WINDOWTITLE (* ;
|
||||
"Original title for this window, of there was one.") THISLINE (* ;
|
||||
"Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ;
|
||||
"T if this TEXTOBJ is a tedit-style menu") DEFAULTPARALOOKS (* ;
|
||||
"Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ;
|
||||
"Flag for paragraph formatting. T if this document is to contain paragraph formatting information.")
|
||||
(TXTREADONLY FLAG) (* ; "This is only available for shift selection.") (TXTEDITING FLAG) (* ;
|
||||
@@ -340,7 +341,7 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL
|
||||
"The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode"
|
||||
) TXTPAGEFRAMES (* ; "A tree of page frames, specifying how the document is to be laid out.")
|
||||
TXTCHARLOOKSLIST (* ; "List of all the CHARLOOKSs in the document, so they can be kept unique")
|
||||
TXTPARALOOKSLIST (* ; "List of all the FMTSPECs in the document, so they can be kept unique") (
|
||||
TXTPARALOOKSLIST (* ; "List of all the PARALOOKS in the document, so they can be kept unique") (
|
||||
TXTAPPENDONLY FLAG) (* ;
|
||||
"Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater"
|
||||
) (TXTDON'TUPDATE FLAG) (* ;
|
||||
@@ -349,10 +350,11 @@ TXTAPPENDONLY FLAG) (* ;
|
||||
"NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ;
|
||||
"Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ;
|
||||
"Style sheet local to this document. Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
|
||||
(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM
|
||||
)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))))) SEL _ (create
|
||||
SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _
|
||||
(create THISLINE) FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (FSETTOBJ DATUM LASTARROWX NIL) (CL:UNLESS (EQ
|
||||
NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY
|
||||
OF DATUM WITH NEWVALUE)))))) SEL _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0
|
||||
WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _ (create THISLINE) DEFAULTPARALOOKS _
|
||||
TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
|
||||
(ACCESSFNS TEXTSTREAM ((* ;;
|
||||
"Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;;
|
||||
"The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3)
|
||||
@@ -362,10 +364,10 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i
|
||||
DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") (
|
||||
NIL) (* ;
|
||||
"Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ."
|
||||
) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with
|
||||
) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (replace (STREAM IMAGEDATA) of DATUM with
|
||||
NEWVALUE)) (* ;
|
||||
"The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone."
|
||||
) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ;
|
||||
"THIS IS SOMEHOW INVOLVED IN STYLES, NOT SENSIBLE. REMOVE? The PARALOOKS that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone."
|
||||
) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (replace (STREAM F4) OF DATUM with NEWVALUE)) (* ;
|
||||
"Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting."
|
||||
) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE?
|
||||
(AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create
|
||||
@@ -444,25 +446,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:28:18"))
|
||||
(RPAQQ NONE.TTC 0)
|
||||
(RPAQQ CHARDELETE.TTC 1)
|
||||
(RPAQQ WORDDELETE.TTC 2)
|
||||
(RPAQQ DELETE.TTC 3)
|
||||
(RPAQQ FUNCTIONCALL.TTC 4)
|
||||
(RPAQQ REDO.TTC 5)
|
||||
(RPAQQ UNDO.TTC 6)
|
||||
(RPAQQ CMD.TTC 7)
|
||||
(RPAQQ NEXT.TTC 8)
|
||||
(RPAQQ EXPAND.TTC 9)
|
||||
(RPAQQ CHARDELETE.FORWARD.TTC 10)
|
||||
(RPAQQ WORDDELETE.FORWARD.TTC 11)
|
||||
(RPAQQ PUNCT.TTC 20)
|
||||
(RPAQQ TEXT.TTC 21)
|
||||
(RPAQQ WHITESPACE.TTC 22)
|
||||
(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (
|
||||
REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) (
|
||||
WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:26:47"))
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
|
||||
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
|
||||
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
||||
@@ -471,22 +455,13 @@ WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
|
||||
I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP)
|
||||
"TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
|
||||
)) (T (CONS COMMENTFLG ARGS)))))
|
||||
(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) (TTDECODE (LOGAND DATUM 31))))
|
||||
(RPAQQ NOTBEFORE.LB 1)
|
||||
(RPAQQ NOTAFTER.LB 2)
|
||||
(RPAQQ BEFORE.LB 4)
|
||||
(RPAQQ AFTER.LB 8)
|
||||
(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
|
||||
(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16)
|
||||
(NEWCHAR-IF-SPLIT.LB 32))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "28-Nov-2024 10:03:03"))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "23-Mar-2025 15:27:20"))
|
||||
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
|
||||
\BIN STREAM)) BITSPERWORD)))
|
||||
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
||||
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:28:41"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:29:36"))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:24:34"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:09:40"))
|
||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||
"The font descriptor for these characters") CLFONTUNPARSE (* ;;
|
||||
@@ -516,7 +491,7 @@ LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
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 FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
|
||||
(DATATYPE PARALOOKS ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
|
||||
1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ;
|
||||
"Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ;
|
||||
"Right margin for the paragraph") LEADBEFORE (* ;
|
||||
@@ -549,25 +524,33 @@ QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED")
|
||||
) FMTHARDCOPYSCALE (* ;
|
||||
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T"
|
||||
) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT (
|
||||
DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _
|
||||
0)
|
||||
DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
|
||||
LINELEAD _ 0)
|
||||
(DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
|
||||
(DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))
|
||||
(DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))
|
||||
(PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A
|
||||
)) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
|
||||
\PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V)))
|
||||
(PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF)))))
|
||||
(PUTPROPS FSETPARA MACRO ((F FIELD NEWVALUE) (freplace (FMTSPEC FIELD) of F with NEWVALUE)))
|
||||
(PUTPROPS FGETPARA MACRO ((F FIELD) (ffetch (FMTSPEC FIELD) of F)))
|
||||
(PUTPROPS GETPARA MACRO ((F FIELD) (fetch (FMTSPEC FIELD) of F)))
|
||||
(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) (replace (FMTSPEC FIELD) of F with NEWVALUE)))
|
||||
(PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL)))
|
||||
(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE)))
|
||||
(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL)))
|
||||
(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC))))
|
||||
(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:34:07"))
|
||||
(PUTPROPS GETPLOOKS MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS SETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
|
||||
))
|
||||
(PUTPROPS FGETPLOOKS MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||
NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||
(PUTPROPS FSETPARA MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
|
||||
))
|
||||
(PUTPROPS FGETPARA MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS GETPARA MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS SETPARA MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:24:25"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:31:28"))
|
||||
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
|
||||
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
||||
means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
|
||||
@@ -623,8 +606,8 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
|
||||
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
||||
$$OUT)))))
|
||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 11:56:24"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE " 6-Jan-2025 00:20:34"))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:07:08"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "24-Mar-2025 09:26:13"))
|
||||
(RPAQQ PTSPERPICA 12)
|
||||
(RPAQQ PTSPERINCH 72)
|
||||
(RPAQQ PICASPERINCH 6)
|
||||
@@ -635,10 +618,15 @@ $$OUT)))))
|
||||
(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT
|
||||
PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT
|
||||
MICASPERINCH PTSPERINCH)))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:36:43"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "29-Dec-2024 08:47:57"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "23-Mar-2025 14:56:57"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:07:00"))
|
||||
(RPAQQ \TEDIT.TTCCODES ((NONE 0) (CHARDELETE 1) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
|
||||
UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT
|
||||
21) (WHITESPACE 22)))
|
||||
(CONSTANTS \TEDIT.TTCCODES)
|
||||
(PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 10:13:53"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:34:37"))
|
||||
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
|
||||
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
|
||||
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
||||
@@ -652,7 +640,7 @@ TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVE
|
||||
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
||||
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
|
||||
NEWVALUE)))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 19:41:55"))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:23:18"))
|
||||
(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ;
|
||||
"The current page number. Counted from 1") FIRSTPAGE (* ;;
|
||||
"T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed."
|
||||
@@ -683,9 +671,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
|
||||
(PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
|
||||
(PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
|
||||
)
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:31:19"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 2-Jan-2025 23:45:04"))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "23-Feb-2025 10:06:16"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 10:13:36"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:23:07"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -281,4 +281,3 @@ Copyright (c) 1987 by Unisys Corp.. All rights reserved.
|
||||
(FILEMAP (NIL (1135 12019 (EDITDEF.FUNCTIONS 1145 . 1784) (FIXDEFUNEDITDATE 1786 . 3426) (MYEDITDATE?
|
||||
3428 . 4692) (MYSUPERPRINT/COMMENT 4694 . 7753) (MYSUPERPRINT/COMMENT2 7755 . 12017)))))
|
||||
STOP
|
||||
ÿ
|
||||
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jan-2025 11:00:54" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;263 131893
|
||||
(FILECREATED "26-Mar-2025 09:41:31" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;267 133447
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
(FNS CD-MENUFN)
|
||||
|
||||
:PREVIOUS-DATE "23-Dec-2024 23:54:13" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;262)
|
||||
:PREVIOUS-DATE "18-Feb-2025 23:37:14" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;264)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -52,6 +53,7 @@
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN)
|
||||
(FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CD-COMPARE-FILES
|
||||
CDBROWSER-COPY CDBROWSER-DELETE-FILE CD-SWAPDIRS)
|
||||
(INITVARS (CD-LINELENGTH NIL))
|
||||
(VARS CDTABLEBROWSER.MENUITEMS)
|
||||
(FILES (SYSLOAD)
|
||||
COMPARESOURCES COMPARETEXT)
|
||||
@@ -1960,6 +1962,10 @@
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 26-Mar-2025 09:39 by rmk")
|
||||
|
||||
(* ;; "Edited 18-Feb-2025 23:36 by rmk")
|
||||
|
||||
(* ;; "Edited 23-Dec-2024 23:53 by rmk")
|
||||
|
||||
(* ;; "Edited 21-May-2022 21:59 by rmk")
|
||||
@@ -1974,7 +1980,10 @@
|
||||
(CL:WHEN (MEMB MENUITEM '(Compare See See% right See% both See% left))
|
||||
(* ; "Close the previous ones")
|
||||
(CLOSEWITH.DOIT WINDOW))
|
||||
(LET (CHILDREN)
|
||||
(LET ((SOURCEWIDTH (ITIMES (OR CD-LINELENGTH TEDIT.SOURCE.LINELENGTH)
|
||||
(CHARWIDTH (CHARCODE SPACE)
|
||||
DEFAULTFONT)))
|
||||
CHILDREN)
|
||||
(SETQ CHILDREN
|
||||
(SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
@@ -1987,7 +1996,13 @@
|
||||
THEN (if (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
else (TEDIT-SEE FILE1 (RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(CL:IF (LISPSOURCEFILEP FILE1)
|
||||
SOURCEWIDTH
|
||||
700)
|
||||
700
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
@@ -2001,7 +2016,13 @@
|
||||
THEN (if (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (TEDIT-SEE FILE2 (RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(CL:IF (LISPSOURCEFILEP FILE2)
|
||||
SOURCEWIDTH
|
||||
700)
|
||||
700
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
@@ -2019,7 +2040,13 @@
|
||||
elseif (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(RELCREATEREGION (ITIMES 2 (CL:IF (LISPSOURCEFILEP FILE1)
|
||||
SOURCEWIDTH
|
||||
700))
|
||||
700
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
@@ -2208,6 +2235,8 @@
|
||||
ELSE (ERROR FILE (CONCAT " doesn't begin with " FROMDIR])
|
||||
)
|
||||
|
||||
(RPAQ? CD-LINELENGTH NIL)
|
||||
|
||||
(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN)
|
||||
(Copy% -> CD-MENUFN)
|
||||
(Copy% <- CD-MENUFN)
|
||||
@@ -2221,25 +2250,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 (2701 23064 (COMPAREDIRECTORIES 2711 . 8046) (COMPAREDIRECTORIES.INFOS 8048 . 11006) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11008 . 14393) (CDENTRIES.SELECT 14395 . 19170) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19172 . 20298) (MATCHNAME 20300 . 20980) (CD.INSURECDVALUE 20982 . 22596
|
||||
) (CD.UPDATEWIDTHS 22598 . 23062)) (23065 33687 (CDFILES 23075 . 29089) (CDFILES.MATCH 29091 . 30716)
|
||||
(CDFILES.PATS 30718 . 33685)) (33688 51509 (CDPRINT 33698 . 36215) (CDPRINT.HEADER 36217 . 37114) (
|
||||
CDPRINT.LINE 37116 . 40348) (CDPRINT.MAXWIDTHS 40350 . 44465) (CDPRINT.COLHEADERS 44467 . 45752) (
|
||||
CDPRINT.COLUMNS 45754 . 50874) (CDTEDIT 50876 . 51507)) (51510 60631 (CDMAP 51520 . 52952) (CDENTRY
|
||||
52954 . 53263) (CDSUBSET 53265 . 54704) (CDMERGE 54706 . 58690) (CDMERGE.COMMON 58692 . 60007) (
|
||||
CD.SORT 60009 . 60629)) (60632 68170 (BINCOMP 60642 . 64931) (EOLTYPE 64933 . 67495) (EOLTYPE.SHOW
|
||||
67497 . 68168)) (68698 81225 (FIND-UNCOMPILED-FILES 68708 . 72351) (FIND-UNSOURCED-FILES 72353 . 74737
|
||||
) (FIND-SOURCE-FILES 74739 . 76477) (FIND-COMPILED-FILES 76479 . 78356) (FIND-UNLOADED-FILES 78358 .
|
||||
79211) (FIND-LOADED-FILES 79213 . 79641) (FIND-MULTICOMPILED-FILES 79643 . 81223)) (81226 89657 (
|
||||
CREATED-AS 81236 . 86033) (SOURCE-FOR-COMPILED-P 86035 . 88962) (COMPILE-SOURCE-DATE-DIFF 88964 .
|
||||
89655)) (89658 100421 (FIX-DIRECTORY-DATES 89668 . 93118) (FIX-EQUIV-DATES 93120 . 94645) (
|
||||
COPY-COMPARED-FILES 94647 . 96468) (COPY-MISSING-FILES 96470 . 98627) (COMPILED-ON-SAME-SOURCE 98629
|
||||
. 100419)) (100615 108453 (CDBROWSER 100625 . 104552) (CDBROWSER.STRINGS 104554 . 108451)) (108615
|
||||
110351 (CD.TABLEITEM 108625 . 108845) (CD.TABLEITEM.PRINTFN 108847 . 109046) (CD.TABLEITEM.COPYFN
|
||||
109048 . 110106) (CDTABLEBROWSER.HEADING.REPAINTFN 110108 . 110349)) (110352 132922 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 110362 . 110830) (CD.COMMANDSELECTEDFN 110832 . 115933) (CD-MENUFN
|
||||
115935 . 122161) (CD-COMPARE-FILES 122163 . 125515) (CDBROWSER-COPY 125517 . 129186) (
|
||||
CDBROWSER-DELETE-FILE 129188 . 132401) (CD-SWAPDIRS 132403 . 132920)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,105 +0,0 @@
|
||||
(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
|
||||
@@ -1,14 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jan-2025 22:00:44" {WMEDLEY}<lispusers>EXAMINEDEFS.;54 16352
|
||||
(FILECREATED " 6-Apr-2025 23:54:50" {WMEDLEY}<lispusers>EXAMINEDEFS.;57 16827
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS EXVV EXV)
|
||||
(COMMANDS exv)
|
||||
(VARS EXAMINEDEFSCOMS)
|
||||
:CHANGES-TO (FNS TEDITDEF)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:09:08" {WMEDLEY}<lispusers>EXAMINEDEFS.;53)
|
||||
:PREVIOUS-DATE "31-Mar-2025 13:53:38" {WMEDLEY}<lispusers>EXAMINEDEFS.;56)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
@@ -22,7 +20,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 6-Dec-2024 20:51 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 31-Mar-2025 13:53 by rmk")
|
||||
(* ; "Edited 18-Feb-2025 22:56 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 20:51 by rmk")
|
||||
(* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
(* ; "Edited 18-May-2023 22:35 by rmk")
|
||||
(* ; "Edited 21-Apr-2023 14:42 by rmk")
|
||||
@@ -140,11 +140,13 @@
|
||||
W1
|
||||
'PROCESS))
|
||||
(CONS W2 (WINDOWPROP W2 'PROCESS])
|
||||
(COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS CTWINDOW
|
||||
(KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2))
|
||||
(TEXTWIDTH 700)
|
||||
(TEXTHEIGHT 600))
|
||||
(COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS
|
||||
CTWINDOW
|
||||
(KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2))
|
||||
(TEXTWIDTH (ITIMES TEDIT.SOURCE.LINELENGTH
|
||||
(CHARWIDTH (CHARCODE SPACE)
|
||||
DEFAULTFONT)))
|
||||
(TEXTHEIGHT 600))
|
||||
(DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS))
|
||||
(* ;
|
||||
"Reuse an existing CT graph window for this DEF")
|
||||
@@ -196,11 +198,12 @@
|
||||
NIL TITLE2])
|
||||
|
||||
(TEDITDEF
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT WIDTH) (* ; "Edited 13-Oct-2023 00:23 by rmk")
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT WIDTH) (* ; "Edited 6-Apr-2025 23:53 by rmk")
|
||||
(* ; "Edited 13-Oct-2023 00:23 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:27 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 23:36 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:27 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(LET [(TSTREAM (OPENTEXTSTREAM NIL NIL `(BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE]
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(CL:WHEN WIDTH
|
||||
(LINELENGTH (IQUOTIENT WIDTH (CHARWIDTH (CHARCODE SPACE)
|
||||
@@ -278,6 +281,6 @@
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT VERSIONDEFS)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (736 16121 (EXAMINEDEFS 746 . 10675) (EXAMINEFILES 10677 . 12159) (TEDITDEF 12161 .
|
||||
14327) (EXVV 14329 . 16119)))))
|
||||
(FILEMAP (NIL (662 16596 (EXAMINEDEFS 672 . 10994) (EXAMINEFILES 10996 . 12478) (TEDITDEF 12480 .
|
||||
14802) (EXVV 14804 . 16594)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10 8777
|
||||
(FILECREATED " 5-Feb-2025 17:03:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;11 9743
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS FontTable)
|
||||
:CHANGES-TO (FNS FontSample FontTable)
|
||||
|
||||
:PREVIOUS-DATE " 3-Feb-2025 13:06:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;7
|
||||
:PREVIOUS-DATE " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10
|
||||
)
|
||||
|
||||
|
||||
@@ -20,7 +20,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FontSample
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03")
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal)
|
||||
(* ; "Edited 5-Feb-2025 17:02 by mth")
|
||||
(* edited%: "29-Apr-87 22:03")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
|
||||
(FontList (if (LISTP Fonts)
|
||||
else (CONS Fonts)))
|
||||
@@ -38,7 +40,7 @@
|
||||
(NEQ CharacterSet
|
||||
LastCharacterSet
|
||||
))
|
||||
TitleFont InchesToPrinterUnits))
|
||||
TitleFont InchesToPrinterUnits Hexadecimal))
|
||||
finally (CLOSEF Stream])
|
||||
|
||||
(FontSampleFaked
|
||||
@@ -55,7 +57,8 @@
|
||||
(CLOSEF Stream])
|
||||
|
||||
(FontTable
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits)
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal)
|
||||
(* ; "Edited 5-Feb-2025 17:03 by mth")
|
||||
(* ; "Edited 3-Feb-2025 20:07 by mth")
|
||||
(* edited%: "29-Apr-87 22:36")
|
||||
(LET*
|
||||
@@ -76,16 +79,22 @@
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
|
||||
(printout T Title .I0.8 CharacterSet "Q" T)
|
||||
(RESETLST
|
||||
(RESETSAVE (RADIX 8))
|
||||
(RESETSAVE (RADIX (if Hexadecimal
|
||||
then 16
|
||||
else 8)))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 10 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(DSPFONT TitleFont Stream)
|
||||
(printout Stream Title .I0.8 CharacterSet)
|
||||
(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 "8")
|
||||
(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)
|
||||
@@ -93,7 +102,10 @@
|
||||
(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)
|
||||
(PRIN1 Counter 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)
|
||||
@@ -139,11 +151,15 @@
|
||||
(FTIMES 0.75 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(DSPFONT TitleFont Stream)
|
||||
(printout Stream Title .I0.8 CharacterSet)
|
||||
(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 "8")
|
||||
(printout Stream (if Hexadecimal
|
||||
then "16"
|
||||
else "8"))
|
||||
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
|
||||
'HOST)
|
||||
'LPT)
|
||||
@@ -169,6 +185,6 @@
|
||||
FONT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (645 8614 (FontSample 655 . 2106) (FontSampleFaked 2108 . 2917) (FontTable 2919 . 8612))
|
||||
(FILEMAP (NIL (657 9580 (FontSample 667 . 2302) (FontSampleFaked 2304 . 3113) (FontTable 3115 . 9578))
|
||||
)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
433
lispusers/GITFNS
433
lispusers/GITFNS
@@ -1,28 +1,29 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Jan-2025 19:20:27" {WMEDLEY}<lispusers>GITFNS.;535 133255
|
||||
(FILECREATED "29-Apr-2025 15:17:37" {WMEDLEY}<lispusers>GITFNS.;541 134267
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS PRC-COMMAND)
|
||||
:CHANGES-TO (VARS GITFNSCOMS)
|
||||
(FNS GIT-WORKING-COMPARE-DIRECTORIES)
|
||||
|
||||
:PREVIOUS-DATE "12-Jun-2024 23:02:26" {WMEDLEY}<lispusers>GITFNS.;531)
|
||||
:PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
|
||||
(RPAQQ GITFNSCOMS
|
||||
(RPAQQ GITFNSCOMS
|
||||
(
|
||||
(* ;; "Set up")
|
||||
(* ;; "Set up")
|
||||
|
||||
(FILES (SYSLOAD FROM LISPUSERS)
|
||||
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER
|
||||
)
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "GIT projects")
|
||||
(* ;; "GIT projects")
|
||||
|
||||
(COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD
|
||||
GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH
|
||||
@@ -43,94 +44,94 @@
|
||||
(P (GIT-INIT))
|
||||
(ADDVARS (AROUNDEXITFNS GIT-INIT))
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Lisp exec commands")
|
||||
(* ;; "Lisp exec commands")
|
||||
|
||||
(INITVARS (GIT-MERGE-COMPARES T)
|
||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
||||
(FNS PRC-COMMAND)
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "File correspondents")
|
||||
(* ;; "File correspondents")
|
||||
|
||||
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
|
||||
(FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
|
||||
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Git commands")
|
||||
(* ;; "Git commands")
|
||||
|
||||
(FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS?
|
||||
GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY
|
||||
GIT-FETCH)
|
||||
|
||||
(* ;; "Differences")
|
||||
(* ;; "Differences")
|
||||
|
||||
(FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Branches")
|
||||
(* ;; "Branches")
|
||||
|
||||
(FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES
|
||||
GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-BRANCH-WHENSELECTEDFN
|
||||
GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
|
||||
|
||||
(* ;; "My branches")
|
||||
(* ;; "My branches")
|
||||
|
||||
(FNS GIT-MY-CURRENT-BRANCH GIT-MY-BRANCHP GIT-MY-NEXT-BRANCH GIT-MY-BRANCHES)
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Worktrees")
|
||||
(* ;; "Worktrees")
|
||||
|
||||
(FNS GIT-ADD-WORKTREE GIT-REMOVE-WORKTREE GIT-LIST-WORKTREES WORKTREEDIR)
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Comparisons")
|
||||
(* ;; "Comparisons")
|
||||
|
||||
(FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES
|
||||
GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN
|
||||
GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE)
|
||||
(INITVARS (FROMGITN 0))
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Utilities")
|
||||
(* ;; "Utilities")
|
||||
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES
|
||||
STRIPLOCAL)
|
||||
(PROPS (GITFNS FILETYPE))))
|
||||
(PROPS (GITFNS FILETYPE))))
|
||||
|
||||
|
||||
|
||||
(* ;; "Set up")
|
||||
(* ;; "Set up")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD FROM LISPUSERS)
|
||||
(FILESLOAD (SYSLOAD FROM LISPUSERS)
|
||||
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "GIT projects")
|
||||
(* ;; "GIT projects")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -401,15 +402,15 @@
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
|
||||
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
|
||||
|
||||
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
|
||||
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
|
||||
(RPAQ? GIT-DEFAULT-PROJECTS
|
||||
(RPAQ? GIT-DEFAULT-PROJECTS
|
||||
'((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
|
||||
(greetfiles scripts sources library lispusers internal doctools rooms))
|
||||
(NOTECARDS)
|
||||
@@ -417,120 +418,120 @@
|
||||
(TEST)
|
||||
(MAIKO)))
|
||||
|
||||
(RPAQ? GIT-PROJECTS NIL)
|
||||
(RPAQ? GIT-PROJECTS NIL)
|
||||
|
||||
(RPAQ? GIT-PRC-MENUS NIL)
|
||||
(RPAQ? GIT-PRC-MENUS NIL)
|
||||
|
||||
(GIT-INIT)
|
||||
(GIT-INIT)
|
||||
|
||||
(ADDTOVAR AROUNDEXITFNS GIT-INIT)
|
||||
(ADDTOVAR AROUNDEXITFNS GIT-INIT)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Lisp exec commands")
|
||||
(* ;; "Lisp exec commands")
|
||||
|
||||
|
||||
(RPAQ? GIT-MERGE-COMPARES T)
|
||||
(RPAQ? GIT-MERGE-COMPARES T)
|
||||
|
||||
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
||||
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
||||
|
||||
(DEFCOMMAND gwc (SUBDIR . OTHERS)
|
||||
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project")
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project")
|
||||
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
PROJECT)
|
||||
(SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL)
|
||||
(SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL)
|
||||
NIL T)
|
||||
THEN (SETQ PROJECT (CAR STAIL))
|
||||
(GO $$OUT))
|
||||
(CAR STAIL)))
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
|
||||
THEN (SETQ PROJECT (CAR STAIL))
|
||||
(GO $$OUT))
|
||||
(CAR STAIL)))
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
|
||||
|
||||
(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
|
||||
|
||||
(* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
|
||||
(* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
|
||||
((NIL T)
|
||||
(GIT-MY-CURRENT-BRANCH PROJECT))
|
||||
(GIT-MY-CURRENT-BRANCH PROJECT))
|
||||
((LOCAL REMOTE ORIGIN)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
|
||||
(OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
|
||||
(OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
|
||||
BRANCH1)))
|
||||
(SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
|
||||
(SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
|
||||
((NIL T)
|
||||
(GIT-MAINBRANCH PROJECT LOCAL))
|
||||
(GIT-MAINBRANCH PROJECT LOCAL))
|
||||
((LOCAL REMOTE ORIGIN)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
|
||||
(OR (GIT-LONG-NAME BRANCH2 NIL PROJECT)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
|
||||
(OR (GIT-LONG-NAME BRANCH2 NIL PROJECT)
|
||||
BRANCH2)))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
|
||||
LOCAL PROJECT))
|
||||
|
||||
(DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT)
|
||||
|
||||
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
|
||||
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
|
||||
|
||||
(PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
|
||||
(PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
|
||||
|
||||
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
|
||||
|
||||
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name. Default is to bring up a menu of locally available branches.")
|
||||
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name. Default is to bring up a menu of locally available branches.")
|
||||
|
||||
(CL:UNLESS (STRINGP NEXTTITLESTRING)
|
||||
(SETQ PROJECT NEXTTITLESTRING))
|
||||
(CL:UNLESS (STRINGP NEXTTITLESTRING)
|
||||
(SETQ PROJECT NEXTTITLESTRING))
|
||||
(CL:UNLESS PROJECT
|
||||
(CL:WHEN (GIT-GET-PROJECT BRANCH NIL T)
|
||||
(SETQ PROJECT BRANCH)
|
||||
(SETQ BRANCH NIL)))
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SELECTQ (U-CASE BRANCH)
|
||||
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
|
||||
(CL:WHEN (GIT-GET-PROJECT BRANCH NIL T)
|
||||
(SETQ PROJECT BRANCH)
|
||||
(SETQ BRANCH NIL)))
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SELECTQ (U-CASE BRANCH)
|
||||
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
|
||||
PROJECT))
|
||||
((NEW NEXT)
|
||||
(GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT))
|
||||
(CL:WHEN [SETQ BRANCH (IF BRANCH
|
||||
THEN (GIT-LONG-NAME BRANCH NIL PROJECT)
|
||||
ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
|
||||
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
(GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT))
|
||||
(CL:WHEN [SETQ BRANCH (IF BRANCH
|
||||
THEN (GIT-LONG-NAME BRANCH NIL PROJECT)
|
||||
ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
|
||||
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
T)
|
||||
" branches"]
|
||||
(GIT-CHECKOUT BRANCH PROJECT))))
|
||||
(GIT-CHECKOUT BRANCH PROJECT))))
|
||||
|
||||
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-FETCH PROJECT)
|
||||
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-FETCH PROJECT)
|
||||
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
T)
|
||||
" "
|
||||
(GIT-WHICH-BRANCH PROJECT)))
|
||||
(GIT-WHICH-BRANCH PROJECT)))
|
||||
|
||||
(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
|
||||
(SETQ SUBDIR PROJECT)
|
||||
(SETQ PROJECT GIT-DEFAULT-PROJECT))
|
||||
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
|
||||
(CHARCODE (> /]
|
||||
(SETQ SUBDIR (CONCAT SUBDIR "/")))
|
||||
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST)
|
||||
(OR SUBDIR "")))
|
||||
(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
|
||||
(SETQ SUBDIR PROJECT)
|
||||
(SETQ PROJECT GIT-DEFAULT-PROJECT))
|
||||
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
|
||||
(CHARCODE (> /]
|
||||
(SETQ SUBDIR (CONCAT SUBDIR "/")))
|
||||
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST)
|
||||
(OR SUBDIR "")))
|
||||
T))
|
||||
|
||||
(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
|
||||
(SETQ SUBDIR PROJECT)
|
||||
(SETQ PROJECT GIT-DEFAULT-PROJECT))
|
||||
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
|
||||
(CHARCODE (> /]
|
||||
(SETQ SUBDIR (CONCAT SUBDIR "/")))
|
||||
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
|
||||
(OR SUBDIR "")))
|
||||
(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
|
||||
(SETQ SUBDIR PROJECT)
|
||||
(SETQ PROJECT GIT-DEFAULT-PROJECT))
|
||||
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
|
||||
(CHARCODE (> /]
|
||||
(SETQ SUBDIR (CONCAT SUBDIR "/")))
|
||||
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
|
||||
(OR SUBDIR "")))
|
||||
T))
|
||||
(DEFINEQ
|
||||
|
||||
@@ -616,12 +617,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "File correspondents")
|
||||
(* ;; "File correspondents")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -864,12 +865,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Git commands")
|
||||
(* ;; "Git commands")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -922,12 +923,12 @@
|
||||
(GIT-GET-FILE
|
||||
[LAMBDA (BRANCH GITFILE LOCALFILE NOERROR PROJECT)
|
||||
|
||||
(* ;; "Edited 31-Mar-2025 21:24 by rmk")
|
||||
|
||||
(* ;; "Edited 2-May-2024 12:08 by mth")
|
||||
|
||||
(* ;; "Edited 18-Jul-2022 09:18 by rmk")
|
||||
|
||||
(* ;; "Edited 8-Jul-2022 10:36 by rmk")
|
||||
|
||||
(* ;; "Edited 5-Jul-2022 00:09 by rmk: Redirect show command to tmp/ rename to localfile")
|
||||
|
||||
(* ;; "Edited 30-Jun-2022 22:09 by rmk")
|
||||
@@ -936,8 +937,6 @@
|
||||
|
||||
(* ;; "Edited 8-May-2022 16:54 by rmk: the stream, not the name because of the NODIRCORE case.")
|
||||
|
||||
(* ;; "Edited 6-Mar-2022 17:45 by rmk: the stream, not the name because of the NODIRCORE case.")
|
||||
|
||||
(* ;; "Returns the stream, not the name because of the NODIRCORE case.")
|
||||
|
||||
(* ;; "If GITFILE in (remote) BRANCH exists, it is copied to LOCALFILE and LOCALFILE is returned. If it doesn't exist, return value is NIL if NOERROR, otherwise an ERROR.")
|
||||
@@ -1075,7 +1074,7 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "Differences")
|
||||
(* ;; "Differences")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1263,12 +1262,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Branches")
|
||||
(* ;; "Branches")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1431,7 +1430,8 @@
|
||||
WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
|
||||
|
||||
(GIT-BRANCH-WHENSELECTEDFN
|
||||
[LAMBDA (ITEM) (* ; "Edited 11-May-2024 11:05 by rmk")
|
||||
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 21-Mar-2025 19:07 by rmk")
|
||||
(* ; "Edited 11-May-2024 11:05 by rmk")
|
||||
(* ; "Edited 1-May-2024 18:17 by rmk")
|
||||
(* ; "CAR is git key, 4th is project")
|
||||
|
||||
@@ -1450,10 +1450,13 @@
|
||||
|
||||
(* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")
|
||||
|
||||
(BKSYSBUF '%()
|
||||
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
|
||||
',(fetch PRPROJECT of PR]
|
||||
(BKSYSBUF '%))
|
||||
(if (EQ BUTTON 'MIDDLE)
|
||||
then (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/"
|
||||
(fetch (PULLREQUEST PRNUMBER) of PR)))
|
||||
else (BKSYSBUF '%()
|
||||
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
|
||||
',(fetch PRPROJECT of PR]
|
||||
(BKSYSBUF '%)))
|
||||
else
|
||||
(* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")
|
||||
|
||||
@@ -1572,7 +1575,7 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "My branches")
|
||||
(* ;; "My branches")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1639,12 +1642,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Worktrees")
|
||||
(* ;; "Worktrees")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1715,12 +1718,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Comparisons")
|
||||
(* ;; "Comparisons")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1932,98 +1935,100 @@
|
||||
else '(0 differences))
|
||||
else '(0 differences])
|
||||
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 12-Jun-2024 22:52 by mth")
|
||||
(* ;; "Edited 29-Apr-2025 15:14 by rmk")
|
||||
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
(* ;; "Edited 12-Jun-2024 22:52 by mth")
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
|
||||
(* ;; "Edited 10-May-2022 10:41 by rmk")
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
|
||||
(* ;; "Edited 10-May-2022 10:41 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
|
||||
"Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.")
|
||||
(CL:UNLESS (AND (fetch GITHOST of PROJECT)
|
||||
(fetch WHOST of PROJECT))
|
||||
(ERROR (fetch PROJECTNAME of PROJECT)
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.")
|
||||
(CL:UNLESS (AND (fetch GITHOST of PROJECT)
|
||||
(fetch WHOST of PROJECT))
|
||||
(ERROR (fetch PROJECTNAME of PROJECT)
|
||||
" does not have both git and working directories"))
|
||||
(CL:WHEN (AND (LISTP SUBDIRS)
|
||||
(NULL (CDR SUBDIRS)))
|
||||
(SETQ SUBDIRS (CAR SUBDIRS)))
|
||||
(CL:WHEN (AND (LISTP SUBDIRS)
|
||||
(NULL (CDR SUBDIRS)))
|
||||
(SETQ SUBDIRS (CAR SUBDIRS)))
|
||||
(CL:UNLESS SUBDIRS
|
||||
(SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT)
|
||||
(SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT)
|
||||
'ALL)))
|
||||
(SETQ SUBDIRS (L-CASE SUBDIRS))
|
||||
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
(SETQ SUBDIRS (L-CASE SUBDIRS))
|
||||
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
"ALL subdirectories"
|
||||
else SUBDIRS)))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
else SUBDIRS)))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
T)))
|
||||
(NENTRIES _ 0)
|
||||
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
NIL
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
'(*.* *>*.* .* *>.*)
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
'DIRECTORY)
|
||||
1 NIL T T FILEDIRCASEARRAY))
|
||||
(CL:IF DPOS
|
||||
(SUBSTRING E (ADD1 DPOS))
|
||||
(SUBSTRING E (ADD1 DPOS))
|
||||
E))
|
||||
NIL NIL NIL FIXDIRECTORYDATES))
|
||||
[for CDE in (fetch CDENTRIES of CDVAL)
|
||||
do (CL:WHEN (fetch INFO1 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE))
|
||||
(UNSLASHIT DATUM T)))
|
||||
(CL:WHEN (fetch INFO2 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE))
|
||||
(SLASHIT DATUM T)))]
|
||||
[for CDE in (fetch CDENTRIES of CDVAL)
|
||||
do (CL:WHEN (fetch INFO1 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE))
|
||||
(UNSLASHIT DATUM T)))
|
||||
(CL:WHEN (fetch INFO2 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE))
|
||||
(SLASHIT DATUM T)))]
|
||||
CDVAL
|
||||
finally
|
||||
finally
|
||||
|
||||
(* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")
|
||||
(* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")
|
||||
|
||||
(CL:WHEN (AND (CDR $$VAL)
|
||||
(CL:WHEN (AND (CDR $$VAL)
|
||||
GIT-MERGE-COMPARES)
|
||||
(SETQ $$VAL (CDMERGE $$VAL))
|
||||
[SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "])
|
||||
[for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS
|
||||
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
||||
(SETQ $$VAL (CDMERGE $$VAL))
|
||||
[SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "])
|
||||
[for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS
|
||||
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
||||
" files"))
|
||||
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
|
||||
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
|
||||
`(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
|
||||
GIT-CD-LABELFN PROJECT ,PROJECT)
|
||||
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
||||
`(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
|
||||
,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
|
||||
,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
|
||||
'("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
|
||||
(CONS (CONCAT SUBDIR "/")
|
||||
(for CDENTRY in (fetch CDENTRIES of CDVAL)
|
||||
collect (fetch MATCHNAME of CDENTRY)))
|
||||
(add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL]
|
||||
(SETQ LAST-WMEDLEY-CDVALUES $$VAL)
|
||||
(TERPRI T)
|
||||
(RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
|
||||
(CONS (CONCAT SUBDIR "/")
|
||||
(for CDENTRY in (fetch CDENTRIES of CDVAL)
|
||||
collect (fetch MATCHNAME of CDENTRY)))
|
||||
(add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL]
|
||||
(SETQ LAST-WMEDLEY-CDVALUES $$VAL)
|
||||
(TERPRI T)
|
||||
(RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
|
||||
'difference
|
||||
'differences)])
|
||||
|
||||
@@ -2268,16 +2273,16 @@
|
||||
RB NIL PROJECT])
|
||||
)
|
||||
|
||||
(RPAQ? FROMGITN 0)
|
||||
(RPAQ? FROMGITN 0)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Utilities")
|
||||
(* ;; "Utilities")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2400,11 +2405,13 @@
|
||||
NIL])
|
||||
|
||||
(GIT-RESULT-TO-LINES
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 31-Mar-2025 15:19 by rmk")
|
||||
(* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
|
||||
(* ;; "Suppress .git lines unless ALL")
|
||||
(* ;; "Suppress .git lines unless ALL SYSTEM-EXTERNALFORMAT may make the wrong guess, but at least we ensure here that lines get broken.")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT))
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (LIST (SYSTEM-EXTERNALFORMAT)
|
||||
'ANY))
|
||||
(bind LINE until (EOFP STREAM) when [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P
|
||||
NIL :EOF-VALUE NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1]
|
||||
@@ -2423,35 +2430,35 @@
|
||||
STRING])
|
||||
)
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(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 (4225 20804 (GIT-CLONEP 4235 . 5563) (GIT-INIT 5565 . 6195) (GIT-MAKE-PROJECT 6197 .
|
||||
13862) (GIT-GET-PROJECT 13864 . 15789) (GIT-PUT-PROJECT-FIELD 15791 . 17432) (GIT-PROJECT-PATH 17434
|
||||
. 18478) (FIND-ANCESTOR-DIRECTORY 18480 . 18829) (GIT-FIND-CLONE 18831 . 19912) (GIT-MAINBRANCH 19914
|
||||
. 20309) (GIT-MAINBRANCH? 20311 . 20802)) (26471 31400 (PRC-COMMAND 26481 . 31398)) (31448 34236 (
|
||||
ALLSUBDIRS 31458 . 32744) (MEDLEYSUBDIRS 32746 . 33439) (GITSUBDIRS 33441 . 34234)) (34237 39027 (
|
||||
TOGIT 34247 . 35653) (FROMGIT 35655 . 36636) (GIT-DELETE-FILE 36638 . 37484) (MYMEDLEY-DELETE-FILES
|
||||
37486 . 39025)) (39028 42031 (MYMEDLEYSUBDIR 39038 . 39494) (GITSUBDIR 39496 . 39939) (STRIPDIR 39941
|
||||
. 40312) (STRIPHOST 40314 . 40554) (STRIPNAME 40556 . 41309) (STRIPWHERE 41311 . 42029)) (42032 43934
|
||||
(GFILE4MFILE 42042 . 42405) (MFILE4GFILE 42407 . 42976) (GIT-REPO-FILENAME 42978 . 43932)) (43975
|
||||
54230 (GIT-COMMIT 43985 . 44811) (GIT-PUSH 44813 . 45573) (GIT-PULL 45575 . 46327) (GIT-APPROVAL 46329
|
||||
. 46678) (GIT-GET-FILE 46680 . 48595) (GIT-FILE-EXISTS? 48597 . 48871) (GIT-REMOTE-UPDATE 48873 .
|
||||
49708) (GIT-REMOTE-ADD 49710 . 50017) (GIT-FILE-DATE 50019 . 51066) (GIT-FILE-HISTORY 51068 . 53002) (
|
||||
GIT-PRINT-FILE-HISTORY 53004 . 54054) (GIT-FETCH 54056 . 54228)) (54256 65376 (GIT-BRANCH-DIFF 54266
|
||||
. 61013) (GIT-COMMIT-DIFFS 61015 . 61688) (GIT-BRANCH-RELATIONS 61690 . 65374)) (65413 84799 (
|
||||
GIT-BRANCH-NUM 65423 . 65996) (GIT-CHECKOUT 65998 . 67284) (GIT-WHICH-BRANCH 67286 . 67693) (
|
||||
GIT-MAKE-BRANCH 67695 . 70274) (GIT-BRANCHES 70276 . 72871) (GIT-BRANCH-EXISTS? 72873 . 73744) (
|
||||
GIT-PICK-BRANCH 73746 . 74236) (GIT-BRANCH-MENU 74238 . 75119) (GIT-BRANCH-WHENSELECTEDFN 75121 .
|
||||
77660) (GIT-PULL-REQUESTS 77662 . 81180) (GIT-SHORT-BRANCH-NAME 81182 . 81473) (GIT-LONG-NAME 81475 .
|
||||
81792) (GIT-PRC-BRANCHES 81794 . 84797)) (84825 88273 (GIT-MY-CURRENT-BRANCH 84835 . 85205) (
|
||||
GIT-MY-BRANCHP 85207 . 85825) (GIT-MY-NEXT-BRANCH 85827 . 86321) (GIT-MY-BRANCHES 86323 . 88271)) (
|
||||
88311 92386 (GIT-ADD-WORKTREE 88321 . 89928) (GIT-REMOVE-WORKTREE 89930 . 90860) (GIT-LIST-WORKTREES
|
||||
90862 . 91666) (WORKTREEDIR 91668 . 92384)) (92426 125819 (GIT-GET-DIFFERENT-FILES 92436 . 98860) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98862 . 106093) (GIT-WORKING-COMPARE-DIRECTORIES 106095 . 111802) (
|
||||
GIT-COMPARE-WORKTREE 111804 . 115782) (GITCDOBJBUTTONFN 115784 . 120274) (GIT-CD-LABELFN 120276 .
|
||||
121358) (GIT-CD-MENUFN 121360 . 123800) (GIT-WORKING-COMPARE-FILES 123802 . 124422) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124424 . 125588) (GIT-PR-COMPARE 125590 . 125817)) (125881 134204 (CDGITDIR
|
||||
125891 . 126578) (GIT-COMMAND 126580 . 128138) (GITORIGIN 128140 . 128837) (GIT-INITIALS 128839 .
|
||||
129143) (GIT-COMMAND-TO-FILE 129145 . 132630) (GIT-RESULT-TO-LINES 132632 . 133537) (STRIPLOCAL 133539
|
||||
. 134202)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
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