Compare commits
94 Commits
medley-241
...
medley-250
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
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 | ||
|
|
ae52a44231 | ||
|
|
fbf0a98aec | ||
|
|
87d3abc632 | ||
|
|
1f317d34ef | ||
|
|
86f5aadf95 | ||
|
|
fc36176134 | ||
|
|
1e47741a71 | ||
|
|
40d18fff6e | ||
|
|
8323b1fae4 | ||
|
|
16e99100f5 | ||
|
|
db9d879920 | ||
|
|
907010013e | ||
|
|
0bc84f97f0 | ||
|
|
db98ea346b | ||
|
|
402a861b95 | ||
|
|
6c3f0d8e56 | ||
|
|
6c86838d18 | ||
|
|
d9090011d4 | ||
|
|
40d2ac394c | ||
|
|
4873590e22 | ||
|
|
188895c7e9 | ||
|
|
292a7cd787 | ||
|
|
a1a67959d1 | ||
|
|
015868e9a6 | ||
|
|
9f980276bf | ||
|
|
ef6a645bf5 | ||
|
|
90c723a8c1 | ||
|
|
20ec5c2bc9 | ||
|
|
ba3a5668bd | ||
|
|
d737f7ec93 | ||
|
|
9e6eba2cd9 | ||
|
|
27473e8cae | ||
|
|
27d8bffaa9 | ||
|
|
58122db362 | ||
|
|
5eb8a7bd34 | ||
|
|
4e11554156 | ||
|
|
0cc21cd46a | ||
|
|
936337d6bb | ||
|
|
6bdcb1853d | ||
|
|
fb7bb25201 | ||
|
|
5b37dd09db | ||
|
|
33a53e47e1 | ||
|
|
db33a50af3 | ||
|
|
f896885720 | ||
|
|
b46583557a | ||
|
|
1d15f37fdc | ||
|
|
e1c594b28c | ||
|
|
abdb128636 | ||
|
|
a26d061843 | ||
|
|
b51be87524 | ||
|
|
4b7a6daacd | ||
|
|
c4c0b65616 | ||
|
|
0dfac33a25 | ||
|
|
e5d4e0d299 | ||
|
|
a365e42a92 | ||
|
|
024e83d17e | ||
|
|
7a32bd3051 | ||
|
|
5fef8528ab | ||
|
|
0b3bc9ac48 | ||
|
|
93ee6a1fbf | ||
|
|
7ed120ca97 |
11
.github/ISSUE_TEMPLATE/bug_report.md
vendored
11
.github/ISSUE_TEMPLATE/bug_report.md
vendored
@@ -3,6 +3,7 @@ name: Bug report (not specific)
|
||||
about: Create a report to help us improve
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
@@ -22,11 +23,13 @@ A clear and concise description of what you expected to happen.
|
||||
If applicable, add screenshots to help explain your problem.
|
||||
|
||||
**Context (please complete the following information):**
|
||||
- OS: [e.g. Mac/Linux/Cygwin]
|
||||
- OS Version: [e.g. High Siera/Ubuntu 18/Raspbian]
|
||||
- Host arch: [e.g. x86_64, arm7l, arm64, sparc]
|
||||
- Are you using online.interlisp.org? [yes / no]
|
||||
- OS: [e.g. macOS/Linux/Cygwin]
|
||||
- OS Version: [e.g. Ventura, Ubuntu 24, Raspberry Pi OS]
|
||||
- Display/window system: [e.g. X11, SDL, VNC, Web browser]
|
||||
- Host arch: [e.g. x86_64, arm7l, arm64, SPARC]
|
||||
- Maiko version: [e.g. commit ID from `git log | head`]
|
||||
- IL:MAKESYSDATE: [ date ]
|
||||
- `IL:MAKESYSDATE`: [ date ] or `(il:print-lisp-information)`: copy-paste or screenshot this
|
||||
|
||||
**Additional context**
|
||||
Add any other context about the problem here.
|
||||
|
||||
1
.github/ISSUE_TEMPLATE/documentation.md
vendored
1
.github/ISSUE_TEMPLATE/documentation.md
vendored
@@ -3,6 +3,7 @@ name: Documentation problem
|
||||
about: Problems with this web site?
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
|
||||
1
.github/ISSUE_TEMPLATE/feature_request.md
vendored
1
.github/ISSUE_TEMPLATE/feature_request.md
vendored
@@ -3,6 +3,7 @@ name: Feature request
|
||||
about: Suggest an idea for this project
|
||||
title: ''
|
||||
labels: ''
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
|
||||
12
.github/workflows/buildDocker.yml
vendored
12
.github/workflows/buildDocker.yml
vendored
@@ -70,7 +70,7 @@ jobs:
|
||||
# based on the latest commit to the repo
|
||||
|
||||
sentry:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
release_not_built: ${{ steps.check.outputs.release_not_built }}
|
||||
|
||||
@@ -99,7 +99,7 @@ jobs:
|
||||
|
||||
build_and-push:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
needs: [sentry]
|
||||
if: |
|
||||
@@ -154,7 +154,8 @@ jobs:
|
||||
if [ "${{ inputs.draft }}" = "false" ];
|
||||
then
|
||||
docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
|
||||
platforms="linux/amd64,linux/arm64"
|
||||
platforms="linux/amd64"
|
||||
#,linux/arm64
|
||||
else
|
||||
docker_tags="${docker_image}:draft"
|
||||
platforms="linux/amd64"
|
||||
@@ -171,7 +172,8 @@ jobs:
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@v3
|
||||
with:
|
||||
platforms: linux/amd64,linux/arm64,linux/arm/v7
|
||||
platforms: linux/amd64
|
||||
# ,linux/arm64,linux/arm/v7
|
||||
|
||||
# Setup the Docker Buildx funtion
|
||||
- name: Set up Docker Buildx
|
||||
@@ -211,7 +213,7 @@ jobs:
|
||||
|
||||
complete:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
outputs:
|
||||
build_successful: ${{ steps.output.outputs.build_successful }}
|
||||
|
||||
12
.github/workflows/buildLoadup.yml
vendored
12
.github/workflows/buildLoadup.yml
vendored
@@ -66,7 +66,7 @@ jobs:
|
||||
# based on the latest commit to the repo
|
||||
|
||||
sentry:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
release_not_built: ${{ steps.check.outputs.release_not_built }}
|
||||
|
||||
@@ -96,7 +96,7 @@ jobs:
|
||||
|
||||
loadup:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
outputs:
|
||||
combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
|
||||
@@ -257,7 +257,7 @@ jobs:
|
||||
#
|
||||
linux_installer:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
needs: [sentry, loadup]
|
||||
if: |
|
||||
@@ -333,7 +333,7 @@ jobs:
|
||||
#
|
||||
macos_installer:
|
||||
|
||||
runs-on: macos-12
|
||||
runs-on: macos-14
|
||||
|
||||
needs: [sentry, loadup]
|
||||
if: |
|
||||
@@ -507,7 +507,7 @@ jobs:
|
||||
|
||||
downloads_page:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
needs: [sentry, loadup, linux_installer, macos_installer, cygwin_installer]
|
||||
if: |
|
||||
@@ -606,7 +606,7 @@ jobs:
|
||||
|
||||
complete:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
outputs:
|
||||
build_successful: ${{ steps.output.outputs.build_successful }}
|
||||
|
||||
6
.github/workflows/buildReleaseInclDocker.yml
vendored
6
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -69,7 +69,7 @@ jobs:
|
||||
# the result of a workflow_dispatch or a workflow_call
|
||||
|
||||
inputs:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
outputs:
|
||||
draft: ${{ steps.one.outputs.draft }}
|
||||
force: ${{ steps.one.outputs.force }}
|
||||
@@ -124,14 +124,14 @@ jobs:
|
||||
|
||||
# Kickoff workflow in online repo to build and deploy Medley docker image to oio
|
||||
do_oio:
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
needs: [inputs, do_docker]
|
||||
steps:
|
||||
- name: trigger-oio-buildAndDeploy
|
||||
run: |
|
||||
if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
|
||||
then
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref main
|
||||
fi
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}
|
||||
|
||||
2
.github/workflows/doHCFILES.yml
vendored
2
.github/workflows/doHCFILES.yml
vendored
@@ -45,7 +45,7 @@ jobs:
|
||||
|
||||
run_HCFILES:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
runs-on: ubuntu-24.04
|
||||
|
||||
steps:
|
||||
|
||||
|
||||
4
.gitignore
vendored
4
.gitignore
vendored
@@ -37,6 +37,10 @@ loadups/fuller.database
|
||||
|
||||
*.IMPTR
|
||||
|
||||
# (Accidentally) created sysouts at any level
|
||||
*.sysout
|
||||
*.SYSOUT
|
||||
|
||||
#compiled code -- leave in for now
|
||||
|
||||
# *.lcom
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,6 +1,6 @@
|
||||
MIT License
|
||||
|
||||
Copyright Interlisp.org contributors
|
||||
Copyright © 2024 Interlisp.org. Portions originally copyrighted by Xerox, Venue, John Sybalsky, and other contributors.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
|
||||
@@ -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
installers/cygwin/.gitignore
vendored
1
installers/cygwin/.gitignore
vendored
@@ -4,3 +4,4 @@ maiko*.tgz
|
||||
setup-x86_64.exe
|
||||
medley.bat
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,6 @@
|
||||
;#
|
||||
;###############################################################################
|
||||
|
||||
#define x86_or_x64 "x64"
|
||||
#if GetEnv('COMBINED_RELEASE_TAG') != ""
|
||||
#define VERSION=GetEnv('COMBINED_RELEASE_TAG')
|
||||
#else
|
||||
@@ -24,20 +23,17 @@
|
||||
|
||||
[Setup]
|
||||
PrivilegesRequired=lowest
|
||||
ArchitecturesAllowed={#x86_or_x64}
|
||||
ArchitecturesAllowed=x64compatible
|
||||
ArchitecturesInstallIn64BitMode=x64compatible
|
||||
AppName=Medley
|
||||
AppVersion={#version}
|
||||
AppPublisher=Interlisp.org
|
||||
AppPublisherURL=https://interlisp.org/
|
||||
AppCopyright=Copyright (C) 2023 Interlisp.org
|
||||
DefaultDirName={%USERPROFILE}\il
|
||||
AppCopyright=Copyright (C) 2023-2024 Interlisp.org
|
||||
DefaultDirName="{%USERPROFILE}\il"
|
||||
DefaultGroupName=Medley
|
||||
Compression=lzma2
|
||||
SolidCompression=yes
|
||||
; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
|
||||
; done in "64-bit mode" on x64, meaning it should use the native
|
||||
; 64-bit Program Files directory and the 64-bit view of the registry.
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
OutputDir="."
|
||||
OutputBaseFilename={#OUTFILE}
|
||||
SetupIconFile="Medley.ico"
|
||||
@@ -48,7 +44,7 @@ WizardImageFile=medley_logo.bmp
|
||||
WizardSmallImageFile=medley_logo_small.bmp
|
||||
WizardImageStretch=no
|
||||
UninstallDisplayIcon="{app}\Medley.ico"
|
||||
UninstallFilesDir={app}\uninstall
|
||||
UninstallFilesDir="{app}\uninstall"
|
||||
UsePreviousAppDir=no
|
||||
|
||||
[Dirs]
|
||||
@@ -68,18 +64,21 @@ Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
|
||||
; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
|
||||
|
||||
[Run]
|
||||
Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
|
||||
Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root ""{app}"" --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir ""{app}\cygwin"" --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
|
||||
Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden
|
||||
Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\medley.tgz"; Flags: runhidden; StatusMsg: "Installing Medley ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -force -recurse {app}\maiko"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\maiko-cygwin.x86_64.tgz"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\medley.tgz"""; Flags: runhidden; StatusMsg: "Installing Medley ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -force -recurse ""{app}\maiko"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\maiko-cygwin.x86_64.tgz"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
; Recreate medley symbolic links (lost in tars)
|
||||
Filename: "{app}\bin\bash"; Parameters: "-login -c 'cd /medley/scripts/medley && ln -s medley.command medley.sh && cd ../.. && ln -s /medley/scripts/medley/medley.sh medley'"; Flags: runhidden
|
||||
; Create medley.bat
|
||||
Filename: "powershell"; Parameters: "write-output \""{app}\bin\bash -login -c '/medley/scripts/medley/medley.sh %*'\"" | out-file medley.bat -Encoding ascii"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden; StatusMsg: "Adding to PATH ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -recurse -force {app}\install"; Flags: runhidden; StatusMsg: "Cleaning up ..."
|
||||
Filename: "powershell"; Parameters: "write-output '""""""""{app}\bin\bash"""""""" -login -c """"""""/medley/scripts/medley/medley.sh %*""""""""' | out-file medley.bat -Encoding ascii -NoNewline"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add ""{app}"""; Flags: runhidden; StatusMsg: "Adding to PATH ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -recurse -force """"""""{app}\install"""""""""; Flags: runhidden; StatusMsg: "Cleaning up ..."
|
||||
|
||||
[UninstallDelete]
|
||||
Type: filesandordirs; Name: "{app}"
|
||||
|
||||
[UninstallRun]
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove ""{app}"""; Flags: runhidden
|
||||
|
||||
|
||||
9
installers/cygwin/prep-for-local-testing.ps1
Normal file
9
installers/cygwin/prep-for-local-testing.ps1
Normal file
@@ -0,0 +1,9 @@
|
||||
#
|
||||
# Prep the installer/cygwin directory to locally test the medley.iss installer
|
||||
# Normally these downloads are done by the github workflow
|
||||
#
|
||||
# fgh 2024-11-15
|
||||
#
|
||||
wget https://cygwin.com/setup-x86_64.exe -OutFile setup-x86_64.exe
|
||||
gh release download --repo interlisp/maiko --pattern *-cygwin.x86_64.tgz --output maiko-cygwin.x86_64.tgz --clobber
|
||||
gh release download --repo interlisp/medley --pattern medley-full-linux-x86_64-*.tgz --output medley.tgz --clobber
|
||||
2498
internal/TEDIT-DEBUG
Normal file
2498
internal/TEDIT-DEBUG
Normal file
File diff suppressed because it is too large
Load Diff
BIN
internal/TEDIT-DEBUG.LCOM
Normal file
BIN
internal/TEDIT-DEBUG.LCOM
Normal file
Binary file not shown.
312
library/IMAGEOBJ
312
library/IMAGEOBJ
@@ -1,137 +1,69 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Dec-95 13:21:56" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1 35602
|
||||
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4 34381
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
|
||||
|
||||
changes to%: (FNS BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN)
|
||||
|
||||
|
||||
|
||||
previous date%: " 6-Dec-95 15:18:32" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ; "
|
||||
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
")
|
||||
|
||||
:PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMAGEOBJCOMS)
|
||||
|
||||
|
||||
|
||||
(RPAQQ IMAGEOBJCOMS
|
||||
|
||||
((COMS
|
||||
|
||||
(* ;; "Bit-map image objects")
|
||||
|
||||
|
||||
(* ;; "Bit-map image objects")
|
||||
|
||||
(FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "fns for the bitmap tedit object.")
|
||||
|
||||
|
||||
(* ;; "fns for the bitmap tedit object.")
|
||||
|
||||
(FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN BMOBJ.PUTFN
|
||||
|
||||
BMOBJ.INIT BMOBJ.GETFN5 BMOBJ.CREATE.MENU)
|
||||
|
||||
(INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700))
|
||||
|
||||
(*SMALLSCREENFACTOR* 0.5))
|
||||
|
||||
(FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2 BMOBJ.GETFN3 BMOBJ.GETFN4)
|
||||
|
||||
(* ;
|
||||
|
||||
"GETFNs for backward compatibility with older objects.")
|
||||
|
||||
(* ;
|
||||
"GETFNs for backward compatibility with older objects.")
|
||||
(RECORDS BITMAPOBJ)
|
||||
|
||||
[INITVARS (DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1]
|
||||
|
||||
|
||||
|
||||
(* ;; "make ^O be a character that inserts an object read from the user.")
|
||||
|
||||
|
||||
(* ;; "make ^O be a character that inserts an object read from the user.")
|
||||
|
||||
(GLOBALVARS (BITMAP.OBJ.MENU))
|
||||
|
||||
(ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
|
||||
|
||||
|
||||
|
||||
"prompts for an area of the screen to insert."
|
||||
|
||||
)
|
||||
|
||||
("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
|
||||
|
||||
|
||||
|
||||
"prompts for an area of the screen to insert, scaled down by 50%%."
|
||||
|
||||
)
|
||||
|
||||
("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
|
||||
|
||||
|
||||
|
||||
"prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50."
|
||||
|
||||
)
|
||||
|
||||
("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
|
||||
|
||||
"Inserts *INSERT-BITMAP* in a document"))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN2))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN3))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN4))
|
||||
|
||||
(IMAGEOBJGETFNS (BMOBJ.GETFN5))
|
||||
|
||||
(IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)))
|
||||
|
||||
(VARS (BackgroundCopyMenu))
|
||||
|
||||
(FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED)
|
||||
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT)))
|
||||
|
||||
(FILES EDITBITMAP))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Bit-map image objects")
|
||||
|
||||
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(BITMAPTEDITOBJ
|
||||
[LAMBDA (BITMAP SCALEFACTOR ROTATION DESCENT) (* ; "Edited 13-Aug-93 17:17 by rmk:")
|
||||
(* ; "Edited 6-Jan-89 16:34 by jds")
|
||||
@@ -146,8 +78,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
BMOBJDESCENT _ (OR DESCENT 0))
|
||||
BITMAPIMAGEFNS])
|
||||
|
||||
|
||||
|
||||
(COERCETOBITMAP
|
||||
[LAMBDA (BMSPEC) (* ; "Edited 11-Jun-90 16:28 by mitani")
|
||||
(* tries to interpret X as a spec
|
||||
@@ -182,16 +112,12 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(fetch (REGION HEIGHT) of CR))
|
||||
BM])
|
||||
|
||||
|
||||
|
||||
(WINDOWTITLEFONT
|
||||
(LAMBDA (FONT) (* rrb " 1-Feb-84 15:26")
|
||||
(* reset type of function that changes
|
||||
the title font)
|
||||
(DSPFONT FONT WindowTitleDisplayStream)))
|
||||
|
||||
|
||||
|
||||
(\PRINTBINARYBITMAP
|
||||
(LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16")
|
||||
|
||||
@@ -211,8 +137,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
BMH BYTESPERWORD))
|
||||
(RETURN BITMAP))))
|
||||
|
||||
|
||||
|
||||
(\READBINARYBITMAP
|
||||
(LAMBDA (STREAM) (* rrb "23-Jul-84 15:17")
|
||||
|
||||
@@ -229,23 +153,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
|
||||
BMH BYTESPERWORD))
|
||||
(RETURN BITMAP))))
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "fns for the bitmap tedit object.")
|
||||
|
||||
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(BMOBJ.BUTTONEVENTINFN
|
||||
[LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)
|
||||
(* ; "Edited 14-Aug-93 19:44 by rmk:")
|
||||
@@ -315,8 +230,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
"And clear any cached shrunk bitmaps so the display looks reasonable.")
|
||||
(RETURN 'CHANGED])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.COPYFN
|
||||
[LAMBDA (IMAGEOBJ) (* ; "Edited 13-Aug-93 17:13 by rmk:")
|
||||
(* ; "Edited 6-Jan-89 16:19 by jds")
|
||||
@@ -329,8 +242,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(FETCH (BITMAPOBJ BMOBJROTATION) OF BMOBJ)
|
||||
(FETCH (BITMAPOBJ BMOBJDESCENT) OF BMOBJ])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.DISPLAYFN
|
||||
|
||||
[LAMBDA (IMAGEOBJ IMAGE.STREAM) (* ; "Edited 7-Dec-95 13:20 by ")
|
||||
@@ -449,8 +360,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
|
||||
'REPLACE NIL NIL FACTOR])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.IMAGEBOXFN
|
||||
|
||||
[LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* ; "Edited 7-Dec-95 13:20 by ")
|
||||
@@ -537,8 +446,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
|
||||
XKERN _ 0])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.PUTFN
|
||||
[LAMBDA (BMOBJ STREAM) (* ; "Edited 13-Aug-93 15:41 by rmk:")
|
||||
(* ; "Edited 11-Jan-89 17:00 by jds")
|
||||
@@ -558,8 +465,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
STREAM FILERDTBL)
|
||||
(SPACES 1 STREAM])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.INIT
|
||||
[LAMBDA NIL (* ; "Edited 13-Aug-93 14:27 by rmk:")
|
||||
(* ; "Edited 11-Jan-89 17:01 by jds")
|
||||
@@ -581,8 +486,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN5
|
||||
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* ; "Edited 13-Aug-93 15:40 by rmk:")
|
||||
(* jds "30-Oct-85 11:29")
|
||||
@@ -592,8 +495,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(READ INPUT.STREAM FILERDTBL)
|
||||
(READ INPUT.STREAM FILERDTBL])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.CREATE.MENU
|
||||
[LAMBDA NIL (* ; "Edited 30-Jul-87 19:19 by jds")
|
||||
|
||||
@@ -628,21 +529,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
MENUOFFSET _ (create POSITION
|
||||
XCOORD _ -1
|
||||
YCOORD _ 0])
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(RPAQ? *SMALLSCREEN* (ILESSP SCREENWIDTH 700))
|
||||
|
||||
|
||||
|
||||
(RPAQ? *SMALLSCREENFACTOR* 0.5)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(SCALED.BITMAP.GETFN
|
||||
(LAMBDA (INPUT.STREAM TEXTSTREAM) (* jds "30-Oct-85 11:29")
|
||||
|
||||
@@ -654,8 +547,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ BITMAP (FQUOTIENT 1.0 FACTOR)
|
||||
0)))))
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN
|
||||
(LAMBDA (STREAM) (* rrb "17-Jul-84 11:46")
|
||||
|
||||
@@ -669,8 +560,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ BITMAP (CAR FIELDS)
|
||||
(CADR FIELDS)))))))
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN2
|
||||
(LAMBDA (STREAM) (* rrb "17-Jul-84 11:29")
|
||||
|
||||
@@ -683,8 +572,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
|
||||
SCALE ROT)))))
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN3
|
||||
[LAMBDA (STREAM) (* ; "Edited 11-Jan-89 17:03 by jds")
|
||||
|
||||
@@ -702,8 +589,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
|
||||
SCALE 0 DESC])
|
||||
|
||||
|
||||
|
||||
(BMOBJ.GETFN4
|
||||
[LAMBDA (STREAM) (* ; "Edited 6-Jan-89 16:33 by jds")
|
||||
|
||||
@@ -731,162 +616,91 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
|
||||
(BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
|
||||
SCALE ROT DESCENT])
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ; "GETFNs for backward compatibility with older objects.")
|
||||
|
||||
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
|
||||
|
||||
(RECORD BITMAPOBJ (
|
||||
(* ;; "Describes a bitmap imageobj")
|
||||
|
||||
(* ;; "Describes a bitmap imageobj")
|
||||
|
||||
|
||||
|
||||
BITMAP (* ; "The bitmap itself")
|
||||
|
||||
BMOBJSCALEFACTOR (* ;
|
||||
|
||||
"The factor to scale it by when displaying")
|
||||
|
||||
BMOBJROTATION (* ;
|
||||
|
||||
"A rotation to apply when displaying")
|
||||
|
||||
BMOBJDESCENT (* ;
|
||||
|
||||
"How far below the base line to display it. NIL => 0.")
|
||||
|
||||
))
|
||||
|
||||
BITMAP (* ; "The bitmap itself")
|
||||
BMOBJSCALEFACTOR (* ;
|
||||
"The factor to scale it by when displaying")
|
||||
BMOBJROTATION (* ;
|
||||
"A rotation to apply when displaying")
|
||||
BMOBJDESCENT (* ;
|
||||
"How far below the base line to display it. NIL => 0.")
|
||||
))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(RPAQ? DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "make ^O be a character that inserts an object read from the user.")
|
||||
|
||||
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
|
||||
|
||||
(GLOBALVARS (BITMAP.OBJ.MENU))
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR BackgroundCopyMenuCommands
|
||||
|
||||
(SNAP (FUNCTION (BITMAPOBJ.SNAPW))
|
||||
|
||||
"prompts for an area of the screen to insert.")
|
||||
|
||||
("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
|
||||
|
||||
"prompts for an area of the screen to insert, scaled down by 50%%.")
|
||||
|
||||
("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
|
||||
|
||||
"prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50.")
|
||||
|
||||
("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
|
||||
|
||||
"Inserts *INSERT-BITMAP* in a document"))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN2))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN3))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN4))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN5))
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR IMAGEOBJGETFNS (SCALED.BITMAP.GETFN))
|
||||
|
||||
|
||||
|
||||
(RPAQQ BackgroundCopyMenu NIL)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(GET.OBJ.FROM.USER
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 26-Apr-91 10:54 by jds")
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Dec-2024 19:44 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 21:04 by rmk")
|
||||
(* ; "Edited 26-Apr-91 10:54 by jds")
|
||||
|
||||
(* ;; "reads an expression from the user and puts the result into the textstream.")
|
||||
(* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")
|
||||
|
||||
(ERSETQ (PROG ((VAL (PROMPTFOREVALED "Form to eval:"))
|
||||
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
BM)
|
||||
(CL:TYPECASE VAL
|
||||
(STRINGP (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL)))
|
||||
(LITATOM (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
|
||||
SEL)))
|
||||
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
|
||||
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM (SELECTQ (fetch POINT of SEL)
|
||||
(LEFT (fetch (SELECTION CH#)
|
||||
of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM)
|
||||
of SEL))
|
||||
NIL)))
|
||||
(T (COND
|
||||
((SETQ BM (COERCETOBITMAP VAL))
|
||||
(ERSETQ (LET ((VAL (PROMPTFOREVALED "Form to eval:"))
|
||||
BM)
|
||||
(CL:WHEN VAL
|
||||
(CL:TYPECASE VAL
|
||||
(STRINGP (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(TEDIT.INSERT TEXTSTREAM VAL))
|
||||
(LITATOM (* ;
|
||||
"Atoms and strings get inserted as text.")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))))
|
||||
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
|
||||
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
|
||||
(T [COND
|
||||
((SETQ BM (COERCETOBITMAP VAL))
|
||||
(* ;
|
||||
"If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")
|
||||
(TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
|
||||
TEXTSTREAM
|
||||
(SELECTQ (fetch POINT of SEL)
|
||||
(LEFT (fetch (SELECTION CH#) of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM) of SEL))
|
||||
NIL)))
|
||||
(T (* ;
|
||||
"Not a bitmap, nor one of the special cases above; complain")
|
||||
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
|
||||
SEL)) (* ;
|
||||
"(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT 'Not implemented to have ' VAL ' in documents yet.') T)")
|
||||
))))])
|
||||
|
||||
|
||||
"If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")
|
||||
(TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
|
||||
TEXTSTREAM))
|
||||
(T (* ;
|
||||
"Not a bitmap, nor one of the special cases above; see what happens")
|
||||
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T])))])
|
||||
|
||||
(BITMAPOBJ.SNAPW
|
||||
[LAMBDA (SCALE SAVE) (* ; "Edited 14-Aug-93 19:54 by rmk:")
|
||||
@@ -911,8 +725,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
0]
|
||||
(RETURN])
|
||||
|
||||
|
||||
|
||||
(PROMPTFOREVALED
|
||||
(LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT) (* jds "26-Sep-85 16:46")
|
||||
|
||||
@@ -950,42 +762,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
|
||||
'>)))))
|
||||
(CLOSEW WIN)
|
||||
(RETURN NEWVALUE))))
|
||||
|
||||
)
|
||||
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
|
||||
|
||||
(BMOBJ.INIT)
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(FILESLOAD EDITBITMAP)
|
||||
|
||||
(PUTPROPS IMAGEOBJ COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993
|
||||
|
||||
1995))
|
||||
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(FILEMAP (NIL (3164 7671 (BITMAPTEDITOBJ 3176 . 3819) (COERCETOBITMAP 3823 . 5867) (WINDOWTITLEFONT
|
||||
|
||||
5871 . 6218) (\PRINTBINARYBITMAP 6222 . 7013) (\READBINARYBITMAP 7017 . 7668)) (7728 23863 (
|
||||
|
||||
BMOBJ.BUTTONEVENTINFN 7740 . 12286) (BMOBJ.COPYFN 12290 . 12916) (BMOBJ.DISPLAYFN 12920 . 16649) (
|
||||
|
||||
BMOBJ.IMAGEBOXFN 16653 . 19068) (BMOBJ.PUTFN 19072 . 20004) (BMOBJ.INIT 20008 . 21047) (BMOBJ.GETFN5
|
||||
|
||||
21051 . 21641) (BMOBJ.CREATE.MENU 21645 . 23860)) (23958 27253 (SCALED.BITMAP.GETFN 23970 . 24396) (
|
||||
|
||||
BMOBJ.GETFN 24400 . 24935) (BMOBJ.GETFN2 24939 . 25424) (BMOBJ.GETFN3 25428 . 26216) (BMOBJ.GETFN4
|
||||
|
||||
26220 . 27250)) (29245 35381 (GET.OBJ.FROM.USER 29257 . 32020) (BITMAPOBJ.SNAPW 32024 . 33150) (
|
||||
|
||||
PROMPTFOREVALED 33154 . 35378)))))
|
||||
|
||||
(FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT
|
||||
5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
|
||||
BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
|
||||
BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5
|
||||
20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
|
||||
BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4
|
||||
25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
|
||||
PROMPTFOREVALED 32055 . 34279)))))
|
||||
STOP
|
||||
|
||||
|
||||
Binary file not shown.
@@ -1,22 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 09:05:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6 196680
|
||||
|
||||
changes to%: (FNS MSINTERPRETSET)
|
||||
(FILECREATED "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28 197707
|
||||
|
||||
previous date%: " 9-Jun-2021 23:55:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jul-2024 11:54:48" {WMEDLEY}<library>MASTERSCOPE.;27)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||
|
||||
(RPAQQ MASTERSCOPECOMS
|
||||
[
|
||||
(* ;; "Main file for MASTERSCOPE.")
|
||||
(* ;; "Main file for MASTERSCOPE.")
|
||||
|
||||
(FILES MSPARSE MSANALYZE)
|
||||
(PROP FILETYPE MASTERSCOPE)
|
||||
@@ -28,13 +25,13 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
[COMS (FNS MSFIND MSEDITF MSEDITE EDITGETDEF)
|
||||
(VARS MSBLIP)
|
||||
|
||||
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
|
||||
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
|
||||
|
||||
[INITVARS (MSFNTYPES '((FNS FNS GETDEF]
|
||||
(COMS (* ; "SCRATCHASH")
|
||||
(COMS (* ; "SCRATCHASH")
|
||||
(INITVARS (MSCRATCHASH))
|
||||
(DECLARE%: DONTCOPY (MACROS SCRATCHASH]
|
||||
(COMS (* ; "marking changed")
|
||||
(COMS (* ; "marking changed")
|
||||
(FNS MSMARKCHANGED CHANGEMACRO CHANGEVAR CHANGEI.S. CHANGERECORD MSNEEDUNSAVE UNSAVEFNS
|
||||
)
|
||||
(ADDVARS (COMPILE.TIME.CONSTANTS))
|
||||
@@ -42,11 +39,11 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(INITVARS (CHECKUNSAVEFLG T)
|
||||
(MSNEEDUNSAVE)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETWORDTYPE))
|
||||
(COMS (* ; "interactive routines")
|
||||
(COMS (* ; "interactive routines")
|
||||
[VARS * (LIST (LIST 'MASTERSCOPEDATE (DATE (DATEFORMAT NO.TIME]
|
||||
(ADDVARS (HISTORYCOMS %.))
|
||||
(FNS %. MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC)
|
||||
(* ; "Interpreting commands")
|
||||
(* ; "Interpreting commands")
|
||||
(FNS MSINTERPRETSET MSINTERPA MSGETBLOCKDEC LISTHARD MSMEMBSET MSLISTSET MSHASHLIST
|
||||
MSHASHLIST1 CHECKPATHS ONFILE)
|
||||
(FNS MSINTERPRET VERBNOTICELIST MSOUTPUT MSCHECKEMPTY CHECKFORCHANGED MSSOLVE)
|
||||
@@ -186,9 +183,9 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
MSFILELST])
|
||||
|
||||
(MSSHOWUSE
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS) (* ; "Edited 4-Jul-2024 15:06 by rmk")
|
||||
(* ;
|
||||
"Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Show/Edit where SHOWFN uses/etc. a pattern.")
|
||||
|
||||
@@ -196,7 +193,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(COND
|
||||
([OR [CL:MULTIPLE-VALUE-SETQ (DEF REALDEF)
|
||||
(MSGETDEF SHOWFN (AND (fetch (MSSETPHRASE KNOWN) of SHOWSET)
|
||||
(fetch (MSSETPHRASE TYPE) of SHOWSET))
|
||||
(fetch (MSSETPHRASE TYPE) of SHOWSET))
|
||||
(COND
|
||||
((EQ SHOWEDIT 'SHOW)
|
||||
'?)
|
||||
@@ -208,43 +205,45 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(FILE (LOADFNS SHOWFN FILE 'PROP)
|
||||
(GETPROP SHOWFN 'EXPR]
|
||||
(* ;
|
||||
"was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
|
||||
"was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
|
||||
(* ;
|
||||
"The SHOW command does not need to save")
|
||||
(MSUPDATEFN1 SHOWFN DEF
|
||||
(LIST SHOWTYPE [FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
|
||||
(COND
|
||||
((MSMEMBSET ITEM SS)
|
||||
(COND
|
||||
((NOT ANYFOUND)
|
||||
(TAB 0 0 T)
|
||||
(PRIN2 SHOWFN)
|
||||
(PRIN1 " :
|
||||
"The SHOW command does not need to save")
|
||||
(MSUPDATEFN1 SHOWFN DEF (LIST SHOWTYPE
|
||||
[FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
|
||||
(COND
|
||||
((MSMEMBSET ITEM SS)
|
||||
(COND
|
||||
((NOT ANYFOUND)
|
||||
(TAB 0 0 T)
|
||||
(DSPFONT (PROG1 (DSPFONT BOLDFONT)
|
||||
(PRIN2 SHOWFN)))
|
||||
(PRIN1 " :
|
||||
")))
|
||||
(SETQ ANYFOUND
|
||||
(CONS (CONS PRNT (AND INCLISP
|
||||
(NOT (MSFIND INCLISP
|
||||
PRNT))
|
||||
INCLISP))
|
||||
ANYFOUND))
|
||||
(COND
|
||||
([AND (EQ SE 'SHOW)
|
||||
(NOT (FASSOC PRNT (CDR ANYFOUND]
|
||||
(SETQ ANYFOUND
|
||||
(CONS (CONS PRNT
|
||||
(AND INCLISP
|
||||
(NOT (MSFIND INCLISP
|
||||
PRNT))
|
||||
INCLISP))
|
||||
ANYFOUND))
|
||||
(COND
|
||||
([AND (EQ SE 'SHOW)
|
||||
(NOT (FASSOC PRNT (CDR ANYFOUND]
|
||||
|
||||
(* ;; "The EDIT command works by collecting a list of the expressions, and then doing a (*ORF* (= . lst1) (= . lst2)) --- if within a CLISP translation (determined by the binding of the INCLISP variable) then want to point at the CLISP if the expression is not actually embedded in the expression")
|
||||
|
||||
(SPACES 3)
|
||||
(LVLPRINT PRNT (OUTPUT)
|
||||
2)
|
||||
(COND
|
||||
((CDAR ANYFOUND)
|
||||
(SPACES 3)
|
||||
(LVLPRINT PRNT (OUTPUT)
|
||||
2)
|
||||
(COND
|
||||
((CDAR ANYFOUND)
|
||||
(* ; "This is under a clisp")
|
||||
(PRIN1 " {under ")
|
||||
(LVLPRIN2 INCLISP (OUTPUT)
|
||||
2)
|
||||
(PRIN1 "}
|
||||
(PRIN1 " {under ")
|
||||
(LVLPRIN2 INCLISP (OUTPUT)
|
||||
2)
|
||||
(PRIN1 "}
|
||||
"]
|
||||
SHOWSET SHOWEDIT)))
|
||||
SHOWSET SHOWEDIT)))
|
||||
(T (printout T "Can't find a definition for " SHOWFN "!" T)
|
||||
(RETURN)))
|
||||
(COND
|
||||
@@ -2403,14 +2402,14 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS SCRATCHASH MACRO [(ARRAYNAME . FORMS)
|
||||
([LAMBDA (ARRAYNAME)
|
||||
(SETQ MSCRATCHASH)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(SETQ MSCRATCHASH ARRAYNAME]
|
||||
(COND
|
||||
(MSCRATCHASH (CLRHASH MSCRATCHASH)
|
||||
MSCRATCHASH)
|
||||
(T (HASHARRAY 20 (FUNCTION MSREHASH])
|
||||
([LAMBDA (ARRAYNAME)
|
||||
(SETQ MSCRATCHASH)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(SETQ MSCRATCHASH ARRAYNAME]
|
||||
(COND
|
||||
(MSCRATCHASH (CLRHASH MSCRATCHASH)
|
||||
MSCRATCHASH)
|
||||
(T (HASHARRAY 20 (FUNCTION MSREHASH])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2569,7 +2568,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS GETWORDTYPE MACRO [(WORD TYPE)
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2578,7 +2577,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE "13-Jun-2021")
|
||||
(RPAQ MASTERSCOPEDATE "14-Jul-2024")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3527,8 +3526,31 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
(LAMBDA (FILE) (* ; "Edited 12-Jun-90 20:43 by teruuchi") (* ;; "OUTPUT is already RESETSAVE'd") (COND ((OPENP FILE (QUOTE OUTPUT)) (OUTPUT FILE)) (T (OUTFILE FILE) (SETQ FILE (OUTPUT)) (RESETSAVE NIL (LIST (QUOTE CLOSEF) FILE)))) (* ;; "output to file, reset LINELENGTH") (LINELENGTH FILELINELENGTH))
|
||||
)
|
||||
[LAMBDA (FILE) (* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||
(LET ((LLENGTH FILELINELENGTH))
|
||||
[COND
|
||||
((AND (LITATOM FILE)
|
||||
(MEMB (U-CASE FILE)
|
||||
'(TEDIT :TEDIT))
|
||||
(GETD (FUNCTION TEDIT)))
|
||||
|
||||
(* ;; "If no TEDIT, leave the current OUTPUT")
|
||||
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT]
|
||||
(SETQ LLENGTH T)
|
||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
||||
((OPENP FILE 'OUTPUT))
|
||||
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
||||
|
||||
(* ;; "Reset LINELENGTH, output to file. OUTPUT is already RESETSAVE'd.")
|
||||
|
||||
(LINELENGTH LLENGTH FILE)
|
||||
(OUTPUT FILE])
|
||||
|
||||
(MSCHECKEMPTY
|
||||
[LAMBDA NIL (* lmm "20-JAN-79 14:08")
|
||||
@@ -3621,15 +3643,15 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD GETHASH (ID HTABLE . BADMARKS)
|
||||
ID _ 'GETHASH)
|
||||
ID _ 'GETHASH)
|
||||
|
||||
(RECORD INRELATION (ID (INVERTED . HTABLES) . OSET)
|
||||
ID _ 'INRELATION)
|
||||
ID _ 'INRELATION)
|
||||
|
||||
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH
|
||||
MARKING) (* CHECKPATHS assumes that this is
|
||||
an ASSOCRECORD)
|
||||
)
|
||||
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH MARKING)
|
||||
(* CHECKPATHS assumes that this is an
|
||||
ASSOCRECORD)
|
||||
)
|
||||
|
||||
(RECORD MSANALYZABLE (FILEPKGNAME SETNAME GETDEF-FN MARKCHANGED-FN))
|
||||
)
|
||||
@@ -3726,39 +3748,37 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
|
||||
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
||||
)
|
||||
(PUTPROPS MASTERSCOPE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993
|
||||
1994 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3419 19188 (UPDATEFN 3429 . 5046) (MSGETDEF 5048 . 6454) (MSNOTICEFILE 6456 . 8849) (
|
||||
MSSHOWUSE 8851 . 14354) (MSUPDATEFN1 14356 . 15044) (MSUPDATE 15046 . 17472) (MSNLAMBDACHECK 17474 .
|
||||
18356) (MSCOLLECTDATA 18358 . 19186)) (19189 20088 (UPDATECHANGED 19199 . 19562) (UPDATECHANGED1 19564
|
||||
. 20086)) (20662 21085 (MSCLOSEFILES 20672 . 21083)) (21766 26198 (MSDESCRIBE 21776 . 24564) (
|
||||
MSDESCRIBE1 24566 . 25629) (FMAPRINT 25631 . 26196)) (26291 26731 (MSPRINTHELPFILE 26301 . 26729)) (
|
||||
26781 29919 (TEMPLATE 26791 . 28212) (GETTEMPLATE 28214 . 28349) (SETTEMPLATE 28351 . 29917)) (30789
|
||||
35713 (ADDTEMPLATEWORD 30799 . 31471) (MSADDANALYZE 31473 . 32971) (MSADDMODIFIER 32973 . 34054) (
|
||||
MSADDRELATION 34056 . 34803) (MSADDTYPE 34805 . 35711)) (37214 42435 (MSMARKCHANGE1 37224 . 38018) (
|
||||
MSINIT 38020 . 39201) (GETVERBTABLES 39203 . 39756) (MSSTOREDATA 39758 . 41437) (STORETABLE 41439 .
|
||||
42433)) (43836 48906 (PARSERELATION 43846 . 44446) (PARSERELATION1 44448 . 45903) (GETRELATION 45905
|
||||
. 46934) (MAPRELATION 46936 . 48070) (TESTRELATION 48072 . 48904)) (48907 50547 (ADDHASH 48917 .
|
||||
49395) (SUBHASH 49397 . 49625) (MAKEHASH 49627 . 49771) (MSREHASH 49773 . 50226) (EQMEMBHASH 50228 .
|
||||
50545)) (50886 57101 (MSVBTABLES 50896 . 56675) (MSUSERVBTABLES 56677 . 57099)) (57184 59395 (
|
||||
BUILDGETRELQ 57194 . 58300) (BUILDTESTRELQ 58302 . 59393)) (59566 59954 (MSERASE 59576 . 59952)) (
|
||||
59955 64415 (DUMPDATABASE 59965 . 62530) (DUMPDATABASE1 62532 . 62877) (READATABASE 62879 . 64413)) (
|
||||
65497 94556 (MSCHECKBLOCKS 65507 . 69327) (MSCHECKBLOCK 69329 . 77949) (MSCHECKFNINBLOCK 77951 . 80951
|
||||
) (MSCHECKBLOCKBASIC 80953 . 83373) (MSCHECKBOUNDFREE 83375 . 85274) (GLOBALVARP 85276 . 85443) (
|
||||
PRINTERROR 85445 . 88661) (MSCHECKVARS1 88663 . 91616) (UNECCSPEC 91618 . 91896) (NECCSPEC 91898 .
|
||||
92245) (SPECVARP 92247 . 92774) (SHORTLST 92776 . 93232) (DOERROR 93234 . 93944) (MSMSGPRINT 93946 .
|
||||
94554)) (95700 110528 (MSPATHS 95710 . 99112) (MSPATHS1 99114 . 103349) (MSPATHS2 103351 . 106761) (
|
||||
MSONPATH 106763 . 107991) (MSPATHS4 107993 . 109075) (DASHES 109077 . 109603) (DOTABS 109605 . 109846)
|
||||
(BELOWMARKER 109848 . 110311) (MSPATHSPRINTFN 110313 . 110526)) (110914 114338 (MSFIND 110924 .
|
||||
111199) (MSEDITF 111201 . 112201) (MSEDITE 112203 . 113240) (EDITGETDEF 113242 . 114336)) (115344
|
||||
123945 (MSMARKCHANGED 115354 . 117078) (CHANGEMACRO 117080 . 117785) (CHANGEVAR 117787 . 118103) (
|
||||
CHANGEI.S. 118105 . 119438) (CHANGERECORD 119440 . 120311) (MSNEEDUNSAVE 120313 . 121305) (UNSAVEFNS
|
||||
121307 . 123943)) (124386 127876 (%. 124396 . 124536) (MASTERSCOPE 124538 . 125064) (MASTERSCOPE1
|
||||
125066 . 125934) (MASTERSCOPEXEC 125936 . 127874)) (127915 167565 (MSINTERPRETSET 127925 . 156459) (
|
||||
MSINTERPA 156461 . 156995) (MSGETBLOCKDEC 156997 . 159510) (LISTHARD 159512 . 160730) (MSMEMBSET
|
||||
160732 . 160877) (MSLISTSET 160879 . 161244) (MSHASHLIST 161246 . 161413) (MSHASHLIST1 161415 . 161741
|
||||
) (CHECKPATHS 161743 . 162383) (ONFILE 162385 . 167563)) (167566 190732 (MSINTERPRET 167576 . 184429)
|
||||
(VERBNOTICELIST 184431 . 185541) (MSOUTPUT 185543 . 185860) (MSCHECKEMPTY 185862 . 187066) (
|
||||
CHECKFORCHANGED 187068 . 187588) (MSSOLVE 187590 . 190730)))))
|
||||
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
|
||||
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
|
||||
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
|
||||
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
|
||||
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
|
||||
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
|
||||
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
|
||||
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42754 (MSMARKCHANGE1 37543 . 38337) (
|
||||
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41756) (STORETABLE 41758 .
|
||||
42752)) (44155 49225 (PARSERELATION 44165 . 44765) (PARSERELATION1 44767 . 46222) (GETRELATION 46224
|
||||
. 47253) (MAPRELATION 47255 . 48389) (TESTRELATION 48391 . 49223)) (49226 50866 (ADDHASH 49236 .
|
||||
49714) (SUBHASH 49716 . 49944) (MAKEHASH 49946 . 50090) (MSREHASH 50092 . 50545) (EQMEMBHASH 50547 .
|
||||
50864)) (51205 57420 (MSVBTABLES 51215 . 56994) (MSUSERVBTABLES 56996 . 57418)) (57503 59714 (
|
||||
BUILDGETRELQ 57513 . 58619) (BUILDTESTRELQ 58621 . 59712)) (59885 60273 (MSERASE 59895 . 60271)) (
|
||||
60274 64734 (DUMPDATABASE 60284 . 62849) (DUMPDATABASE1 62851 . 63196) (READATABASE 63198 . 64732)) (
|
||||
65816 94875 (MSCHECKBLOCKS 65826 . 69646) (MSCHECKBLOCK 69648 . 78268) (MSCHECKFNINBLOCK 78270 . 81270
|
||||
) (MSCHECKBLOCKBASIC 81272 . 83692) (MSCHECKBOUNDFREE 83694 . 85593) (GLOBALVARP 85595 . 85762) (
|
||||
PRINTERROR 85764 . 88980) (MSCHECKVARS1 88982 . 91935) (UNECCSPEC 91937 . 92215) (NECCSPEC 92217 .
|
||||
92564) (SPECVARP 92566 . 93093) (SHORTLST 93095 . 93551) (DOERROR 93553 . 94263) (MSMSGPRINT 94265 .
|
||||
94873)) (96019 110847 (MSPATHS 96029 . 99431) (MSPATHS1 99433 . 103668) (MSPATHS2 103670 . 107080) (
|
||||
MSONPATH 107082 . 108310) (MSPATHS4 108312 . 109394) (DASHES 109396 . 109922) (DOTABS 109924 . 110165)
|
||||
(BELOWMARKER 110167 . 110630) (MSPATHSPRINTFN 110632 . 110845)) (111233 114657 (MSFIND 111243 .
|
||||
111518) (MSEDITF 111520 . 112520) (MSEDITE 112522 . 113559) (EDITGETDEF 113561 . 114655)) (115599
|
||||
124200 (MSMARKCHANGED 115609 . 117333) (CHANGEMACRO 117335 . 118040) (CHANGEVAR 118042 . 118358) (
|
||||
CHANGEI.S. 118360 . 119693) (CHANGERECORD 119695 . 120566) (MSNEEDUNSAVE 120568 . 121560) (UNSAVEFNS
|
||||
121562 . 124198)) (124633 128123 (%. 124643 . 124783) (MASTERSCOPE 124785 . 125311) (MASTERSCOPE1
|
||||
125313 . 126181) (MASTERSCOPEXEC 126183 . 128121)) (128162 167812 (MSINTERPRETSET 128172 . 156706) (
|
||||
MSINTERPA 156708 . 157242) (MSGETBLOCKDEC 157244 . 159757) (LISTHARD 159759 . 160977) (MSMEMBSET
|
||||
160979 . 161124) (MSLISTSET 161126 . 161491) (MSHASHLIST 161493 . 161660) (MSHASHLIST1 161662 . 161988
|
||||
) (CHECKPATHS 161990 . 162630) (ONFILE 162632 . 167810)) (167813 191885 (MSINTERPRET 167823 . 184676)
|
||||
(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187013) (MSCHECKEMPTY 187015 . 188219) (
|
||||
CHECKFORCHANGED 188221 . 188741) (MSSOLVE 188743 . 191883)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56 14033
|
||||
(FILECREATED "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62 14729
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS PDFSTREAMCOMS)
|
||||
:CHANGES-TO (FNS OPEN-PDF-STREAM)
|
||||
|
||||
:PREVIOUS-DATE " 9-Oct-2023 00:42:25" {WMEDLEY}<library>PDFSTREAM.;55)
|
||||
:PREVIOUS-DATE "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -30,6 +30,7 @@
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC]
|
||||
(ALISTS (DEFAULTFILETYPELIST PDF))
|
||||
(VARS (DEFAULTPRINTERTYPE 'PDF))
|
||||
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
|
||||
(P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
|
||||
@@ -73,6 +74,8 @@
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC)))
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY))
|
||||
|
||||
(RPAQQ DEFAULTPRINTERTYPE PDF)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -150,7 +153,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPEN-PDF-STREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Feb-2025 12:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 14:49 by rmk")
|
||||
|
||||
@@ -168,20 +172,26 @@
|
||||
(* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
else (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
|
||||
(SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
elseif (EQ 'NULL (FILENAMEFIELD (TRUEFILENAME FILE)
|
||||
'HOST))
|
||||
then
|
||||
(* ;; "Device NULL used by TMAX, maybe others, to get page number for table of contents, index. Nothing to convert")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
elseif (SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
then (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "Can't find a POSTSCRIPT-to-PDF converter"))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
|
||||
(CLOSE-PDF-STREAM
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
@@ -262,12 +272,14 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SEE-PDF
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 25-Dec-2024 14:25 by rmk")
|
||||
(* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
(* ; "Edited 26-Sep-2023 16:52 by rmk")
|
||||
|
||||
(* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")
|
||||
|
||||
(ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
|
||||
(ShellOpen (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
|
||||
(ERROR "FILE NOT FOUND" PDFFILE])
|
||||
)
|
||||
|
||||
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
|
||||
@@ -280,8 +292,8 @@
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3162 5776 (PDFFILEP 3172 . 4086) (PDF.HARDCOPYW 4088 . 4686) (PDF.TEXT 4688 . 5405) (
|
||||
PDF.TEDIT 5407 . 5774)) (6216 13276 (OPEN-PDF-STREAM 6226 . 8362) (CLOSE-PDF-STREAM 8364 . 9651) (
|
||||
PS-TO-PDF 9653 . 13274)) (13277 13675 (SEE-PDF 13287 . 13673)) (13726 14010 (PDFCONVERTER 13736 .
|
||||
14008)))))
|
||||
(FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
|
||||
PDF.TEDIT 5508 . 5875)) (6317 13806 (OPEN-PDF-STREAM 6327 . 8892) (CLOSE-PDF-STREAM 8894 . 10181) (
|
||||
PS-TO-PDF 10183 . 13804)) (13807 14371 (SEE-PDF 13817 . 14369)) (14422 14706 (PDFCONVERTER 14432 .
|
||||
14704)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12 258100
|
||||
(FILECREATED "10-Dec-2024 15:16:36" {WMEDLEY}<library>POSTSCRIPTSTREAM.;15 258118
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS POSTSCRIPTFILEP)
|
||||
:CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS)
|
||||
|
||||
:PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
|
||||
:PREVIOUS-DATE "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
||||
@@ -18,11 +18,11 @@
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
|
||||
(INITRECORDS \POSTSCRIPTDATA)
|
||||
(FNS POSTSCRIPT.INIT)
|
||||
(ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
|
||||
(PSC . TEXT)
|
||||
(ADDVARS (DEFAULTFILETYPELIST (PS . BINARY)
|
||||
(PSC . BINARY)
|
||||
(PSF . BINARY)
|
||||
(PSCFONT . BINARY)
|
||||
(POSTSCRIPT . TEXT))
|
||||
(POSTSCRIPT . BINARY))
|
||||
(*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
|
||||
(AVANTGARDE-DEMI . AD)
|
||||
(BECKMAN . BM)
|
||||
@@ -483,11 +483,11 @@
|
||||
(\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*])
|
||||
)
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT)
|
||||
(PSC . TEXT)
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PS . BINARY)
|
||||
(PSC . BINARY)
|
||||
(PSF . BINARY)
|
||||
(PSCFONT . BINARY)
|
||||
(POSTSCRIPT . TEXT))
|
||||
(POSTSCRIPT . BINARY))
|
||||
|
||||
(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
|
||||
(AVANTGARDE-DEMI . AD)
|
||||
@@ -4383,38 +4383,38 @@
|
||||
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 .
|
||||
32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
|
||||
PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
|
||||
PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
|
||||
POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
|
||||
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622
|
||||
74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
|
||||
POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
|
||||
POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE
|
||||
81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
|
||||
POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND
|
||||
94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
|
||||
POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024)
|
||||
(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719)
|
||||
(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
|
||||
\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 .
|
||||
126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 .
|
||||
133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 .
|
||||
142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 .
|
||||
147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
|
||||
\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
|
||||
(\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 .
|
||||
160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
|
||||
. 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 .
|
||||
167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC
|
||||
168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
|
||||
\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 .
|
||||
180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
|
||||
\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
|
||||
\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC
|
||||
199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
|
||||
205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 .
|
||||
206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 .
|
||||
254985)))))
|
||||
(FILEMAP (NIL (22211 29315 (POSTSCRIPT.INIT 22221 . 29313)) (30301 65085 (PSCFONT.READFONT 30311 .
|
||||
32219) (PSCFONT.SPELLFILE 32221 . 32799) (PSCFONT.COERCEFILE 32801 . 34373) (
|
||||
PSCFONTFROMCACHE.SPELLFILE 34375 . 35360) (PSCFONTFROMCACHE.COERCEFILE 35362 . 37014) (
|
||||
PSCFONT.WRITEFONT 37016 . 38031) (READ-AFM-FILE 38033 . 43904) (CONVERT-AFM-FILES 43906 . 45118) (
|
||||
POSTSCRIPT.GETFONTID 45120 . 46515) (POSTSCRIPT.FONTCREATE 46517 . 58916) (
|
||||
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58918 . 61315) (POSTSCRIPT.FONTSAVAILABLE 61317 . 65083)) (65640
|
||||
74786 (OPENPOSTSCRIPTSTREAM 65650 . 74452) (CLOSEPOSTSCRIPTSTREAM 74454 . 74784)) (74831 81123 (
|
||||
POSTSCRIPT.HARDCOPYW 74841 . 78190) (POSTSCRIPT.TEDIT 78192 . 78672) (POSTSCRIPT.TEXT 78674 . 78965) (
|
||||
POSTSCRIPTFILEP 78967 . 80074) (MAKEEPSFILE 80076 . 81121)) (81124 126010 (POSTSCRIPT.BITMAPSCALE
|
||||
81134 . 83590) (POSTSCRIPT.CLOSESTRING 83592 . 84126) (POSTSCRIPT.ENDPAGE 84128 . 84999) (
|
||||
POSTSCRIPT.OUTSTR 85001 . 86022) (POSTSCRIPT.PUTBITMAPBYTES 86024 . 94495) (POSTSCRIPT.PUTCOMMAND
|
||||
94497 . 95546) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95548 . 100996) (POSTSCRIPT.SHOWACCUM 100998 . 103236) (
|
||||
POSTSCRIPT.STARTPAGE 103238 . 105817) (\POSTSCRIPTTAB 105819 . 106690) (\PS.BOUTFIXP 106692 . 108042)
|
||||
(\PS.SCALEHACK 108044 . 110873) (\PS.SCALEREGION 110875 . 111435) (\SCALEDBITBLT.PSC 111437 . 115737)
|
||||
(\SETPOS.PSC 115739 . 116201) (\SETXFORM.PSC 116203 . 118022) (\STRINGWIDTH.PSC 118024 . 118478) (
|
||||
\SWITCHFONTS.PSC 118480 . 124637) (\TERPRI.PSC 124639 . 126008)) (126045 181765 (\BITBLT.PSC 126055 .
|
||||
126608) (\BLTSHADE.PSC 126610 . 130892) (\CHARWIDTH.PSC 130894 . 131661) (\CREATECHARSET.PSC 131663 .
|
||||
133361) (\DRAWARC.PSC 133363 . 135843) (\DRAWCIRCLE.PSC 135845 . 138254) (\DRAWCURVE.PSC 138256 .
|
||||
142277) (\DRAWELLIPSE.PSC 142279 . 144756) (\DRAWLINE.PSC 144758 . 147108) (\DRAWPOINT.PSC 147110 .
|
||||
147698) (\DRAWPOLYGON.PSC 147700 . 150814) (\DSPBOTTOMMARGIN.PSC 150816 . 151381) (
|
||||
\DSPCLIPPINGREGION.PSC 151383 . 152826) (\DSPCOLOR.PSC 152828 . 153669) (\DSPFONT.PSC 153671 . 157881)
|
||||
(\DSPLEFTMARGIN.PSC 157883 . 158452) (\DSPLINEFEED.PSC 158454 . 159030) (\DSPPUSHSTATE.PSC 159032 .
|
||||
160795) (\DSPPOPSTATE.PSC 160797 . 163306) (\DSPRESET.PSC 163308 . 163954) (\DSPRIGHTMARGIN.PSC 163956
|
||||
. 164528) (\DSPROTATE.PSC 164530 . 165553) (\DSPSCALE.PSC 165555 . 166486) (\DSPSCALE2.PSC 166488 .
|
||||
167307) (\DSPSPACEFACTOR.PSC 167309 . 168281) (\DSPTOPMARGIN.PSC 168283 . 169000) (\DSPTRANSLATE.PSC
|
||||
169002 . 171576) (\DSPXPOSITION.PSC 171578 . 172177) (\DSPYPOSITION.PSC 172179 . 172751) (
|
||||
\FILLCIRCLE.PSC 172753 . 175399) (\FILLPOLYGON.PSC 175401 . 179317) (\FIXLINELENGTH.PSC 179319 .
|
||||
180813) (\MOVETO.PSC 180815 . 181566) (\NEWPAGE.PSC 181568 . 181763)) (181821 204973 (
|
||||
\POSTSCRIPT.CHANGECHARSET 181831 . 182635) (\POSTSCRIPT.OUTCHARFN 182637 . 195494) (
|
||||
\POSTSCRIPT.PRINTSLUG 195496 . 197463) (\POSTSCRIPT.SPECIALOUTCHARFN 197465 . 199897) (\UPDATE.PSC
|
||||
199899 . 201122) (\POSTSCRIPT.ACCENTFN 201124 . 202066) (\POSTSCRIPT.ACCENTPAIR 202068 . 204971)) (
|
||||
205071 206716 (\PSC.SPACEDISP 205081 . 205360) (\PSC.SPACEWID 205362 . 205981) (\PSC.SYMBOLS 205983 .
|
||||
206714)) (206825 209816 (\POSTSCRIPT.NSHASH 206835 . 209814)) (254291 255005 (POSTSCRIPTSEND 254301 .
|
||||
255003)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Nov-2023 10:53:30" {WMEDLEY}<lispusers>PSEUDOHOSTS.;160 26843
|
||||
(FILECREATED "31-Dec-2024 11:45:23" {WMEDLEY}<library>PSEUDOHOSTS.;177 29713
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS PSEUDOHOST)
|
||||
:CHANGES-TO (FNS TRUEDEVICE)
|
||||
|
||||
:PREVIOUS-DATE " 1-Oct-2023 20:16:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;159)
|
||||
:PREVIOUS-DATE "25-Dec-2024 07:38:10" {WMEDLEY}<library>PSEUDOHOSTS.;176)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
|
||||
@@ -15,16 +15,17 @@
|
||||
(
|
||||
(* ;; "Public entries")
|
||||
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME)
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME)
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH)
|
||||
(FNS CDPSEUDO)
|
||||
(FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH
|
||||
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
|
||||
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
|
||||
(P (PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (PSEUDOHOST 'LI LOGINHOST/DIR)))
|
||||
(P (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
(MOVD 'GETHOSTINFO.PH 'GETHOSTINFO))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
|
||||
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
|
||||
@@ -136,9 +137,14 @@
|
||||
HOST])
|
||||
|
||||
(PSEUDOHOSTP
|
||||
[LAMBDA (HOST) (* ; "Edited 24-Feb-2022 23:51 by rmk")
|
||||
[LAMBDA (HOST) (* ; "Edited 16-Dec-2024 21:15 by rmk")
|
||||
(* ; "Edited 24-Feb-2022 23:51 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 11:29 by rmk")
|
||||
(LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
|
||||
(LET [(DEV (if (type? FDEV HOST)
|
||||
then HOST
|
||||
elseif (type? STREAM HOST)
|
||||
then (fetch (STREAM DEVICE) of HOST)
|
||||
else (\GETDEVICEFROMNAME HOST T T]
|
||||
(CL:WHEN (AND DEV (type? FDEV (fetch (PHDEVICE TARGETDEV) OF DEV)))
|
||||
(LIST (FETCH (FDEV DEVICENAME) OF DEV)
|
||||
(FETCH (PHDEVICE PREFIX)
|
||||
@@ -151,9 +157,30 @@
|
||||
(FETCH (PHDEVICE PREFIX) OF DEV])
|
||||
|
||||
(TARGETHOST
|
||||
[LAMBDA (HOST) (* ; "Edited 22-Jan-2022 09:00 by rmk")
|
||||
(CL:WHEN (PSEUDOHOSTP HOST)
|
||||
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
|
||||
[LAMBDA (HOST) (* ; "Edited 14-Dec-2024 15:26 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 16:16 by rmk")
|
||||
(* ; "Edited 22-Jan-2022 09:00 by rmk")
|
||||
(if (STREAMP HOST)
|
||||
then (CL:WHEN (type? FDEV (fetch (PHDEVICE TARGETDEV) of (fetch (STREAM DEVICE) of HOST)))
|
||||
(fetch (FDEV DEVICENAME) of (fetch (PHDEVICE TARGETDEV) of (fetch (STREAM DEVICE)
|
||||
of HOST))))
|
||||
elseif (PSEUDOHOSTP HOST)
|
||||
then (fetch (FDEV DEVICENAME) of (fetch (PHDEVICE TARGETDEV) of (\GETDEVICEFROMNAME HOST T T])
|
||||
|
||||
(TRUEDEVICE
|
||||
[LAMBDA (X) (* ; "Edited 31-Dec-2024 11:44 by rmk")
|
||||
(* ; "Edited 25-Dec-2024 07:37 by rmk")
|
||||
(* ; "Edited 23-Dec-2024 22:56 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 17:36 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 14:34 by rmk")
|
||||
(LET [(DEV (if (type? FDEV X)
|
||||
then X
|
||||
elseif (STREAMP X)
|
||||
then (fetch (STREAM DEVICE) of X)
|
||||
else (\GETDEVICEFROMNAME X]
|
||||
(if (type? FDEV (fetch (PHDEVICE TARGETDEV) of DEV))
|
||||
then (fetch (PHDEVICE TARGETDEV) of DEV)
|
||||
else DEV])
|
||||
|
||||
(TRUEFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 1-Oct-2023 20:16 by rmk")
|
||||
@@ -301,6 +328,24 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CDPSEUDO
|
||||
[LAMBDA (PHOST CDSUFFIX FILEPKG) (* ; "Edited 21-Dec-2024 13:48 by rmk")
|
||||
(* ; "Edited 6-Feb-2024 15:50 by rmk")
|
||||
|
||||
(* ;; "Makes a cd command for PHOST. The command name is %"cd%" followed by the lower-case letters of CDSUFFIX (e.g. cdf for PHOST FOO and CDSUFFIX %"f%".")
|
||||
|
||||
(CL:WHEN (AND (SETQ PHOST (CAR (PSEUDOHOSTP PHOST)))
|
||||
CDSUFFIX)
|
||||
[LET ((C (PACK* "cd" (L-CASE CDSUFFIX)))
|
||||
(FILEPKGFLG FILEPKG))
|
||||
(DECLARE (SPECVARS FILEPKGFLG))
|
||||
(SETQ PHOST (CONCAT "{" PHOST "}"))
|
||||
(EVAL `(DEFCOMMAND ,C (SUBDIR) (/CNDIR (CL:IF SUBDIR
|
||||
(CONCAT ,PHOST "/" SUBDIR)
|
||||
,PHOST)))])])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OPENFILE.PH
|
||||
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
|
||||
|
||||
@@ -453,8 +498,10 @@
|
||||
(SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE)))
|
||||
RESULT])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
)
|
||||
|
||||
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
|
||||
|
||||
@@ -515,12 +562,13 @@
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1254 10126 (PSEUDOHOST 1264 . 6972) (PSEUDOHOSTP 6974 . 7487) (PSEUDOHOSTS 7489 . 7850)
|
||||
(TARGETHOST 7852 . 8126) (TRUEFILENAME 8128 . 9253) (PSEUDOFILENAME 9255 . 10124)) (10154 16169 (
|
||||
EXPAND.PH 10164 . 11417) (CONTRACT.PH 11419 . 14130) (UNSLASHIT 14132 . 15878) (GETHOSTINFO.PH 15880
|
||||
. 16167)) (16170 24190 (OPENFILE.PH 16180 . 17253) (GETFILENAME.PH 17255 . 17544) (DIRECTORYNAMEP.PH
|
||||
17546 . 18170) (CLOSEFILE.PH 18172 . 18639) (REOPENFILE.PH 18641 . 19206) (DELETEFILE.PH 19208 . 19492
|
||||
) (OPENP.PH 19494 . 19789) (UNREGISTERFILE.PH 19791 . 20333) (REGISTERFILE.PH 20335 . 20869) (
|
||||
GENERATEFILES.PH 20871 . 21915) (GETFILEINFO.PH 21917 . 22219) (SETFILEINFO.PH 22221 . 22420) (
|
||||
NEXTFILEFN.PH 22422 . 22968) (FILEINFOFN.PH 22970 . 23245) (RENAMEFILE.PH 23247 . 24188)))))
|
||||
(FILEMAP (NIL (1318 12059 (PSEUDOHOST 1328 . 7036) (PSEUDOHOSTP 7038 . 7867) (PSEUDOHOSTS 7869 . 8230)
|
||||
(TARGETHOST 8232 . 9101) (TRUEDEVICE 9103 . 10059) (TRUEFILENAME 10061 . 11186) (PSEUDOFILENAME 11188
|
||||
. 12057)) (12087 18102 (EXPAND.PH 12097 . 13350) (CONTRACT.PH 13352 . 16063) (UNSLASHIT 16065 . 17811
|
||||
) (GETHOSTINFO.PH 17813 . 18100)) (18103 19004 (CDPSEUDO 18113 . 19002)) (19005 27025 (OPENFILE.PH
|
||||
19015 . 20088) (GETFILENAME.PH 20090 . 20379) (DIRECTORYNAMEP.PH 20381 . 21005) (CLOSEFILE.PH 21007 .
|
||||
21474) (REOPENFILE.PH 21476 . 22041) (DELETEFILE.PH 22043 . 22327) (OPENP.PH 22329 . 22624) (
|
||||
UNREGISTERFILE.PH 22626 . 23168) (REGISTERFILE.PH 23170 . 23704) (GENERATEFILES.PH 23706 . 24750) (
|
||||
GETFILEINFO.PH 24752 . 25054) (SETFILEINFO.PH 25056 . 25255) (NEXTFILEFN.PH 25257 . 25803) (
|
||||
FILEINFOFN.PH 25805 . 26080) (RENAMEFILE.PH 26082 . 27023)))))
|
||||
STOP
|
||||
Binary file not shown.
952
library/UNICODE
952
library/UNICODE
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "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.
2278
library/tedit/TEDIT
2278
library/tedit/TEDIT
File diff suppressed because it is too large
Load Diff
@@ -1,20 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Mar-2024 18:15:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8 9500
|
||||
(FILECREATED "23-Mar-2025 17:09:00" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;20 15864
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:06:12"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7)
|
||||
:PREVIOUS-DATE "20-Mar-2025 22:21:20" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;19)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(RPAQQ TEDIT-ABBREVCOMS
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
|
||||
("n" . "357,44")
|
||||
@@ -65,36 +63,146 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||
(* ; "Edited 17-May-2023 13:31 by rmk")
|
||||
(* ; "Edited 8-Sep-2022 23:53 by rmk")
|
||||
(* ; "Edited 1-Aug-2022 12:04 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 30-May-91 19:27 by jds")
|
||||
(* ; "Expand an abbvreviation")
|
||||
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
|
||||
SEL CH# CH OLDLOOKS EXPANSION)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL)))
|
||||
[COND
|
||||
((ZEROP (GETSEL SEL DCH)) (* ;
|
||||
"Point Selection, so use the character to the left")
|
||||
(CL:WHEN (ZEROP CH#) (* ;
|
||||
"If we're off the front of the document, don't bother trying.")
|
||||
(RETURN))
|
||||
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)
|
||||
CH#)
|
||||
[SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM]
|
||||
(TEDIT.SETSEL TSTREAM CH# 1 'RIGHT))
|
||||
(T (* ;
|
||||
"We have a selection that isn't just a caret. Use it.")
|
||||
(SETQ CH (TEDIT.SEL.AS.STRING TSTREAM]
|
||||
(SETQ EXPANSION (\TEDIT.TRY.ABBREV CH TSTREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")
|
||||
(CL:WHEN EXPANSION (* ;
|
||||
"It exists, so insert it where the abbrev used to be")
|
||||
(SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
|
||||
(TEDIT.DELETE TEXTOBJ SEL) (* ;
|
||||
"First, delete the thing being expanded.")
|
||||
(TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))])
|
||||
(LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL))
|
||||
CAND EXPANSION)
|
||||
|
||||
(* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.")
|
||||
|
||||
(* ;; "Try literal match first, then fiddle the case.")
|
||||
|
||||
(* ;; "If we don't find it in abbrevs, try for a character code.")
|
||||
|
||||
[SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(CAR C)
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(U-CASE (CAR C))
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(L-CASE (CAR C))
|
||||
TSTREAM]
|
||||
(if EXPANSION
|
||||
then (\TEDIT.UPDATE.SEL SEL (CADR CAND)
|
||||
(CADDR CAND)
|
||||
'RIGHT
|
||||
'NORMAL) (* ; "Set the target")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||
(PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
|
||||
TEXTOBJ)))
|
||||
TEXTOBJ SEL)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
|
||||
(\TEDIT.ABBREV.PARSE
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 23-Mar-2025 17:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 22:21 by rmk")
|
||||
|
||||
(* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).")
|
||||
|
||||
(* ;;
|
||||
"It first backs up over any spaces to find the anchor position. The candidates then include")
|
||||
|
||||
(* ;; " The immediately preceding singleton character, if a point selection")
|
||||
|
||||
(* ;; " The remaining (after backing up) characters of the selection.")
|
||||
|
||||
(* ;; " The word that contains the caret (backwards and forwards)")
|
||||
|
||||
(* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).")
|
||||
|
||||
(* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)")
|
||||
|
||||
(* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.")
|
||||
|
||||
(* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.")
|
||||
|
||||
(PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
FIRST# LAST# LEN CANDIDATES KEY NSPACES)
|
||||
|
||||
(* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.")
|
||||
|
||||
(* ;; " The character at CH#, if it is a point selection")
|
||||
|
||||
(* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.")
|
||||
|
||||
(* ;; "Back up over spaces")
|
||||
|
||||
(SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE)
|
||||
(TEDIT.NTHCHARCODE TSTREAM I)) sum 1))
|
||||
(add PT# (IMINUS NSPACES))
|
||||
(CL:WHEN (ZEROP PT#) (* ; "Beginning of document")
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..")
|
||||
|
||||
(push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#))
|
||||
PT# 1))
|
||||
(SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH)
|
||||
NSPACES))) (* ; "Last singleton predecessor")
|
||||
(CL:WHEN (IGEQ LEN 2) (* ; "At least one more character")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#)
|
||||
LEN)
|
||||
(FGETSEL SEL CH#)
|
||||
LEN)))
|
||||
(SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN)))
|
||||
(SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN))) (* ; "Extend if a ,")
|
||||
[for C KEY END in CANDIDATES
|
||||
do
|
||||
(* ;; "Comma for XCCS character names, - and / - for internal punctuation (3/4 EM-DASH). Adjacent character must be text")
|
||||
|
||||
(if [AND (MEMB (TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C)
|
||||
2]
|
||||
then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C)
|
||||
2)))
|
||||
(* ; "Comma before, maybe a charname")
|
||||
(SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C)
|
||||
END))
|
||||
(CAR C)))
|
||||
(push CANDIDATES (LIST KEY END (NCHARS KEY)))
|
||||
elseif [AND (MEMB (TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C)
|
||||
(CADDR C]
|
||||
then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(* ; "Comma after")
|
||||
[SETQ KEY (CONCAT (CAR C)
|
||||
(TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C))
|
||||
(ADD1 (IDIFFERENCE END (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(push CANDIDATES (LIST KEY (CADR C)
|
||||
(NCHARS KEY] (* ;
|
||||
"If preceded by \, include it optionally in the key, always include it in the replacement")
|
||||
(for C in CANDIDATES when [EQ (CHARCODE \)
|
||||
(TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C]
|
||||
do (* ; "Match and replace \KEY")
|
||||
[push CANDIDATES (LIST (CONCAT "\" (CAR C))
|
||||
(SUB1 (CADR C))
|
||||
(ADD1 (CADDR C]
|
||||
(change (CADR C)
|
||||
(SUB1 DATUM)) (* ; "Match KEY but also replace the \")
|
||||
(change (CADDR C)
|
||||
(ADD1 DATUM)))
|
||||
[SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2)
|
||||
(IGEQ (CADDR C1)
|
||||
(CADDR C2] (* ; "Look for longest first")
|
||||
(RETURN CANDIDATES])
|
||||
|
||||
(\TEDIT.EXPAND.DATE
|
||||
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
|
||||
@@ -111,47 +219,38 @@
|
||||
" " DAY ", " YEAR])
|
||||
|
||||
(\TEDIT.TRY.ABBREV
|
||||
[LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
[LAMBDA (KEY TSTREAM) (* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;;
|
||||
"Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.")
|
||||
(* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ")
|
||||
|
||||
(* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.")
|
||||
(LET ((ABBREV (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(if (NULL ABBREV)
|
||||
then (CL:WHEN (CHARCODE.DECODE KEY T)
|
||||
(CHARACTER (CHARCODE.DECODE KEY T)))
|
||||
elseif (STRINGP (CDR ABBREV))
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(PROG (SEL CH# (CH NIL)
|
||||
EXPANSION)
|
||||
(SETQ EXPANSION (OR (SASSOC ABBREV TEDIT.ABBREVS)
|
||||
(SASSOC (U-CASE ABBREV)
|
||||
TEDIT.ABBREVS)))
|
||||
(LET ((CH (CHARCODE.DECODE (CDR ABBREV)
|
||||
T)))
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
(CDR ABBREV)))
|
||||
elseif (SMALLP (CDR ABBREV))
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(* Find the abbreviation's expansion --first try it as-is, then try the
|
||||
upper-case version to be safe.)
|
||||
|
||||
(RETURN (COND
|
||||
(EXPANSION (* There's an expansion.
|
||||
Turn it into an insertable string.)
|
||||
(COND
|
||||
[(STRINGP (CDR EXPANSION))
|
||||
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(COND
|
||||
((SETQ CH (CHARCODE.DECODE (CDR EXPANSION)
|
||||
T))
|
||||
(CHARACTER CH))
|
||||
(T (CDR EXPANSION]
|
||||
((SMALLP (CDR EXPANSION))
|
||||
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(CHARACTER (CDR EXPANSION)))
|
||||
((AND (LITATOM (CDR EXPANSION))
|
||||
(GETD (CDR EXPANSION))) (* It's a function to be called.)
|
||||
(APPLY* (CDR EXPANSION)
|
||||
STREAM CH))
|
||||
(T (* Anything else is a form to EVAL.)
|
||||
(EVAL (CDR EXPANSION])
|
||||
(CHARACTER (CDR ABBREV))
|
||||
elseif (AND (LITATOM (CDR ABBREV))
|
||||
(GETD (CDR ABBREV)))
|
||||
then (* ; "It's a function to be called.")
|
||||
(APPLY* (CDR ABBREV)
|
||||
TSTREAM
|
||||
(CAR ABBREV))
|
||||
else (* ; "Anything else is a form to EVAL.")
|
||||
(EVAL (CDR ABBREV])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -206,6 +305,6 @@
|
||||
("DATE" . \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
|
||||
\TEDIT.TRY.ABBREV 6008 . 8154)))))
|
||||
(FILEMAP (NIL (2933 14520 (\TEDIT.ABBREV.EXPAND 2943 . 5054) (\TEDIT.ABBREV.PARSE 5056 . 12222) (
|
||||
\TEDIT.EXPAND.DATE 12224 . 12857) (\TEDIT.TRY.ABBREV 12859 . 14518)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1985
library/tedit/TEDIT-BUTTONS
Normal file
1985
library/tedit/TEDIT-BUTTONS
Normal file
File diff suppressed because it is too large
Load Diff
BIN
library/tedit/TEDIT-BUTTONS.LCOM
Normal file
BIN
library/tedit/TEDIT-BUTTONS.LCOM
Normal file
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14 12223
|
||||
(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17 12449
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-CHATCOMS)
|
||||
(FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN)
|
||||
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
|
||||
|
||||
:PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}<library>tedit>TEDIT-CHAT.;9)
|
||||
:PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-CHATCOMS)
|
||||
@@ -71,16 +70,19 @@
|
||||
(replace (CHAT.STATE HELD) of STATE with NIL])
|
||||
|
||||
(TEDITCHAT.CHARFN
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 22-Dec-2023 23:57 by rmk")
|
||||
[LAMBDA (CH CHAT.STATE) (* ; "Edited 11-Mar-2025 15:40 by rmk")
|
||||
(* ; "Edited 24-Jun-2024 00:04 by rmk")
|
||||
(* ; "Edited 2-May-2024 18:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2023 23:57 by rmk")
|
||||
(* ; "Edited 18-Mar-2023 20:08 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:00 by mitani")
|
||||
(LET [(TEXTOBJ (TEXTOBJ (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE]
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TEXTOBJ (FGETTOBJ TEXTOBJ SEL)))
|
||||
(LF NIL)
|
||||
(BOUT (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
CH])
|
||||
(LET* ((TSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE))
|
||||
(TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
|
||||
(SELCHARQ CH
|
||||
(BS (\TEDIT.CHARDELETE TSTREAM))
|
||||
(LF NIL)
|
||||
(BOUT TSTREAM CH])
|
||||
)
|
||||
|
||||
|
||||
@@ -212,6 +214,6 @@
|
||||
CHATDECLS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN
|
||||
3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333)))))
|
||||
(FILEMAP (NIL (886 4630 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
|
||||
3663 . 4628)) (4677 11561 (TEDIT.DISPLAYTEXT 4687 . 11559)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Apr-2024 09:12:32" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;153 33754
|
||||
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170 33842
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
|
||||
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
\TEDIT.HCPYFMTSPEC)
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;152)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
|
||||
@@ -87,9 +88,11 @@
|
||||
"Can't HARDCOPY: No print server specified." T])
|
||||
|
||||
(\TEDIT.PRINT.MENU
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 25-Jun-2023 13:16 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 22:09 by rmk")
|
||||
(* ; "Edited 25-Jun-2023 13:16 by rmk")
|
||||
(* ; "Edited 6-Jun-2023 17:48 by rmk")
|
||||
(LET [(W (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TSTREAM]
|
||||
(LET ((W (GETTOBJ (TEXTOBJ TSTREAM)
|
||||
PRIMARYPANE)))
|
||||
(SELECTQ [MENU (create MENU
|
||||
ITEMS _ '(("Print to a file" 'FILE
|
||||
"Puts image on a file; prompts for filename and format"
|
||||
@@ -101,7 +104,8 @@
|
||||
NIL])
|
||||
|
||||
(TEDIT.HCPYFILE
|
||||
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 4-Oct-2022 09:23 by rmk")
|
||||
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 29-Jun-2024 16:33 by rmk")
|
||||
(* ; "Edited 4-Oct-2022 09:23 by rmk")
|
||||
(* ; "Edited 1-Oct-2022 22:12 by rmk")
|
||||
(* ; "Edited 12-Jun-90 18:36 by mitani")
|
||||
|
||||
@@ -125,10 +129,16 @@
|
||||
'HCPY)
|
||||
'BODY
|
||||
(fetch (STREAM FULLFILENAME) of TXTFILE]
|
||||
(TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
|
||||
(if FILENM
|
||||
then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
|
||||
|
||||
(\TEDIT.HARDCOPY.DISPLAYLINE
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Apr-2024 09:09 by rmk")
|
||||
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:39 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:49 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 17:13 by rmk")
|
||||
(* ; "Edited 19-Apr-2024 09:09 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:23 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 22:07 by rmk")
|
||||
@@ -151,16 +161,16 @@
|
||||
(FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
[LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
|
||||
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
|
||||
(\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
|
||||
(\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
|
||||
(FGETLD LINE LCHAR1)
|
||||
LINE REGION PRSTREAM FORMATTINGSTATE))
|
||||
|
||||
(* ;; "Use the characters cached in THISLINE.")
|
||||
|
||||
(for CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
|
||||
|
||||
(for CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
|
||||
TLSPACEFACTOR
|
||||
)
|
||||
of THISLINE))
|
||||
)
|
||||
of THISLINE))
|
||||
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
|
||||
(SCALE _ (DSPSCALE NIL PRSTREAM))
|
||||
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
|
||||
@@ -225,11 +235,7 @@
|
||||
)
|
||||
of CLOOKS]
|
||||
(T (FGETLD LINE YBASE]
|
||||
(DSPYPOSITION CURY PRSTREAM)
|
||||
(CL:WHEN (SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO)
|
||||
of CLOOKS)
|
||||
'KERN))
|
||||
(SETQ KERN (HCSCALE SCALE KERN)))
|
||||
(DSPYPOSITION CURY PRSTREAM)
|
||||
|
||||
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
|
||||
|
||||
@@ -253,6 +259,8 @@
|
||||
|
||||
(SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE
|
||||
PRSTREAM))
|
||||
elseif (EQ 'KERN CHAR)
|
||||
then (RELMOVETO 0 CHARW PRSTREAM)
|
||||
else (\OUTCHAR PRSTREAM CHAR))
|
||||
(add TX CHARW))) finally
|
||||
|
||||
@@ -262,36 +270,39 @@
|
||||
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE
|
||||
LOOKSTARTX TX (FGETLD LINE YBASE)
|
||||
CLOOKS PRSTREAM))
|
||||
(CL:WHEN (fetch (FMTSPEC FMTREVISED)
|
||||
of (FGETLD LINE LFMTSPEC))
|
||||
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
|
||||
FMTREVISED)
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ
|
||||
(FGETLD LINE LFMTSPEC)
|
||||
(FGETLD LINE LPARALOOKS)
|
||||
PRSTREAM LINE))])])
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
[LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 21:13 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 11:04 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 17:22 by rmk")
|
||||
(* ; "Edited 19-Jan-2024 23:19 by rmk")
|
||||
(* ; "Edited 3-Oct-2022 13:05 by rmk")
|
||||
|
||||
(* ;; "Return setup LINE to skip a sequence of heading pieces STATE")
|
||||
|
||||
(SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC)
|
||||
(SELECTQ (GETPLOOKS PARALOOKS FMTPARATYPE)
|
||||
(PAGEHEADING
|
||||
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
|
||||
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
|
||||
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM
|
||||
FORMATTINGSTATE)
|
||||
T)
|
||||
(EVEN (* ; "Skip an odd page.")
|
||||
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
T))
|
||||
(ODD (* ; "Skip an even page")
|
||||
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
|
||||
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
|
||||
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE PARALOOKS CHNO)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
@@ -337,53 +348,44 @@
|
||||
(MOVETO CURX CURY PRSTREAM])
|
||||
|
||||
(\TEDIT.HCPYFMTSPEC
|
||||
[LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 19-Feb-2025 13:34 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 22:36 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 22:25 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:34 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 21:03 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 15:14 by rmk")
|
||||
(* ; "Edited 20-Oct-2022 22:35 by rmk")
|
||||
(* ; "Edited 29-Sep-2022 23:32 by rmk")
|
||||
(* ; "Edited 30-May-91 21:18 by jds")
|
||||
|
||||
(* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
(* ;; "Given a display-type PARALOOKS, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
|
||||
|
||||
(LET ((SCALE (DSPSCALE NIL IMAGESTREAM))
|
||||
FMTSPEC)
|
||||
[SETQ FMTSPEC (create FMTSPEC using SPEC FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (fetch (FMTSPEC 1STLEFTMAR) of SPEC))
|
||||
LEFTMAR _ (HCSCALE SCALE (fetch (FMTSPEC LEFTMAR)
|
||||
of SPEC))
|
||||
RIGHTMAR _ (HCSCALE SCALE (fetch (FMTSPEC RIGHTMAR)
|
||||
of SPEC))
|
||||
QUAD _ (fetch (FMTSPEC QUAD) of SPEC)
|
||||
TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE)
|
||||
FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX)
|
||||
of SPEC)
|
||||
(HCSCALE SCALE
|
||||
(SCALEPAGEUNITS
|
||||
(fetch (FMTSPEC FMTSPECIALX)
|
||||
of SPEC)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY)
|
||||
of SPEC)
|
||||
(HCSCALE SCALE
|
||||
(SCALEPAGEUNITS
|
||||
(fetch (FMTSPEC FMTSPECIALY)
|
||||
of SPEC)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (fetch (FMTSPEC LEADBEFORE)
|
||||
of SPEC))
|
||||
LEADAFTER _ (HCSCALE SCALE (fetch (FMTSPEC LEADAFTER)
|
||||
of SPEC))
|
||||
LINELEAD _ (HCSCALE SCALE (fetch (FMTSPEC LINELEAD)
|
||||
of SPEC))
|
||||
FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE)
|
||||
of SPEC)
|
||||
(HCSCALE SCALE (fetch (FMTSPEC
|
||||
|
||||
FMTBASETOBASE
|
||||
)
|
||||
of SPEC]
|
||||
FMTSPEC])
|
||||
(LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
|
||||
(create PARALOOKS using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT 1STLEFTMAR))
|
||||
LEFTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEFTMAR))
|
||||
RIGHTMAR _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT RIGHTMAR))
|
||||
QUAD _ (FGETPLOOKS DISPLAYFMT QUAD DISPLAYFMT)
|
||||
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT FMTDEFAULTTAB
|
||||
))
|
||||
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPLOOKS DISPLAYFMT FMTTABS)
|
||||
SCALE)
|
||||
FMTSPECIALX _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALX)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALX)
|
||||
1.0 NIL)))
|
||||
FMTSPECIALY _ (AND (FGETPLOOKS DISPLAYFMT FMTSPECIALY)
|
||||
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPLOOKS
|
||||
DISPLAYFMT
|
||||
FMTSPECIALY)
|
||||
1.0 NIL)))
|
||||
LEADBEFORE _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADBEFORE))
|
||||
LEADAFTER _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LEADAFTER))
|
||||
LINELEAD _ (HCSCALE SCALE (FGETPLOOKS DISPLAYFMT LINELEAD))
|
||||
FMTBASETOBASE _ (AND (FGETPLOOKS DISPLAYFMT FMTBASETOBASE)
|
||||
(HCSCALE SCALE (FGETPLOOKS DISPLAYFMT
|
||||
FMTBASETOBASE])
|
||||
|
||||
(\TEDIT.INTEGER.IMAGEBOX
|
||||
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
|
||||
@@ -451,7 +453,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.HARDCOPYFN
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 20-Mar-2024 10:49 by rmk")
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 13-Dec-2024 22:33 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 14:42 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:49 by rmk")
|
||||
(* ; "Edited 25-Sep-2023 16:29 by rmk")
|
||||
(* ; "Edited 4-Jul-2023 11:16 by rmk")
|
||||
(* ; "Edited 21-Sep-2021 15:33 by rmk:")
|
||||
@@ -459,22 +463,15 @@
|
||||
(* ;;
|
||||
"This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
|
||||
|
||||
(LET ((TEXTOBJ (TEXTOBJ WINDOW))
|
||||
(TEXTSTREAM (TEXTSTREAM WINDOW))
|
||||
WASDIRTY)
|
||||
(LET ((TEXTSTREAM (TEXTSTREAM WINDOW)))
|
||||
|
||||
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
|
||||
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
|
||||
(SETQ WINDOW (\TEDIT.MAINW WINDOW))
|
||||
(SETQ TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW)))
|
||||
(RESETLST
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(FSETTOBJ TEXTOBJ EDITOPACTIVE 'Hardcopy) (* ; "Build the hardcopy")
|
||||
(SETQ WASDIRTY (FGETTOBJ TEXTOBJ \DIRTY))
|
||||
(PROG1 (TEDIT.FORMAT.HARDCOPY WINDOW IMAGESTREAM)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY WASDIRTY)))])
|
||||
(TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW)
|
||||
MENUFLG)
|
||||
(\TEDIT.MAINW WINDOW)
|
||||
WINDOW)
|
||||
IMAGESTREAM])
|
||||
|
||||
(\TEDIT.HARDCOPYFILEFN
|
||||
[LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk")
|
||||
@@ -566,11 +563,11 @@
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3475 26808 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5474) (TEDIT.HCPYFILE
|
||||
5476 . 7416) (\TEDIT.HARDCOPY.DISPLAYLINE 7418 . 17356) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17358 .
|
||||
18765) (\TEDIT.HARDCOPY.MODIFYLOOKS 18767 . 21001) (\TEDIT.HCPYFMTSPEC 21003 . 25137) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 25139 . 25810) (\TEDIT.DISPLAY.DIACRITIC 25812 . 26806)) (26883 27713 (
|
||||
\TEDIT.SCALEREGION 26893 . 27711)) (27972 31667 (TEDIT.HARDCOPYFN 27982 . 29442) (
|
||||
\TEDIT.HARDCOPYFILEFN 29444 . 30005) (\TEDIT.POSTSCRIPT.HARDCOPY 30007 . 30938) (\TEDIT.PRESS.HARDCOPY
|
||||
30940 . 31665)) (32930 33731 (TEDIT-BOOK 32940 . 33729)))))
|
||||
(FILEMAP (NIL (3554 27051 (TEDIT.HARDCOPY 3564 . 4697) (\TEDIT.PRINT.MENU 4699 . 5665) (TEDIT.HCPYFILE
|
||||
5667 . 7841) (\TEDIT.HARDCOPY.DISPLAYLINE 7843 . 17953) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17955 .
|
||||
19684) (\TEDIT.HARDCOPY.MODIFYLOOKS 19686 . 21920) (\TEDIT.HCPYFMTSPEC 21922 . 25380) (
|
||||
\TEDIT.INTEGER.IMAGEBOX 25382 . 26053) (\TEDIT.DISPLAY.DIACRITIC 26055 . 27049)) (27126 27956 (
|
||||
\TEDIT.SCALEREGION 27136 . 27954)) (28215 31755 (TEDIT.HARDCOPYFN 28225 . 29530) (
|
||||
\TEDIT.HARDCOPYFILEFN 29532 . 30093) (\TEDIT.POSTSCRIPT.HARDCOPY 30095 . 31026) (\TEDIT.PRESS.HARDCOPY
|
||||
31028 . 31753)) (33018 33819 (TEDIT-BOOK 33028 . 33817)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,21 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154 33348
|
||||
(FILECREATED "16-Mar-2025 18:50:43" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;225 53719
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.UNDO)
|
||||
:CHANGES-TO (FNS \TEDIT.UNDO1 TEDIT.REDO)
|
||||
|
||||
:PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
|
||||
:PREVIOUS-DATE "15-Mar-2025 22:42:11" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;224)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
||||
|
||||
(RPAQQ TEDIT-HISTORYCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT)
|
||||
(MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH)
|
||||
))
|
||||
(MACROS \TEDIT.LASTEVENT GETTH SETTH)))
|
||||
(FNS \TEDIT.HISTORYEVENT.DEFPRINT)
|
||||
(MACROS \TEDIT.HISTORYADD1)
|
||||
(INITRECORDS TEDITHISTORYEVENT)
|
||||
(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
|
||||
(INITVARS (TEDIT.HISTORY.TYPELST NIL)
|
||||
@@ -23,13 +23,16 @@
|
||||
(COMS
|
||||
(* ;; "History-list maintenance functions")
|
||||
|
||||
(FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
|
||||
(FNS \TEDIT.HISTORYADD \TEDIT.HISTORYADD.COMPOSITE \TEDIT.CUMULATE.EVENTS
|
||||
\TEDIT.COMPOSITE.EVENT \TEDIT.HISTORY.PROP \TEDIT.HISTORY.EVENT \TEDIT.POPEVENT))
|
||||
(COMS
|
||||
(* ;; "Specialized UNDO & REDO functions.")
|
||||
|
||||
(FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
|
||||
(FNS \TEDIT.UNDO.INSERTION \TEDIT.UNDO.DELETION \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE)
|
||||
(FNS \TEDIT.REDO.INSERTION \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE))))
|
||||
(FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE
|
||||
\TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS
|
||||
\TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE)
|
||||
(FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -47,16 +50,16 @@
|
||||
NIL (* ;
|
||||
"Was THAUXINFO: Auxiliary info about the event, primarily for redo")
|
||||
THDELETEDPIECES)
|
||||
[ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT
|
||||
THCH#) of DATUM)
|
||||
(IPLUS (fetch (
|
||||
[ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (
|
||||
TEDITHISTORYEVENT
|
||||
THCH#)
|
||||
of DATUM)
|
||||
(fetch (
|
||||
THCH#)
|
||||
of DATUM)
|
||||
0)
|
||||
(OR (fetch (
|
||||
TEDITHISTORYEVENT
|
||||
THLEN)
|
||||
of DATUM]
|
||||
THLEN)
|
||||
of DATUM)
|
||||
0]
|
||||
(INIT (DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT
|
||||
)))
|
||||
THPOINT _ 'LEFT)
|
||||
@@ -80,9 +83,6 @@
|
||||
(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ)
|
||||
(CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
|
||||
(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ)
|
||||
(pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
|
||||
(PUTPROPS GETTH MACRO ((EVENT FIELD)
|
||||
(fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
||||
|
||||
@@ -114,6 +114,15 @@
|
||||
(CDR LOC)
|
||||
"}"])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \TEDIT.HISTORYADD1 MACRO ((TEXTOBJ EVENT)
|
||||
|
||||
(* ;; "This is the primitive, to be upgraded if we go to a ring.")
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
|
||||
EVENT)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
@@ -144,7 +153,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.HISTORYADD
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Mar-2024 12:15 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Dec-2024 17:32 by rmk")
|
||||
(* ; "Edited 29-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 21:57 by rmk")
|
||||
(* ; "Edited 30-Apr-2024 22:51 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:15 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 12:09 by rmk")
|
||||
(* ; "Edited 30-Dec-2023 22:19 by rmk")
|
||||
(* ; "Edited 11-Aug-2023 14:25 by rmk")
|
||||
@@ -158,55 +171,75 @@
|
||||
|
||||
(* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards. Old code seemed to treat those as separate events, and only the second/right one could be undone.")
|
||||
|
||||
(CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY))
|
||||
(if (type? TEDITHISTORYEVENT EVENT)
|
||||
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
|
||||
(CONSTANT (LIST :Put :Get))) (* ;
|
||||
(if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
then
|
||||
(* ;; "Maybe the first event after setting the textprop--now's the time to flush")
|
||||
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
|
||||
else (if (type? TEDITHISTORYEVENT EVENT)
|
||||
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
|
||||
(CONSTANT (LIST :Put :Get)))
|
||||
(* ;
|
||||
"Can't back up over Put/Get, flush the history.")
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
|
||||
|
||||
(* ;; "Somebody may have already done there own fixup.")
|
||||
(* ;; "Somebody may have already done there own fixup.")
|
||||
|
||||
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH EVENT THACTION))
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION)))
|
||||
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH EVENT THACTION))
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION)))
|
||||
|
||||
(* ;;
|
||||
"Repeated successive deletions, we can combine them if they are adjacent.")
|
||||
(* ;;
|
||||
"Repeated successive deletions, we can combine them if they are adjacent.")
|
||||
|
||||
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
|
||||
(GETTH OLDEVENT THCH#))
|
||||
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
|
||||
(GETTH OLDEVENT THCH#))
|
||||
(* ;
|
||||
"OLDEVENT is first, EVENT is still delete")
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
|
||||
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
|
||||
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
|
||||
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
|
||||
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
|
||||
|
||||
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
|
||||
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
|
||||
|
||||
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION))
|
||||
(IEQP (GETTH OLDEVENT THCHLIM)
|
||||
(IPLUS (GETTH EVENT THCH#)
|
||||
(GETTH OLDEVENT THLEN]
|
||||
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
|
||||
(EQ :Delete (GETTH OLDEVENT THACTION))
|
||||
(IEQP (GETTH OLDEVENT THCHLIM)
|
||||
(IPLUS (GETTH EVENT THCH#)
|
||||
(GETTH OLDEVENT THLEN]
|
||||
|
||||
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
|
||||
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
|
||||
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
|
||||
(\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(push (GETTOBJ TEXTOBJ TXTHISTORY)
|
||||
EVENT))
|
||||
elseif (LISTP EVENT)
|
||||
then
|
||||
(* ;; "A monolithic sequence of undoable events")
|
||||
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
|
||||
(\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
|
||||
elseif (LISTP EVENT)
|
||||
then
|
||||
(* ;; "A monolithic sequence of undoable events")
|
||||
|
||||
(push (GETTOBJ TEXTOBJ TXTHISTORY)
|
||||
EVENT)))
|
||||
(* ;; "SHOULDNT HAPPEN ?")
|
||||
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
|
||||
EVENT])
|
||||
|
||||
(\TEDIT.HISTORYADD.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 6-Feb-2025 15:31 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:31 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:47 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 08:02 by rmk")
|
||||
(* ; "Edited 8-May-2024 12:34 by rmk")
|
||||
(SETQ EVENTS (REMOVE NIL EVENTS))
|
||||
(CL:WHEN EVENTS
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL
|
||||
EVENTS)
|
||||
(CAR EVENTS))))])
|
||||
|
||||
(\TEDIT.CUMULATE.EVENTS
|
||||
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 8-Dec-2024 17:35 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 12:15 by rmk")
|
||||
(* ; "Edited 3-Jun-2023 17:09 by rmk")
|
||||
(* ; "Edited 27-May-2023 00:54 by rmk")
|
||||
@@ -222,8 +255,68 @@
|
||||
(SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
|
||||
(GETTH EVENT2 THDELETEDPIECES)
|
||||
TEXTOBJ))
|
||||
(SETTH EVENT1 THLEN (fetch (SELPIECES SPLEN) of (GETTH EVENT1 THDELETEDPIECES)))
|
||||
(SETTH EVENT1 THLEN (GETSPC (GETTH EVENT1 THDELETEDPIECES)
|
||||
SPLEN))
|
||||
EVENT1])
|
||||
|
||||
(\TEDIT.COMPOSITE.EVENT
|
||||
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 18:47 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 08:02 by rmk")
|
||||
(* ; "Edited 8-May-2024 12:34 by rmk")
|
||||
(CL:WHEN EVENTS
|
||||
(\TEDIT.HISTORYADD (CL:IF (CDR EVENTS)
|
||||
(\TEDIT.HISTORY.EVENT TEXTOBJ (OR ACTION :Composite)
|
||||
NIL NIL NIL NIL NEWEVENTS)
|
||||
(CAR EVENTS))))])
|
||||
|
||||
(\TEDIT.HISTORY.PROP
|
||||
[LAMBDA (TEXTOBJ SETNEWVALUE NEWVALUE) (* ; "Edited 22-Sep-2024 08:42 by rmk")
|
||||
|
||||
(* ;; "Called fromTEDIT.TEXT.PROP to manage the history list. History is ON by default, and the events always correspond to the current state of the document. If it's OFF, the next document-changing event will cause HISTORYADD to flush the past and no further events will be recorded until it is turned ON again to start a new epoch. CLEAR flushes old events but then turns on collection.")
|
||||
|
||||
(PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
'OFF
|
||||
'ON)
|
||||
(CL:WHEN SETNEWVALUE
|
||||
(SELECTQ NEWVALUE
|
||||
((ON T)
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
|
||||
((OFF NIL)
|
||||
(* ;;
|
||||
"HISTORYADD will wipe out everything the next time it is called event--gives a chance to back out")
|
||||
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE T))
|
||||
(CLEAR (* ;
|
||||
"Wipes out current history now, then resumes collection")
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
|
||||
(\ILLEGAL.ARG NEWVALUE))))])
|
||||
|
||||
(\TEDIT.HISTORY.EVENT
|
||||
[LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)
|
||||
(* ; "Edited 26-Sep-2024 15:44 by rmk")
|
||||
(* ; "Edited 23-Sep-2024 16:47 by rmk")
|
||||
|
||||
(* ;; "Don't create if it's inactive")
|
||||
|
||||
(CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
|
||||
(CL:WHEN (AND (NULL LEN)
|
||||
(type? SELPIECES CH#))
|
||||
(SETQ LEN (fetch (SELPIECES SPLEN) of CH#))
|
||||
(SETQ CH# (fetch (SELPIECES SPFIRSTCHAR) of CH#)))
|
||||
(create TEDITHISTORYEVENT
|
||||
THACTION _ ACTION
|
||||
THCH# _ CH#
|
||||
THLEN _ LEN
|
||||
THPOINT _ (OR POINT 'LEFT)
|
||||
THFIRSTPIECE _ FIRSTPIECE
|
||||
THOLDINFO _ OLDINFO
|
||||
THDELETEDPIECES _ DELETEDPIECES))])
|
||||
|
||||
(\TEDIT.POPEVENT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2024 21:24 by rmk")
|
||||
(pop (GETTOBJ TEXTOBJ TXTHISTORY])
|
||||
)
|
||||
|
||||
|
||||
@@ -233,7 +326,15 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.UNDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 13-Mar-2025 15:47 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 19:41 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:17 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 10:49 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 21:21 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 11:04 by rmk")
|
||||
(* ; "Edited 8-May-2024 11:16 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 7-Mar-2024 12:48 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 20:02 by rmk")
|
||||
@@ -246,95 +347,127 @@
|
||||
|
||||
(* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.")
|
||||
|
||||
(TEXTOBJ! TEXTOBJ)
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
|
||||
(* ;; "Only undo things if the document is allowed to change.")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "" T)
|
||||
(PROG ((SEL (TEXTSEL TEXTOBJ))
|
||||
(EVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
PREVEVENTS UNDOEVENT)
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
EVENT PREVEVENT UNDOEVENT)
|
||||
(CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(RETURN))
|
||||
(SETQ EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
|
||||
(RETURN))
|
||||
(CL:WHEN (MEMB (GETTH EVENT THACTION)
|
||||
'(:Get :Put))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
|
||||
T)
|
||||
(RETURN))
|
||||
(SETQ EVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) (* ;
|
||||
"So we can test for the undoundo event.")
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Nothing to undo" T)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ")
|
||||
(* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ")
|
||||
|
||||
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
|
||||
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
|
||||
|
||||
(SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY))
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(\TEDIT.UNDO1 TEXTOBJ EVENT)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UNDO1 TSTREAM EVENT)
|
||||
|
||||
(* ;; "Get the event that undid EVENT")
|
||||
(* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")
|
||||
|
||||
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS)
|
||||
(CL:WHEN [OR (NULL PREVEVENTS)
|
||||
(AND (type? TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS)))
|
||||
(MEMB (GETTH (CAR PREVEVENTS)
|
||||
THACTION)
|
||||
(CONSTANT (LIST :Get :Put]
|
||||
(SETTOBJ TEXTOBJ \DIRTY NIL))
|
||||
(CL:UNLESS (EQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(CL:WHEN [OR (NULL PREVEVENT)
|
||||
(MEMB (GETTH PREVEVENT THACTION)
|
||||
(CONSTANT (LIST :Get :Put]
|
||||
(FSETTOBJ TEXTOBJ \DIRTY NIL))
|
||||
(CL:UNLESS NOUNDOUNDO
|
||||
|
||||
(* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing.")
|
||||
(* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing by redoing the original event.")
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ)
|
||||
(LIST (CAR PREVEVENTS)
|
||||
UNDOEVENT EVENT))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T)))])
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
|
||||
(LIST PREVEVENT UNDOEVENT EVENT)))
|
||||
(\TEDIT.FIXSEL SEL TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO1
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 4-Mar-2024 14:55 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 16-Mar-2025 18:46 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 13:56 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 13:51 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 21:41 by rmk")
|
||||
(* ; "Edited 19-Aug-2024 00:11 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 23:42 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:10 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 14:55 by rmk")
|
||||
(* ; "Edited 16-Jul-2023 11:14 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:50 by rmk")
|
||||
(* ; "Edited 25-May-2023 00:33 by rmk")
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy)
|
||||
(\TEDIT.UNDO.INSERTION TEXTOBJ EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT))
|
||||
(:Delete (* ; "Deletion or case-shift")
|
||||
(\TEDIT.UNDO.DELETION TEXTOBJ EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT))
|
||||
(:Looks (* ; "Character-looks change")
|
||||
(\TEDIT.UNDO.LOOKS TEXTOBJ EVENT))
|
||||
(:ParaLooks (* ; "PARA looks change")
|
||||
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (GETTH EVENT THOLDINFO)
|
||||
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ
|
||||
TXTPAGEFRAMES)))
|
||||
]
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT))
|
||||
((LIST :Replace :LowerCase :UpperCase)
|
||||
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
|
||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
|
||||
(CL:WHEN (GETTH EVENT THCH#)
|
||||
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT)
|
||||
(\TEDIT.SHOWSEL NIL T TEXTOBJ)
|
||||
(\TEDIT.SCROLL.CARET TSTREAM))
|
||||
(PROG1 (SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy)
|
||||
(\TEDIT.UNDO.INSERT TEXTOBJ EVENT))
|
||||
(:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT))
|
||||
(:Delete (* ; "Deletion or case-shift")
|
||||
(\TEDIT.UNDO.DELETE TEXTOBJ EVENT))
|
||||
(:CharLooks (* ; "Character-looks change")
|
||||
(\TEDIT.UNDO.CHARLOOKS TEXTOBJ EVENT))
|
||||
(:ParaLooks (* ; "PARA looks change")
|
||||
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
|
||||
(:PageFormat (* ; "Pageframe change")
|
||||
(\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT))
|
||||
((LIST :Replace :Transform)
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:Closefile (* ; "Closes an included file")
|
||||
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
|
||||
(CLOSEF? (GETTH EVENT THOLDINFO))))
|
||||
((LIST :Get :Put) (* ;
|
||||
(* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")
|
||||
|
||||
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT))
|
||||
(:Closefile (* ; "Closes an included file")
|
||||
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
|
||||
(CLOSEF? (GETTH EVENT THOLDINFO))))
|
||||
(:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT))
|
||||
((LIST :Get :Put) (* ;
|
||||
"He did a GET or PUT-- not undoable.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
|
||||
T))
|
||||
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
|
||||
TEDIT.HISTORY.TYPELST]
|
||||
(COND
|
||||
(UNDOFN
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION
|
||||
))
|
||||
T))
|
||||
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
|
||||
TEDIT.HISTORY.TYPELST]
|
||||
(COND
|
||||
(UNDOFN
|
||||
|
||||
(* ;; "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
||||
(* ;;
|
||||
"<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
||||
|
||||
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT
|
||||
THACTION))
|
||||
T])
|
||||
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
|
||||
(GETTH EVENT THACTION))
|
||||
T])
|
||||
|
||||
(TEDIT.REDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2025 18:48 by rmk")
|
||||
(* ; "Edited 2-Feb-2025 11:28 by rmk")
|
||||
(* ; "Edited 8-Dec-2024 17:53 by rmk")
|
||||
(* ; "Edited 27-Nov-2024 23:11 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 16:49 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:58 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 07:41 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 21:08 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:13 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 21:33 by rmk")
|
||||
(* ; "Edited 2-Mar-2024 09:41 by rmk")
|
||||
(* ; "Edited 21-Dec-2023 11:57 by rmk")
|
||||
@@ -343,71 +476,83 @@
|
||||
|
||||
(* ;; "REDO the last thing this guy did.")
|
||||
|
||||
(CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
|
||||
(PROG ((SEL (GETTOBJ TEXTOBJ SEL))
|
||||
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
CH)
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
|
||||
(RETURN))
|
||||
(CL:UNLESS (GETSEL SEL SET)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
|
||||
(RETURN))
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (GETTOBJ TEXTOBJ SEL))
|
||||
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
CH)
|
||||
(CL:WHEN (\TEDIT.READONLY TEXTOBJ)
|
||||
(RETURN NIL))
|
||||
(CL:UNLESS EVENT
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
|
||||
(RETURN))
|
||||
(CL:UNLESS (GETSEL SEL SET)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "There really is something to redo and something to do it to.")
|
||||
(* ;; "There really is something to redo and something to do it to.")
|
||||
|
||||
(\TEDIT.SHOWSEL SEL NIL)
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
|
||||
(\TEDIT.REDO.INSERTION TEXTOBJ EVENT SEL))
|
||||
(:Delete (* ; "It was a deletion")
|
||||
(\TEDIT.DELETE TEXTOBJ SEL))
|
||||
(:Replace (* ;
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(SELECTC (GETTH EVENT THACTION)
|
||||
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
|
||||
(\TEDIT.REDO.INSERT TEXTOBJ EVENT SEL))
|
||||
(:Delete (* ; "It was a deletion")
|
||||
(\TEDIT.DELETE TEXTOBJ SEL))
|
||||
(:Replace (* ;
|
||||
"It was a replacement (a del/insert combo)")
|
||||
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(:Looks (* ; "It was a character looks change")
|
||||
(TEDIT.LOOKS TEXTOBJ (PLOOKS (GETTH EVENT THFIRSTPIECE))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(TEDIT.PARALOOKS TEXTOBJ (PPARALOOKS (GETTH EVENT THFIRSTPIECE))
|
||||
SEL))
|
||||
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
|
||||
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
|
||||
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
|
||||
(:Transform (\TEDIT.KEY.TRANSFORM TSTREAM (GETTH EVENT THOLDINFO)))
|
||||
(:LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.LCASE.SEL TSTREAM TEXTOBJ SEL))
|
||||
(:UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.UCASE.SEL TSTREAM TEXTOBJ SEL))
|
||||
(:InitialCap (\TEDIT.KEY.INITIALCAP TSTREAM TEXTOBJ SEL))
|
||||
(:CharLooks (* ; "It was a character looks change")
|
||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
|
||||
SEL))
|
||||
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
|
||||
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
|
||||
(* (* ;; "RESTLST ?")
|
||||
(AND NIL (RESETSAVE (CURSOR
|
||||
WAITINGCURSOR))) (TEDIT.PROMPTPRINT
|
||||
TEXTOBJ "Searching..." T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of
|
||||
TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL)
|
||||
(SETQ CH (TEDIT.FIND TEXTOBJ
|
||||
TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL
|
||||
TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
|
||||
(GETTH EVENT THAUXINFO)))
|
||||
(COND (CH (TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"done.") (\TEDIT.UPDATE.SEL SEL CH
|
||||
(NCHARS (GETTH EVENT THAUXINFO))
|
||||
(QUOTE RIGHT)) (\TEDIT.FIXSEL SEL
|
||||
TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(\TEDIT.SHOWSEL SEL T))
|
||||
(\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"[Not found]"))))
|
||||
)
|
||||
(:Move (* ; "He moved some text")
|
||||
(\TEDIT.REDO.MOVE TEXTOBJ EVENT (GETTH EVENT THLEN)
|
||||
(IMAX 1 (TEDIT.GETPOINT NIL SEL))
|
||||
(GETTH EVENT THFIRSTPIECE)))
|
||||
((LIST :Get :Put) (* ; "Why can't you redo a get or put ?")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
|
||||
" isn't implemented.")
|
||||
T))
|
||||
(\TEDIT.SHOWSEL SEL T)))])
|
||||
)
|
||||
(:Move
|
||||
(* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place. The insert part is probably OK--that maps to the :Insert clause above.")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(:Composite (\TEDIT.REDO.COMPOSITE TEXTOBJ EVENT SEL))
|
||||
((LIST :Get :Put NIL) (* ; "Why can't you redo a get or put ?")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
|
||||
T T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
|
||||
" isn't implemented.")
|
||||
T))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO.UNDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 21:27 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 18:24 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 22:57 by rmk")
|
||||
(* ; "Edited 22-Sep-2024 11:08 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 23:45 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 09:50 by rmk")
|
||||
(* ; "Edited 3-Mar-2024 21:27 by rmk")
|
||||
(* ; "Edited 13-Jun-2023 15:05 by rmk")
|
||||
(* ; "Edited 3-Jun-2023 23:04 by rmk")
|
||||
(* ; "Edited 1-Jun-2023 23:53 by rmk")
|
||||
@@ -419,33 +564,34 @@
|
||||
|
||||
(* ;; "This makes sense only if the document is now in the state immediately after the undoing--if any other events have intervened, the character positions and the general state of the document are unrelated. So the elements of the undo list also contain the state of the (forward) history list after the undoing was undone. If we have moved back to the same point in history, we can do the undoing.")
|
||||
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "" T)
|
||||
(LET [(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
|
||||
(if (NULL LASTUNDONE)
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ "There is no action whose undoing can be reversed" T)
|
||||
elseif (EQ (CAR LASTUNDONE)
|
||||
(\TEDIT.LASTEVENT TEXTOBJ))
|
||||
then
|
||||
(* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
|
||||
(TEDIT.PROMPTCLEAR TSTREAM)
|
||||
(if (NULL LASTUNDONE)
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "There is no action whose undoing can be reversed")
|
||||
elseif (EQ (CAR LASTUNDONE)
|
||||
(\TEDIT.LASTEVENT TEXTOBJ))
|
||||
then
|
||||
(* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")
|
||||
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
|
||||
(CADR LASTUNDONE))
|
||||
(TEDIT.UNDO TEXTOBJ)
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ (CADR LASTUNDONE))
|
||||
(TEDIT.UNDO TSTREAM)
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Undo undone" T)
|
||||
|
||||
(* ;; "This saved what we just undid, don't want to keep reundoing it.")
|
||||
(* ;; "This undoing saved what we just undid, don't want to keep reundoing it.")
|
||||
|
||||
(pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
|
||||
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
|
||||
(CADDR LASTUNDONE))
|
||||
else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;
|
||||
(pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
|
||||
(\TEDIT.HISTORYADD1 TEXTOBJ (CADDR LASTUNDONE))
|
||||
else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;
|
||||
"If something else has happened, there are no undos to undo.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T])
|
||||
(TEDIT.PROMPTPRINT TSTREAM "Cannot undo the previous undo" T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.UNDO.INSERTION
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-2023 22:54 by rmk")
|
||||
(\TEDIT.UNDO.INSERT
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Jul-2024 00:07 by rmk")
|
||||
(* ; "Edited 30-May-2023 22:54 by rmk")
|
||||
(* ; "Edited 26-May-2023 23:49 by rmk")
|
||||
(* ; "Edited 24-May-2023 23:53 by rmk")
|
||||
(* ; "Edited 2-May-2023 23:26 by rmk")
|
||||
@@ -453,11 +599,13 @@
|
||||
|
||||
(* ;; "UNDO a prior Insert, Copy, or Include. ")
|
||||
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
EVENT])
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT)
|
||||
TEXTOBJ])
|
||||
|
||||
(\TEDIT.UNDO.DELETION
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(\TEDIT.UNDO.DELETE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 29-Sep-2024 00:23 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:31 by rmk")
|
||||
(* ; "Edited 27-May-2023 23:39 by rmk")
|
||||
(* ; "Edited 21-Apr-93 12:01 by jds")
|
||||
@@ -470,65 +618,212 @@
|
||||
(GETTH EVENT THCH#])
|
||||
|
||||
(\TEDIT.UNDO.MOVE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 19:38 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 14:12 by rmk")
|
||||
(* ; "Edited 29-Sep-2024 00:23 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:50 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 10:17 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 4-Mar-2024 16:08 by rmk")
|
||||
|
||||
(* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense. The deleted string would reappear in some random place.")
|
||||
(* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)")
|
||||
|
||||
(LET ((DELEVENT (CAR (GETTH EVENT THOLDINFO)))
|
||||
(FOBJ (CDR (GETTH EVENT THOLDINFO)))
|
||||
(SEL (FGETTOBJ TEXTOBJ SEL)))
|
||||
(\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL SEL EVENT))
|
||||
(* ; "Undo the insert in this document")
|
||||
(CL:WHEN (GETTH EVENT THDELETEDPIECES) (* ;
|
||||
":Move must have started as :Replace")
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
'INSERT TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(GETTH EVENT THCH#)))
|
||||
(if FOBJ
|
||||
then (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ))
|
||||
(* ;
|
||||
"Delete is last event in other document")
|
||||
(TEDIT.UNDO FOBJ))
|
||||
else (\TEDIT.UNDO1 TEXTOBJ DELEVENT))
|
||||
|
||||
(* ;; "Put the point back after the original target. Caller wil fix it.")
|
||||
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T])
|
||||
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||
(SEL (TEXTSEL TEXTOBJ))
|
||||
(REPLACE (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
|
||||
THACTION]
|
||||
(\TEDIT.UNDO.COMPOSITE TSTREAM EVENT)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL (if REPLACE
|
||||
then (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
|
||||
'PENDINGDEL
|
||||
else 'NORMAL))
|
||||
(\TEDIT.FIXSEL SEL TSTREAM)
|
||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2025 22:35 by rmk")
|
||||
(* ; "Edited 13-Sep-2024 23:50 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 30-May-2023 23:10 by rmk")
|
||||
(* ; "Edited 27-May-2023 16:49 by rmk")
|
||||
(* ; "Edited 24-May-2023 22:43 by rmk")
|
||||
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.")
|
||||
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, uppercase, or initialcap.")
|
||||
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
|
||||
(\TEDIT.UNDO.CHARLOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 21:59 by rmk")
|
||||
(* ; "Edited 28-Sep-2024 22:37 by rmk")
|
||||
(* ; "Edited 26-Sep-2024 16:06 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 22:11 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:54 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:21 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 11:32 by rmk")
|
||||
(* ; "Edited 14-Dec-2023 21:01 by rmk")
|
||||
(* ; "Edited 30-May-2023 22:56 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:56 by rmk")
|
||||
(* ; "Edited 30-May-91 21:44 by jds")
|
||||
|
||||
(* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed. We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece")
|
||||
|
||||
(for U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
|
||||
TEXTOBJ))
|
||||
(CHNO _ (GETTH EVENT THCH#))
|
||||
(SEL _ (FGETTOBJ TEXTOBJ SEL))
|
||||
(CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in (CDR (GETTH EVENT THOLDINFO))
|
||||
do
|
||||
(* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")
|
||||
|
||||
(* ;; "Perhaps we should also save the CHNO of the CARETPC")
|
||||
|
||||
(SETQ NEXTCHNO (CAR U))
|
||||
(SETQ OLDLOOKS (CDR U))
|
||||
(CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
|
||||
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
|
||||
[push NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC]
|
||||
|
||||
(* ;; "U starts at the first piece. We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...)) But then, what about the last piece. Maybe we have to do our own popping, or look at UTAIL. Or end in (NEXTPC-CHNO . NIL ). Or text for IGEQ THCHLIM")
|
||||
|
||||
(for P inpieces PC do (FSETPC P PLOOKS OLDLOOKS)
|
||||
(add CHNO (PLEN P))
|
||||
(CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run")
|
||||
(SETQ PC P)
|
||||
(RETURN))) finally
|
||||
|
||||
(* ;;
|
||||
"Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
|
||||
|
||||
(CL:WHEN NEWUNDOLIST
|
||||
(change (GETTH EVENT THOLDINFO)
|
||||
(CONS (CAR DATUM)
|
||||
(DREVERSE NEWUNDOLIST)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
|
||||
'NORMAL)
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"Character looks restored" T))
|
||||
|
||||
(* ;;
|
||||
"Save the event for REDO, even if these pieces didn't change")
|
||||
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.PARALOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 22:00 by rmk")
|
||||
(* ; "Edited 28-Sep-2024 22:38 by rmk")
|
||||
(* ; "Edited 27-Sep-2024 12:23 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 22:10 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:54 by rmk")
|
||||
(* ; "Edited 18-May-2024 16:22 by rmk")
|
||||
(* ; "Edited 19-Feb-2024 11:32 by rmk")
|
||||
(* ; "Edited 11-Dec-2023 11:10 by rmk")
|
||||
(* ; "Edited 21-Sep-2023 23:51 by rmk")
|
||||
(* ; "Edited 30-May-2023 22:55 by rmk")
|
||||
(* ; "Edited 18-Apr-2023 23:57 by rmk")
|
||||
(* ; "Edited 30-May-91 21:44 by jds")
|
||||
|
||||
(* ;; "Undo the setting of paragraph looks.")
|
||||
|
||||
(for U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
|
||||
TEXTOBJ))
|
||||
(CHNO _ (GETTH EVENT THCH#))
|
||||
(SEL _ (FGETTOBJ TEXTOBJ SEL)) in (CDR (GETTH EVENT THOLDINFO))
|
||||
do
|
||||
(* ;; "Find the first piece of the next changed paragraph")
|
||||
|
||||
(for P inpieces PC do (CL:WHEN (IEQP CHNO (CAR U))
|
||||
(SETQ PC P)
|
||||
(RETURN))
|
||||
(add CHNO (PLEN P)))
|
||||
(SETQ OLDLOOKS (CDR U))
|
||||
(push NEWUNDOLIST (CONS CHNO (PPARALOOKS PC))) (* ; "Save for UNDO UNDO")
|
||||
|
||||
(* ;; "Change all the pieces in this paragraph")
|
||||
|
||||
(for P inpieces PC do (FSETPC P PPARALOOKS OLDLOOKS)
|
||||
(CL:WHEN (PPARALAST P)
|
||||
(SETQ PC P)
|
||||
(RETURN))
|
||||
(add CHNO (PLEN P))) finally
|
||||
|
||||
(* ;;
|
||||
"Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
|
||||
|
||||
(CL:WHEN NEWUNDOLIST
|
||||
(change (GETTH EVENT THOLDINFO)
|
||||
(CONS (CAR DATUM)
|
||||
(DREVERSE NEWUNDOLIST)))
|
||||
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
|
||||
'NORMAL)
|
||||
(\TEDIT.UPDATE.LINES TEXTOBJ
|
||||
'LOOKS
|
||||
(GETTH EVENT THCH#)
|
||||
(GETTH EVENT THLEN))
|
||||
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ
|
||||
"Paragraph looks restored" T))
|
||||
|
||||
(* ;;
|
||||
"Save the event for REDO, even if these pieces didn't change")
|
||||
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.PAGELOOKS
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 12-Aug-2024 10:28 by rmk")
|
||||
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
|
||||
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T)
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(\TEDIT.UNDO.COMPOSITE
|
||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 15:47 by rmk")
|
||||
(* ; "Edited 25-Nov-2024 22:27 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 10:14 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:17 by rmk")
|
||||
|
||||
(* ;; "A composite event is a group of other events that are to be undone at the same time. Only show the selection of the last undo event. We want to end up with a single event on history. We don't want to bump the count. (Presumably EVENT was alread popped)")
|
||||
|
||||
(for E EVENTS CUREVENT (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) in (GETTH EVENT THOLDINFO)
|
||||
do (SETQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))
|
||||
(\TEDIT.UNDO1 TSTREAM E)
|
||||
(CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ)))
|
||||
(\TEDIT.SHOWSEL NIL NIL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))
|
||||
(\TEDIT.SCROLL.CARET TSTREAM])
|
||||
|
||||
(\TEDIT.UNDO.REPLACECODE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 23-Sep-2024 00:45 by rmk")
|
||||
(TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
|
||||
(GETTH EVENT THOLDINFO])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.REDO.INSERTION
|
||||
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(\TEDIT.REDO.INSERT
|
||||
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Aug-2024 10:47 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 31-May-2023 10:26 by rmk")
|
||||
(* ; "Edited 18-May-2023 19:24 by rmk")
|
||||
(* ; "Edited 21-Apr-93 01:06 by jds")
|
||||
|
||||
(* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret. We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.")
|
||||
|
||||
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
'INSERT TEXTOBJ)
|
||||
TEXTOBJ SEL])
|
||||
|
||||
(\TEDIT.REDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 7-Jul-2024 11:59 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 13:54 by rmk")
|
||||
(* ; "Edited 2-Oct-2023 11:43 by rmk")
|
||||
(* ; "Edited 31-May-2023 10:25 by rmk")
|
||||
(* ; "Edited 27-May-2023 11:16 by rmk")
|
||||
@@ -540,31 +835,25 @@
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
|
||||
NIL TEXTOBJ)
|
||||
TEXTOBJ
|
||||
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
(\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
|
||||
EVENT))
|
||||
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
|
||||
THACTION ACTION])
|
||||
|
||||
(\TEDIT.REDO.MOVE
|
||||
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 15-Mar-2024 13:36 by rmk")
|
||||
(* ; "Edited 16-Feb-2024 23:36 by rmk")
|
||||
(* ; "Edited 7-Jun-2023 23:19 by rmk")
|
||||
(* ; "Edited 27-May-2023 11:18 by rmk")
|
||||
(* ; "Edited 23-May-2023 12:54 by rmk")
|
||||
(* ; "Edited 30-May-91 21:28 by jds")
|
||||
(LET ((SCR2 (GETTOBJ TEXTOBJ SCRATCHSEL2)))
|
||||
(\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#)
|
||||
LEN)
|
||||
(SETSEL SCR2 SET T)
|
||||
(\TEDIT.FIXSEL SCR2 TEXTOBJ)
|
||||
(\TEDIT.SET.SEL.LOOKS SCR2 'MOVE)
|
||||
(TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL])
|
||||
(\TEDIT.REDO.COMPOSITE
|
||||
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:12 by rmk")
|
||||
(\TEDIT.THELP 'Redo-composite])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD
|
||||
6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) (
|
||||
\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162
|
||||
(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 .
|
||||
29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) (
|
||||
\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323)))))
|
||||
(FILEMAP (NIL (4909 5930 (\TEDIT.HISTORYEVENT.DEFPRINT 4919 . 5928)) (7020 17605 (\TEDIT.HISTORYADD
|
||||
7030 . 11891) (\TEDIT.HISTORYADD.COMPOSITE 11893 . 12799) (\TEDIT.CUMULATE.EVENTS 12801 . 14395) (
|
||||
\TEDIT.COMPOSITE.EVENT 14397 . 15133) (\TEDIT.HISTORY.PROP 15135 . 16498) (\TEDIT.HISTORY.EVENT 16500
|
||||
. 17429) (\TEDIT.POPEVENT 17431 . 17603)) (17658 36127 (TEDIT.UNDO 17668 . 22227) (\TEDIT.UNDO1 22229
|
||||
. 26541) (TEDIT.REDO 26543 . 33281) (\TEDIT.UNDO.UNDO 33283 . 36125)) (36128 51335 (
|
||||
\TEDIT.UNDO.INSERT 36138 . 37051) (\TEDIT.UNDO.DELETE 37053 . 37847) (\TEDIT.UNDO.MOVE 37849 . 39438)
|
||||
(\TEDIT.UNDO.REPLACE 39440 . 40657) (\TEDIT.UNDO.CHARLOOKS 40659 . 45233) (\TEDIT.UNDO.PARALOOKS 45235
|
||||
. 49467) (\TEDIT.UNDO.PAGELOOKS 49469 . 49878) (\TEDIT.UNDO.COMPOSITE 49880 . 51107) (
|
||||
\TEDIT.UNDO.REPLACECODE 51109 . 51333)) (51336 53696 (\TEDIT.REDO.INSERT 51346 . 52079) (
|
||||
\TEDIT.REDO.REPLACE 52081 . 53412) (\TEDIT.REDO.COMPOSITE 53414 . 53694)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239 66617
|
||||
(FILECREATED " 8-Feb-2025 20:56:54" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;248 68998
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.INSERTPIECES)
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
|
||||
:PREVIOUS-DATE " 7-Feb-2025 08:31:28" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;246)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -25,7 +25,7 @@
|
||||
(RECORDS BTREENODE BTSLOT)
|
||||
(MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT
|
||||
\FINDSLOT)
|
||||
(MACROS \LASTPIECEP)
|
||||
(MACROS \SUFFIXPIECEP)
|
||||
(I.S.OPRS inslots inpieces backpieces))
|
||||
(MACROS \INSURE.VACANT.BTREESLOT)
|
||||
(ADDVARS (INSPECTDONTSORTFIELDS BTREENODE)))
|
||||
@@ -138,9 +138,9 @@
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ))
|
||||
PC)))
|
||||
(PUTPROPS \SUFFIXPIECEP MACRO (OPENLAMBDA (PC TOBJ)
|
||||
(AND (EQ PC (FGETTOBJ TOBJ SUFFIXPIECE))
|
||||
PC)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -215,7 +215,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MAKEPCTB
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 12:41 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:09 by rmk")
|
||||
(* ; "Edited 8-Sep-2023 16:30 by rmk")
|
||||
(* ; "Edited 26-Apr-2023 14:03 by rmk")
|
||||
@@ -236,8 +238,8 @@
|
||||
PLEN _ 0
|
||||
PTREENODE _ NODE
|
||||
PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC)))
|
||||
(FSETTOBJ TEXTOBJ LASTPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
PPARALOOKS _ (GETTOBJ TEXTOBJ DEFAULTPARALOOKS)))
|
||||
(FSETTOBJ TEXTOBJ SUFFIXPIECE (ffetch (BTREENODE DOWN1) of NODE))
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ TEXTLEN 0)
|
||||
(FSETTOBJ TEXTOBJ PCTB (CONS NODE])
|
||||
@@ -272,19 +274,26 @@
|
||||
DELTA])
|
||||
|
||||
(\TEDIT.FIRSTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:02 by rmk")
|
||||
(* ; "Edited 21-Aug-2024 16:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 11-Apr-2023 12:54 by rmk")
|
||||
(* ; "Edited 24-Aug-2022 12:45 by rmk")
|
||||
(for (NODE _ (CAR (GETTOBJ TEXTOBJ PCTB))) by (ffetch (BTREENODE DOWN1) of NODE)
|
||||
(for (NODE _ (CAR (GETTOBJ (if (type? TEXTOBJ TEXTOBJ)
|
||||
then TEXTOBJ
|
||||
elseif (type? STREAM TEXTOBJ)
|
||||
then (fetch (TEXTSTREAM TEXTOBJ) of TEXTOBJ))
|
||||
PCTB))) by (ffetch (BTREENODE DOWN1) of NODE)
|
||||
unless (type? BTREENODE NODE) do
|
||||
|
||||
(* ;; "If we don't bottom out in a piece, something else is screwed up. But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")
|
||||
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
NODE])
|
||||
|
||||
(\TEDIT.DELETETREE
|
||||
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 17-Mar-2024 00:22 by rmk")
|
||||
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:22 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:23 by rmk")
|
||||
(* ; "Edited 26-Oct-2023 12:50 by rmk")
|
||||
(* ; "Edited 30-May-2023 08:58 by rmk")
|
||||
@@ -313,7 +322,7 @@
|
||||
|
||||
(bind TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE))
|
||||
first (SETQ OLDSLOT (\FINDSLOT PCNODE OLD))
|
||||
(CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE"))
|
||||
(CL:UNLESS OLDSLOT (\TEDIT.THELP "Piece/node not in PCNODE"))
|
||||
(CL:WHEN (EQ OLDSLOT LAST) (* ; "Just shrink by one")
|
||||
(\FILLSLOT OLDSLOT NIL 0)
|
||||
(GO $$OUT))
|
||||
@@ -377,16 +386,16 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.LASTPIECE
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Feb-2025 08:20 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:20 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 19:23 by rmk")
|
||||
(* ; "Edited 21-Aug-2022 17:13 by rmk")
|
||||
(* ; "Edited 16-Aug-2022 10:16 by rmk")
|
||||
(* ; "Edited 14-Apr-93 16:29 by jds")
|
||||
|
||||
(* ;; "Returns the LASTPIECE by running down the right side of the B-tree. Should be the same as (fetch LASTPIECE of TEXTOBJ). Argument can also be a node.")
|
||||
(* ;; "Returns the last real piece of the text, NIL for an empty document.")
|
||||
|
||||
(bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD)
|
||||
do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD])
|
||||
(PREVPIECE (FGETTOBJ TEXTOBJ SUFFIXPIECE])
|
||||
|
||||
(\TEDIT.PCTOCH
|
||||
[LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk")
|
||||
@@ -415,7 +424,8 @@
|
||||
of TOPNODE])
|
||||
|
||||
(\TEDIT.CHTOPC
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 7-Feb-2025 08:29 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 17:56 by rmk")
|
||||
(* ; "Edited 1-Nov-2023 23:29 by rmk")
|
||||
(* ; "Edited 13-Apr-2023 22:22 by rmk")
|
||||
(* ; "Edited 12-Apr-2023 09:49 by rmk")
|
||||
@@ -429,7 +439,7 @@
|
||||
|
||||
(* ;; "There are 2 acceleration cases:")
|
||||
|
||||
(* ;; " if CH# is after the current text length, the pseudo LASTPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
(* ;; " if CH# is after the current text length, the pseudo SUFFIXPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.")
|
||||
|
||||
(* ;; " If the TEXTOBJ contains a HINTPC and CH# is in the range HINTPCSTARTCH# and HINTPCSTARTCH#+PLEN-1, then HINTPC is returned. Others may cache that, but we cache it here too for repeated sequential calls.")
|
||||
|
||||
@@ -441,7 +451,7 @@
|
||||
(if (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (CL:WHEN TELL-PC-START?
|
||||
(SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN))))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
elseif (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC))
|
||||
(IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)))
|
||||
(ILESSP (IDIFFERENCE CH# STARTCH)
|
||||
@@ -457,7 +467,7 @@
|
||||
|
||||
(* ;; "When PCTB is a list of top-level BTNODES, we find the sub-tree that contains the global CH# piece, sum the TOTLEN's of all prior top-level nodes, retrieve the piece from the identified subtree after adjusting to its LOCAL#. START-OF-PIECE, if required, is globally correct.")
|
||||
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the LASTPIECE case above. Also look at \INSERTPIECE.")
|
||||
(* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the SUFFIXPIECE case above. Also look at \INSERTPIECE.")
|
||||
|
||||
(for old BASE-NODE NEXT in (FGETTOBJ TEXTOBJ PCTB)
|
||||
do (SETQ NEXT (IPLUS ALLPRIOR (ffetch (BTREENODE TOTLEN) of BASE-NODE)))
|
||||
@@ -504,18 +514,20 @@
|
||||
(RETURN NODE])
|
||||
|
||||
(\TEDIT.SET-TOTLEN
|
||||
[LAMBDA (PCNODE) (* ; "Edited 21-Oct-2023 17:22 by rmk")
|
||||
[LAMBDA (PCNODE) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:22 by rmk")
|
||||
(* ; "Edited 15-Aug-2022 17:15 by rmk")
|
||||
(* ; "Edited 9-May-93 15:40 by jds")
|
||||
|
||||
(* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")
|
||||
|
||||
(HELP 'NOTCALLED)
|
||||
(\TEDIT.THELP 'NOTCALLED)
|
||||
(replace (BTREENODE TOTLEN) of PCNODE with (for S inslots PCNODE sum (fetch (BTSLOT DLEN)
|
||||
of S])
|
||||
|
||||
(\TEDIT.MAKE.VACANT.BTREESLOT
|
||||
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:08 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:32 by rmk")
|
||||
(* ; "Edited 10-Jun-2023 00:13 by rmk")
|
||||
@@ -563,7 +575,7 @@
|
||||
(UNINTERRUPTABLY
|
||||
(replace (BTREENODE UPWARD) of BTNODE with PARENT)
|
||||
(RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB))
|
||||
(HELP "BTNODE NOT FOUND"))
|
||||
(\TEDIT.THELP "BTNODE NOT FOUND"))
|
||||
PARENT)))
|
||||
|
||||
(* ;; "Tree is still valid, but PARENT how has a needed empty slot.")
|
||||
@@ -620,16 +632,17 @@
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
|
||||
|
||||
(\TEDIT.LINKNEWPIECE
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Feb-2025 08:26 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:16 by rmk")
|
||||
|
||||
(* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain. This doesn't deal with the btree.")
|
||||
|
||||
(* ;; "NEXT=NIL denotes the last piece LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
(* ;; "NEXT=NIL denotes the last piece SUFFIXPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.")
|
||||
|
||||
(CL:UNLESS NEXT
|
||||
(SETQ NEXT (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)))
|
||||
(SETQ NEXT (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(LET ((NEXTPREV (PREVPIECE NEXT)))
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ)
|
||||
(freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\SUFFIXPIECEP NEXT TEXTOBJ)
|
||||
NEXT))
|
||||
(* ; "NIL for last piece")
|
||||
(freplace (PIECE PREVPIECE) of NEW with NEXTPREV) (* ;
|
||||
@@ -643,19 +656,22 @@
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
(* ;; "Takes PC out of the piece chain, linking prev and next around it.")
|
||||
|
||||
(HELP 'NOTCALLED?)
|
||||
(\TEDIT.THELP 'NOTCALLED?)
|
||||
(CL:WHEN PREV
|
||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
||||
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
||||
|
||||
(\TEDIT.SPLITPIECE
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
(* ; "Edited 28-Dec-2023 22:17 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 11:50 by rmk")
|
||||
@@ -687,7 +703,7 @@
|
||||
(CONSTANT (APPEND STRING.PTYPES FILE.PTYPES)))
|
||||
(* ;
|
||||
"Dont' want the error under the UNINTERRABPTABLY. Remove when everything is good.")
|
||||
(SHOULDNT "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
|
||||
(\TEDIT.THELP "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -722,7 +738,8 @@
|
||||
PC])
|
||||
|
||||
(\TEDIT.INSERTPIECE
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:28 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 23:05 by rmk")
|
||||
(* ; "Edited 9-Jun-2023 22:40 by rmk")
|
||||
@@ -731,15 +748,15 @@
|
||||
|
||||
(* ;; "Insert the piece NEWPC in front of the piece NEXTPC. At the end, NEWPC appears before NEXTPC in the piece tree, and all counts and lengths are consistent.")
|
||||
|
||||
(* ;; "The last piece LASTPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the lastpiece has its rightful place in the tree.")
|
||||
(* ;; "The last piece SUFFIXPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the suffix piece has its rightful place in the tree.")
|
||||
|
||||
(* ;; "Caller guarantees that the chain links of NEW can be smashed.")
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.INSERTPIECE 'START TEXTOBJ)
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(* ; "Inserting at the very end")
|
||||
(LET ((PCTB (FGETTOBJ TEXTOBJ PCTB))
|
||||
LASTTREECONS)
|
||||
@@ -775,7 +792,8 @@
|
||||
NEWPC])
|
||||
|
||||
(\TEDIT.INSERTPIECES
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 20-Mar-2024 10:55 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 21:08 by rmk")
|
||||
@@ -793,7 +811,7 @@
|
||||
(FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T)
|
||||
(CL:UNLESS NEXTPC
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
|
||||
(SETQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(for PC (PREVPC _ (PREVPIECE NEXTPC)) inpieces PIECES
|
||||
do
|
||||
(* ;; "This is a variant of \INSERTPIECE specialized for filling in an empty TEXTOBJ from a piece chain. Insertion always happens before NEXTPC, and the chain-links are not smashed. ")
|
||||
@@ -809,7 +827,7 @@
|
||||
|
||||
(* ;; "PC is the final piece of the chain")
|
||||
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))
|
||||
(CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
|
||||
(FSETPC PC NEXTPIECE NEXTPC))
|
||||
(FSETPC NEXTPC PREVPIECE PC)
|
||||
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES))
|
||||
@@ -817,7 +835,9 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
(* ; "Edited 4-Nov-2023 23:03 by rmk")
|
||||
(* ; "Edited 22-Oct-2023 11:43 by rmk")
|
||||
@@ -829,7 +849,7 @@
|
||||
|
||||
(* ;; "As the PC is deleted from the tree on each iteration, the original previous PREV piece is linked to PC's next, and the next PREVPIECE is linked to PREV so that the tree and the links are uninterruptably consistent.")
|
||||
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then LASTPIECE's PREVPIECE will be updated.")
|
||||
(* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then SUFFIXPIECE's PREVPIECE will be updated.")
|
||||
|
||||
(* ;; " Since the pieces are not unlinked on the fly, the tree may be invalid until all the pieces are gone.")
|
||||
|
||||
@@ -837,10 +857,11 @@
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
|
||||
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(SETQ PREV (PREVPIECE (fetch (SELPIECES SPFIRST) of SELPIECES)))
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
(SETQ NEXT (OR (NEXTPIECE (fetch (SELPIECES SPLAST) of SELPIECES))
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces SELPIECES
|
||||
(SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)))
|
||||
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
|
||||
do (UNINTERRUPTABLY
|
||||
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
|
||||
TEXTOBJ)
|
||||
@@ -856,14 +877,15 @@
|
||||
(* ;;
|
||||
"TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.")
|
||||
|
||||
(FSETPC (fetch (SELPIECES SPFIRST) of SELPIECES)
|
||||
(FSETPC (GETSPC SELPIECES SPFIRST)
|
||||
PREVPIECE NIL)
|
||||
(FSETPC (fetch (SELPIECES SPLAST) of SELPIECES)
|
||||
(FSETPC (GETSPC SELPIECES SPLAST)
|
||||
NEXTPIECE NIL))
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
|
||||
|
||||
(\TEDIT.ALIGNEDPIECE
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 7-Feb-2025 08:05 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 19:37 by rmk")
|
||||
(* ; "Edited 29-May-2023 23:48 by rmk")
|
||||
(* ; "Edited 20-May-2023 13:53 by rmk")
|
||||
@@ -878,7 +900,7 @@
|
||||
then
|
||||
(* ;; "Doesn't return NIL in this case, returns the last piece.")
|
||||
|
||||
(FGETTOBJ TEXTOBJ LASTPIECE)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)
|
||||
elseif (ILEQ CHNO 1)
|
||||
then (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
else (LET (PC START-OF-PIECE)
|
||||
@@ -944,13 +966,14 @@
|
||||
T])
|
||||
|
||||
(\TEDIT.CHECK-BTREE
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 7-Feb-2025 08:07 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:25 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:33 by rmk")
|
||||
(* ; "Edited 7-Sep-2022 09:43 by rmk")
|
||||
(* ; "Edited 4-Sep-2022 16:37 by rmk")
|
||||
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS LASTPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for BT (SUFFIXPIECE _ (FGETTOBJ TEXTOBJ SUFFIXPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
|
||||
declare (SPECVARS SUFFIXPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
|
||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
do (SELECTC (PTYPE PC)
|
||||
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
|
||||
@@ -977,7 +1000,8 @@
|
||||
'VALID])
|
||||
|
||||
(\TEDIT.CHECK-BTREE1
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 7-Feb-2025 08:31 by rmk")
|
||||
(* ; "Edited 31-Oct-2023 10:35 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:06 by rmk")
|
||||
(* ; "Edited 27-May-2023 15:00 by rmk")
|
||||
(* ; "Edited 1-Sep-2022 09:49 by rmk")
|
||||
@@ -987,30 +1011,30 @@
|
||||
(* ;;
|
||||
"Returns the TOTLEN/PLEN of NODE, after verifying that all of the nodes underneath are consistent.")
|
||||
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE))
|
||||
(DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ SUFFIXPIECE))
|
||||
(ADD DEPTH 1)
|
||||
(if (type? PIECE NODE)
|
||||
then [if (EQ NODE LASTPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE LASTPIECE)
|
||||
(NEXTPIECE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
|
||||
then [if (EQ NODE SUFFIXPIECE)
|
||||
then (CL:WHEN (AND (PREVPIECE SUFFIXPIECE)
|
||||
(NEXTPIECE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "(NEXT (PPREV of SUFFIXPIECE is not NULL" SUFFIXPIECE))
|
||||
else (CL:UNLESS (IGEQ (PLEN NODE)
|
||||
0)
|
||||
(\TEDIT.BTFAIL "Negative PLEN" NODE))
|
||||
(CL:UNLESS (OR (NEXTPIECE NODE)
|
||||
(EQ NODE (PREVPIECE LASTPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
|
||||
(EQ NODE (PREVPIECE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of SUFFIXPIECE" NODE))
|
||||
(CL:UNLESS (EQ PARENT (fetch (PIECE PTREENODE) of NODE))
|
||||
(\TEDIT.BTFAIL "Piece with wrong PTREENODE" NODE))
|
||||
(CL:WHEN (PREVPIECE NODE)
|
||||
(CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE)))
|
||||
(AND (NULL (NEXTPIECE (PREVPIECE NODE)))
|
||||
(EQ NODE LASTPIECE)))
|
||||
(EQ NODE SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "PREVPIECE is not consistent" NODE)))
|
||||
(CL:WHEN (OR (NEXTPIECE NODE)
|
||||
LASTPIECE)
|
||||
SUFFIXPIECE)
|
||||
(CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
|
||||
LASTPIECE)))
|
||||
SUFFIXPIECE)))
|
||||
(\TEDIT.BTFAIL "NEXTPIECE is not consistent" NODE)))]
|
||||
(add NPIECES 1)
|
||||
(add [CDR (OR (SASSOC DEPTH DEPTHHIST)
|
||||
@@ -1057,12 +1081,13 @@
|
||||
|
||||
(\TEDIT.BTFAIL
|
||||
[LAMBDA (STRING VAL)
|
||||
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 28-May-2023 08:45 by rmk")
|
||||
(HELP (CONCAT (OR TAG "")
|
||||
" "
|
||||
(OR MSG "")
|
||||
": " STRING)
|
||||
VAL])
|
||||
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 28-May-2023 08:45 by rmk")
|
||||
(\TEDIT.THELP (CONCAT (OR TAG "")
|
||||
" "
|
||||
(OR MSG "")
|
||||
": " STRING)
|
||||
VAL])
|
||||
|
||||
(\TEDIT.MATCHPCS
|
||||
[LAMBDA (NODE) (* ; "Edited 16-Mar-2024 11:07 by rmk")
|
||||
@@ -1085,13 +1110,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
|
||||
\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) (
|
||||
\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) (
|
||||
\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE
|
||||
35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) (
|
||||
\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 .
|
||||
52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) (
|
||||
\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693
|
||||
. 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492)))))
|
||||
(FILEMAP (NIL (8685 56524 (\TEDIT.MAKEPCTB 8695 . 10475) (\TEDIT.UPDATEPCNODES 10477 . 12771) (
|
||||
\TEDIT.FIRSTPIECE 12773 . 14180) (\TEDIT.DELETETREE 14182 . 17456) (\TEDIT.INSERTTREE 17458 . 20203) (
|
||||
\TEDIT.LASTPIECE 20205 . 21012) (\TEDIT.PCTOCH 21014 . 23111) (\TEDIT.CHTOPC 23113 . 29290) (
|
||||
\TEDIT.SET-TOTLEN 29292 . 30080) (\TEDIT.MAKE.VACANT.BTREESLOT 30082 . 36812) (\TEDIT.LINKNEWPIECE
|
||||
36814 . 38403) (\TEDIT.UNLINKPIECE 38405 . 39225) (\TEDIT.SPLITPIECE 39227 . 43883) (
|
||||
\TEDIT.INSERTPIECE 43885 . 47157) (\TEDIT.INSERTPIECES 47159 . 50251) (\TEDIT.DELETEPIECES 50253 .
|
||||
54407) (\TEDIT.ALIGNEDPIECE 54409 . 56522)) (56552 68875 (\TEDIT.BTVALIDATE 56562 . 58103) (
|
||||
\TEDIT.BTVALIDATE.PRINT 58105 . 59470) (\TEDIT.CHECK-BTREE 59472 . 61799) (\TEDIT.CHECK-BTREE1 61801
|
||||
. 67432) (\TEDIT.BTFAIL 67434 . 67856) (\TEDIT.MATCHPCS 67858 . 68873)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/tedit/TEDIT-RELEASENOTES.PDF
Normal file
BIN
library/tedit/TEDIT-RELEASENOTES.PDF
Normal file
Binary file not shown.
BIN
library/tedit/TEDIT-RELEASENOTES.TEDIT
Normal file
BIN
library/tedit/TEDIT-RELEASENOTES.TEDIT
Normal file
Binary file not shown.
172
library/tedit/TEDIT-RENAMES
Normal file
172
library/tedit/TEDIT-RENAMES
Normal file
@@ -0,0 +1,172 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Aug-2024 08:48:45" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;5 7187
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDITSYMBOLMAP)
|
||||
|
||||
:PREVIOUS-DATE "22-Jul-2024 11:31:22" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-RENAMESCOMS)
|
||||
|
||||
(RPAQQ TEDIT-RENAMESCOMS (
|
||||
(* ;; "TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE).")
|
||||
|
||||
|
||||
(* ;;
|
||||
"FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")
|
||||
|
||||
(VARS TEDITSYMBOLMAP)
|
||||
(VARS FORWARDEDFILES)))
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE)."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")
|
||||
|
||||
|
||||
(RPAQQ TEDITSYMBOLMAP
|
||||
((MB.NB.ARRANGEBUTTONS MB.NB.PACKITEMS)
|
||||
(MB.NWAYBUTTON.BUTTONEVENTINFN MB.NWAYBUTTON.SELFN)
|
||||
(\TEDIT.BTFAIL BTFAIL)
|
||||
(\TEDIT.BTVALIDATE BTVALIDATE)
|
||||
(\TEDIT.BTVALIDATE.PRINT BTVALIDATE.PRINT)
|
||||
(\TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.LOOKS)
|
||||
(\TEDIT.CHECK-BTREE CHECK-BTREE)
|
||||
(\TEDIT.CHECK-BTREE1 CHECK-BTREE1)
|
||||
(\TEDIT.EQCLOOKS EQCLOOKS)
|
||||
(\TEDIT.EQFMTSPEC EQFMTSPEC)
|
||||
(\TEDIT.REOPENTEXTSTREAM REOPENTEXTSTREAM)
|
||||
(\TEDIT.SAMECLOOKS SAMECLOOKS)
|
||||
(\TEDIT.DO.BLUEPENDINGDELETE TEDIT.DO.BLUEPENDINGDELETE)
|
||||
(\TEDIT.FORMATBOX TEDIT.FORMATBOX)
|
||||
(\TEDIT.FORMATFOLIO TEDIT.FORMATFOLIO)
|
||||
(\TEDIT.FORMATHEADING TEDIT.FORMATHEADING)
|
||||
(\TEDIT.FORMATPAGE TEDIT.FORMATPAGE)
|
||||
(\TEDIT.FORMATTEXTBOX TEDIT.FORMATTEXTBOX)
|
||||
(\TEDIT.GET.CHARLOOKS0 TEDIT.GET.CHARLOOKS0)
|
||||
(\TEDIT.GET.OBJECT TEDIT.GET.OBJECT)
|
||||
(\TEDIT.GET.OBJECT0 TEDIT.GET.OBJECT0)
|
||||
(\TEDIT.GET.PARALOOKS0 TEDIT.GET.PARALOOKS0)
|
||||
(\TEDIT.GET.PCTB0 TEDIT.GET.PCTB0)
|
||||
(\TEDIT.PUT.OBJECT TEDIT.PUT.OBJECT)
|
||||
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEDIT.RESET.EXTEND.PENDING.DELETE)
|
||||
(\TEDIT.SELECTED.PIECES TEDIT.SELECTED.PIECES)
|
||||
(\TEDIT.UPDATE.SCREEN TEDIT.UPDATE.SCREEN)
|
||||
(\TEDIT.ALIGNEDPIECE \ALIGNEDPIECE)
|
||||
(\TEDIT.BACKFORMAT \BACKFORMAT)
|
||||
(\TEDIT.CHTOPC \CHTOPC)
|
||||
(\TEDIT.COPYSEL \COPYSEL)
|
||||
(\TEDIT.CREATE.TEDIT.RESTART.MENU \CREATE.TEDIT.RESTART.MENU)
|
||||
(\TEDIT.DELETEPIECES \DELETEPIECES)
|
||||
(\TEDIT.DELETETREE \DELETETREE)
|
||||
(\TEDIT.DISPLAYLINE \DISPLAYLINE)
|
||||
(\TEDIT.DISPLAYLINE.TABS \DISPLAYLINE.TABS)
|
||||
(\TEDIT.FILLPANE \FILLPANE)
|
||||
(\TEDIT.FIRSTPIECE \FIRSTPIECE)
|
||||
(\TEDIT.FIXSEL \FIXSEL)
|
||||
(\TEDIT.FORMATBLOCK \FORMATBLOCK)
|
||||
(\TEDIT.FORMATLINE \FORMATLINE)
|
||||
(\TEDIT.FORMATLINE.EMPTY \FORMATLINE.EMPTY)
|
||||
(\TEDIT.FORMATLINE.JUSTIFY \FORMATLINE.JUSTIFY)
|
||||
(\TEDIT.FORMATLINE.LASTLEGAL \FORMATLINE.LASTLEGAL)
|
||||
(\TEDIT.FORMATLINE.PURGE.SPACES \FORMATLINE.PURGE.SPACES)
|
||||
(\TEDIT.FORMATLINE.SCALETABS \FORMATLINE.SCALETABS)
|
||||
(\TEDIT.FORMATLINE.SETUP \FORMATLINE.SETUP)
|
||||
(\TEDIT.FORMATLINE.TABS \FORMATLINE.TABS)
|
||||
(\TEDIT.FORMATLINE.UPDATELOOKS \FORMATLINE.UPDATELOOKS)
|
||||
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \HARDCOPY.FORMATLINE.HEADINGS)
|
||||
(\TEDIT.INSERT TEDIT.\INSERT)
|
||||
(\TEDIT.INSERTCH \INSERTCH)
|
||||
(\TEDIT.INSERTCH.EXTEND \INSERTCH.EXTEND)
|
||||
(\TEDIT.INSERTCH.HISTORY \INSERTCH.HISTORY)
|
||||
(\TEDIT.INSERTCH.INSERTION \INSERTCH.INSERTION)
|
||||
(\TEDIT.INSERTEOL \INSERTEOL)
|
||||
(\TEDIT.INSERTPIECE \INSERTPIECE)
|
||||
(\TEDIT.INSERTPIECES \INSERTPIECES)
|
||||
(\TEDIT.INSERTTREE \INSERTTREE)
|
||||
(\TEDIT.LASTPIECE \LASTPIECE)
|
||||
(\TEDIT.LINKNEWPIECE \LINKNEWPIECE)
|
||||
(\TEDIT.MAKE.VACANT.BTREESLOT \MAKE.VACANT.BTREESLOT)
|
||||
(\TEDIT.MAKEPCTB \MAKEPCTB)
|
||||
(\TEDIT.MATCHPCS \MATCHPCS)
|
||||
(\TEDIT.NAMEDTAB.INIT \NAMEDTAB.INIT)
|
||||
(\TEDIT.PCTOCH \PCTOCH)
|
||||
(\TEDIT.PRIMARYPANE \TEDIT.PRIMARYW)
|
||||
(\TEDIT.SELPIECES \SELPIECES)
|
||||
(\TEDIT.SELPIECES.CHARTRANSFORM \SELPIECES.CHARTRANSFORM)
|
||||
(\TEDIT.SELPIECES.CONCAT \SELPIECES.CONCAT)
|
||||
(\TEDIT.SELPIECES.COPY \SELPIECES.COPY)
|
||||
(\TEDIT.SELPIECES.FROM.STRING \SELPIECES.FROM.STRING)
|
||||
(\TEDIT.SELPIECES.TO.STRING \SELPIECES.TO.STRING)
|
||||
(\TEDIT.SHOWSEL \SHOWSEL)
|
||||
(\TEDIT.SPLITPIECE \SPLITPIECE)
|
||||
(\TEDIT.TEDIT.FORMATLINES \TEDIT.FORMATLINES)
|
||||
(\TEDIT.POSTSCRIPT.HARDCOPY \TEDIT.HARDCOPY)
|
||||
(\TEDIT.TEDIT.HARDCOPY \TEDIT.HARDCOPY)
|
||||
(\TEDIT.TEXTBACKFILEPTR \TEXTBACKFILEPTR)
|
||||
(\TEDIT.TEXTBIN \TEXTBIN)
|
||||
(\TEDIT.TEXTBOUT \TEXTBOUT)
|
||||
(\TEDIT.TEXTCLOSEF \TEXTCLOSEF)
|
||||
(\TEDIT.TEXTDSPCHARWIDTH \TEXTDSPCHARWIDTH)
|
||||
(\TEDIT.TEXTDSPFONT \TEXTDSPFONT)
|
||||
(\TEDIT.TEXTDSPLINEFEED \TEXTDSPLINEFEED)
|
||||
(\TEDIT.TEXTDSPSTRINGWIDTH \TEXTDSPSTRINGWIDTH)
|
||||
(\TEDIT.TEXTDSPXPOSITION \TEXTDSPXPOSITION)
|
||||
(\TEDIT.TEXTDSPYPOSITION \TEXTDSPYPOSITION)
|
||||
(\TEDIT.TEXTEOFP \TEXTEOFP)
|
||||
(\TEDIT.TEXTGETEOFPTR \TEXTGETEOFPTR)
|
||||
(\TEDIT.TEXTGETFILEPTR \TEXTGETFILEPTR)
|
||||
(\TEDIT.TEXTINIT \TEXTINIT)
|
||||
(\TEDIT.TEXTLEFTMARGIN \TEXTLEFTMARGIN)
|
||||
(\TEDIT.TEXTOPENF \TEXTOPENF)
|
||||
(\TEDIT.TEXTPEEKBIN \TEXTPEEKBIN)
|
||||
(\TEDIT.TEXTRIGHTMARGIN \TEXTRIGHTMARGIN)
|
||||
(\TEDIT.TEXTSETEOF \TEXTSETEOF)
|
||||
(\TEDIT.TEXTSETFILEPTR \TEXTSETFILEPTR)
|
||||
(\TEDIT.TEXTBACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
|
||||
(\TEDIT.TEXTSTREAM.BACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
|
||||
(\TEDIT.TEXTFORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
|
||||
(\TEDIT.TEXTSTREAM.FORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
|
||||
(\TEDIT.TEXTINCCODEFN \TEXTSTREAM.INCCCODEFN)
|
||||
(\TEDIT.TEXTSTREAM.INCCCODEFN \TEXTSTREAM.INCCCODEFN)
|
||||
(\TEDIT.TEXTOUTCHARFN \TEXTSTREAM.OUTCHARFN)
|
||||
(\TEDIT.TEXTSTREAM.OUTCHARFN \TEXTSTREAM.OUTCHARFN)
|
||||
(\TEDIT.TEXTTTYBOUT \TEXTTTYBOUT)
|
||||
(\TEDIT.UNLINKPIECE \UNLINKPIECE)
|
||||
(\TEDIT.UPDATEPCNODES \UPDATEPCNODES)
|
||||
(\TEDIT.XYTOSEL \TEDIT.SELECT.LINE.SCANNER)))
|
||||
|
||||
(RPAQQ FORWARDEDFILES
|
||||
((PCTREE TEDIT-PCTREE)
|
||||
(TEDIT TEDIT)
|
||||
(TEDIT-FILE TEDIT-FILE)
|
||||
(TEDIT-TEXTOFD TEDIT-STREAM)
|
||||
(TEDITABBREV TEDIT-ABBREV)
|
||||
(TEDITCHAT TEDIT-CHAT)
|
||||
(TEDITCOMMAND TEDIT-COMMAND)
|
||||
(TEDITDCL TEDITDCL)
|
||||
(TEDITDEBUG TEDIT-DEBUG)
|
||||
(TEDITFILE TEDIT-FILE TEDIT-OLDFILE)
|
||||
(TEDITFIND TEDIT-FIND)
|
||||
(TEDITFNKEYS TEDIT-FNKEYS)
|
||||
(TEDITHCPY TEDIT-HCPY)
|
||||
(TEDITHISTORY TEDIT-HISTORY)
|
||||
(TEDITLOOKS TEDIT-LOOKS)
|
||||
(TEDITMENU TEDIT-MENU)
|
||||
(TEDITPAGE TEDIT-PAGE)
|
||||
(TEDITSCREEN TEDIT-SCREEN)
|
||||
(TEDITSELECTION TEDIT-SELECTION)
|
||||
(TEDITWINDOW TEDIT-WINDOW)
|
||||
(TFBRAVO TEDIT-TFBRAVO)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Mar-2024 21:34:32" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;70 15296
|
||||
(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}<library>tedit>TEDIT-STRESS.;71 15583
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK)
|
||||
(VARS TEDIT-STRESSCOMS)
|
||||
:CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;54)
|
||||
:PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
|
||||
@@ -25,6 +24,7 @@
|
||||
|
||||
(STRESSHC
|
||||
[LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:33 by rmk")
|
||||
(* ; "Edited 14-Mar-2024 15:15 by rmk")
|
||||
(* ; "Edited 13-Mar-2024 00:23 by rmk")
|
||||
@@ -83,7 +83,7 @@
|
||||
T))
|
||||
(CLOSEF? TSTRM)
|
||||
(CL:WHEN SINGLESTEP
|
||||
(HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
|
||||
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
|
||||
(PRINTOUT T " Hardcopied " N " files without failure" T)
|
||||
finally (RETURN (LIST R N])
|
||||
|
||||
@@ -121,7 +121,8 @@
|
||||
T)) finally (RETURN (LIST R N])
|
||||
|
||||
(STRESSPUT
|
||||
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 21:34 by rmk")
|
||||
(* ; "Edited 12-Mar-2024 09:48 by rmk")
|
||||
|
||||
(* ;; "Opens, puts, reopens and tests for equivalence")
|
||||
@@ -142,13 +143,13 @@
|
||||
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
|
||||
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
|
||||
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
|
||||
(HELP "Get of put not equivalent" F))
|
||||
(\TEDIT.THELP "Get of put not equivalent" F))
|
||||
(CLOSEF TSP))
|
||||
else (SETQ TSTRM (OPENTEXTSTREAM F))
|
||||
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
|
||||
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
|
||||
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
|
||||
(HELP "Get of put not equivalent" F))
|
||||
(\TEDIT.THELP "Get of put not equivalent" F))
|
||||
(CLOSEF TSP))
|
||||
then (CLOSEF TSTRM)
|
||||
(add N 1)
|
||||
@@ -242,7 +243,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EQTEXTSTREAM
|
||||
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 11-Mar-2024 16:53 by rmk")
|
||||
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 16:53 by rmk")
|
||||
(AND (IEQP (TEDIT.NCHARS TS1)
|
||||
(TEDIT.NCHARS TS2))
|
||||
(OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
|
||||
@@ -255,8 +257,8 @@
|
||||
(AND (IMAGEOBJP C1)
|
||||
(IMAGEOBJP C2)
|
||||
(EQUALALL C1 C2))) do (CL:WHEN STOP
|
||||
(HELP "Different characters: "
|
||||
(LIST I C1 C2)))
|
||||
(\TEDIT.THELP "Different characters: "
|
||||
(LIST I C1 C2)))
|
||||
(RETURN NIL) finally (RETURN T])
|
||||
|
||||
(SYSOUTRING
|
||||
@@ -293,7 +295,7 @@
|
||||
finally (CL:UNLESS NORECLAIM (RECLAIM])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) (
|
||||
STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695
|
||||
)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271)))))
|
||||
(FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) (
|
||||
STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864
|
||||
)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558)))))
|
||||
STOP
|
||||
|
||||
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,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Mar-2024 18:27:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;153 91304
|
||||
(FILECREATED "19-Feb-2025 12:18:40" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;175 94753
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-TFBRAVOCOMS)
|
||||
(FNS \TEDIT.NAMEDTAB.INIT)
|
||||
:CHANGES-TO (RECORDS PARA)
|
||||
(FNS TEDITFROMBRAVO \TFBRAVO.READ.PARALOOKS \TFBRAVO.HANDLE.HEADING
|
||||
\TFBRAVO.PARSE.PROFILE.PARA \TFBRAVO.SPLIT.PARA \TFBRAVO.RUN.TABSPEC
|
||||
\TFBRAVO.ADD.NAMEDTAB)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2024 12:41:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 23:19:34" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;174)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||
@@ -75,10 +75,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))
|
||||
@@ -124,7 +124,7 @@
|
||||
(WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72)))
|
||||
NUM))
|
||||
(NIL NUM)
|
||||
(HELP "UNKNOWN DIMENSION" DIMENSION))))
|
||||
(\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION))))
|
||||
NUM)))
|
||||
)
|
||||
|
||||
@@ -173,7 +173,10 @@
|
||||
(RETURN T])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 17-Jan-2024 12:11 by rmk")
|
||||
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 19-Feb-2025 12:13 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:03 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 22:22 by rmk")
|
||||
(* ; "Edited 17-Jan-2024 12:11 by rmk")
|
||||
(* ; "Edited 26-Nov-2023 00:29 by rmk")
|
||||
(* ; "Edited 14-Nov-2023 17:09 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 08:53 by rmk")
|
||||
@@ -188,9 +191,9 @@
|
||||
(CL:UNLESS TEXTSTREAM
|
||||
(SETQ TEXTSTREAM (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
|
||||
(bind PARA NEXTPARALOOKS USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST START
|
||||
(BSTREAM _ BFILE)
|
||||
(TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare (SPECVARS USER.CM.PARALOOKS USER.CM.CHARLOOKS
|
||||
USER.CM.ALIST)
|
||||
first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ))
|
||||
(* ; "Go for plain text")
|
||||
@@ -204,28 +207,32 @@
|
||||
(PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT)
|
||||
[RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
`(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE]
|
||||
(SETQ NEXTFMTSPEC USER.CM.FMTSPEC) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(SETQ NEXTPARALOOKS USER.CM.PARALOOKS) eachtime (SETQ START (GETFILEPTR BSTREAM))
|
||||
(* ;
|
||||
"Profiles and headings have to back up")
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA NEXTFMTSPEC
|
||||
BSTREAM TEXTOBJ))
|
||||
(SETQ PARA (\TFBRAVO.PARSE.PARA
|
||||
NEXTPARALOOKS BSTREAM
|
||||
TEXTOBJ))
|
||||
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(* ;; "No runs signals the very end")
|
||||
while (fetch (PARA RUNS) of PARA) do (SETQ NEXTPARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
|
||||
(* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text")
|
||||
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE)
|
||||
of NEXTFMTSPEC))
|
||||
(CL:UNLESS (AND (EQ 'PROFILE (GETPLOOKS NEXTPARALOOKS
|
||||
FMTPARATYPE))
|
||||
(\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA
|
||||
TEXTOBJ START))
|
||||
(\TFBRAVO.INSERT.PARA PARA BSTREAM TEXTOBJ))
|
||||
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
|
||||
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
|
||||
(* ;; "Named tab information is collected in the userinfo fields, but then ignored.")
|
||||
|
||||
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||
do (replace (FMTSPEC FMTUSERINFO) of PARALOOKS with NIL))
|
||||
do (SETPLOOKS PARALOOKS FMTUSERINFO NIL))
|
||||
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
|
||||
do (replace (CHARLOOKS CLUSERINFO) of CHARLOOKS with NIL))
|
||||
do (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
|
||||
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
|
||||
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ)
|
||||
(TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
|
||||
(RETURN TEXTSTREAM)))])
|
||||
@@ -285,25 +292,27 @@
|
||||
(RETURN USER.CM])
|
||||
|
||||
(\TFBRAVO.USER.CM.LOOKS
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 18-Aug-2023 18:47 by rmk")
|
||||
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 8-Feb-2025 22:13 by rmk")
|
||||
(* ; "Edited 2-Jan-2025 11:06 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 18:47 by rmk")
|
||||
(* ; "Edited 16-Aug-2023 21:33 by rmk")
|
||||
(* ; "Edited 5-Aug-2023 17:15 by rmk")
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST))
|
||||
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
|
||||
(SETQ USER.CM.CHARLOOKS (create CHARLOOKS
|
||||
CLNAME _ (\TFBRAVO.GETFONT 0 BRFAMILY)
|
||||
CLSIZE _ (\TFBRAVO.GETFONT 0 BRSIZE)
|
||||
CLOFFSET _ 0))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS)
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS (\TFBRAVO.GETFONT 0 BRFAMILY)
|
||||
(\TFBRAVO.GETFONT 0 BRSIZE))
|
||||
(\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ)
|
||||
(SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
|
||||
(SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ))
|
||||
(SETQ USER.CM.FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.FMTSPEC TEXTOBJ))
|
||||
(SETQ USER.CM.PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.PARALOOKS TEXTOBJ))
|
||||
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS USER.CM.CHARLOOKS)
|
||||
(SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
|
||||
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS USER.CM.PARALOOKS])
|
||||
|
||||
(\TFBRAVO.READ.USER.CM
|
||||
[LAMBDA (USER.CM) (* ; "Edited 18-Aug-2023 22:26 by rmk")
|
||||
[LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 22:26 by rmk")
|
||||
(* ; "Edited 10-Aug-2023 13:02 by rmk")
|
||||
(* ; "Edited 7-Aug-2023 12:52 by rmk")
|
||||
(* ; "Edited 1-Aug-2023 22:11 by rmk")
|
||||
@@ -330,7 +339,9 @@
|
||||
|
||||
LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL)))
|
||||
USER.CM USER.CM.RDTBL)))
|
||||
(RETURN ALIST)) (* ;
|
||||
(CL:UNLESS (ASSOC 'DefaultTab ALIST)
|
||||
(push ALIST (CONS 'DefaulTab DEFAULTTAB)))
|
||||
(RETURN ALIST)) (* ;
|
||||
"If the '[BRAVO]' section is the last one")
|
||||
(COND
|
||||
((NULL LINE) (* ; "ignore blank lines")
|
||||
@@ -378,19 +389,22 @@
|
||||
(GO LLP)))])
|
||||
|
||||
(\TFBRAVO.INIT.PARALOOKS
|
||||
[LAMBDA (ALIST) (* ; "Edited 13-Aug-2023 11:27 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")
|
||||
(* ; "Edited 7-Aug-2023 14:59 by rmk")
|
||||
(* ; "Edited 31-May-91 15:26 by jds")
|
||||
|
||||
(* ;; "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))
|
||||
@@ -400,11 +414,11 @@
|
||||
(SETQ LEADBEFORE (OR (CADR (ASSOC 'ParagraphLeading ALIST))
|
||||
0))
|
||||
(SETQ LEADAFTER 0)
|
||||
(SETQ TABSPEC (LIST (OR (CADR (ASSOC 'DefaultTab ALIST))
|
||||
36)))
|
||||
(SETQ FMTDEFAULTTAB (OR (CADR (ASSOC 'DefaultTab ALIST))
|
||||
DEFAULTTAB))
|
||||
(SETQ FMTSPECIALX 0)
|
||||
(SETQ FMTSPECIALY 0))
|
||||
INITFMTSPEC])
|
||||
INITPARALOOKS])
|
||||
|
||||
(\TFBRAVO.INIT.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:03 by rmk")
|
||||
@@ -491,24 +505,26 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.PARSE.PARA
|
||||
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 14-Nov-2023 13:03 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")
|
||||
(* ; "Edited 20-Aug-2023 22:48 by rmk")
|
||||
(* ; "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")
|
||||
|
||||
@@ -537,17 +553,23 @@
|
||||
(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)
|
||||
(SHOULDNT "Bravo paragraph not ending in ^Z, CR, EOF"))
|
||||
(\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 9-Sep-2023 21:40 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")
|
||||
(* ; "Edited 9-Sep-2023 21:40 by rmk")
|
||||
(* ; "Edited 21-Aug-2023 21:43 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 15:48 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 23:08 by rmk")
|
||||
@@ -555,60 +577,62 @@
|
||||
(* ; "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.")
|
||||
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME TABDEFAULT NAMEDTABS (NEWFMTSPEC _
|
||||
(create FMTSPEC
|
||||
using USER.CM.FMTSPEC))
|
||||
first (CL:UNLESS (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE) of OLDFMTSPEC))
|
||||
(PARALOOKS! OLDPARALOOKS)
|
||||
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPLOOKS USER.CM.PARALOOKS
|
||||
FMTDEFAULTTAB))
|
||||
(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 (CAR (fetch (FMTSPEC TABSPEC) of OLDFMTSPEC)))
|
||||
(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 (fetch (FMTSPEC FMTUSERINFO) of OLDFMTSPEC))))
|
||||
(SETQ NAMEDTABS (COPY (FGETPLOOKS OLDPARALOOKS FMTUSERINFO))))
|
||||
do (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(l (SETQ LMFLAG T)
|
||||
(replace (FMTSPEC LEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(FSETPLOOKS NEWPARALOOKS LEFTMAR (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(d (SETQ 1LMFLAG T)
|
||||
(replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(z (replace (FMTSPEC RIGHTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
|
||||
'MICATOHALFPICAPOINTS)))
|
||||
(x (replace (FMTSPEC LINELEAD) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(e (replace (FMTSPEC LEADAFTER) of NEWFMTSPEC with 0)
|
||||
(replace (FMTSPEC LEADBEFORE) of NEWFMTSPEC with (\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")
|
||||
(replace (FMTSPEC FMTSPECIALX) of NEWFMTSPEC with 0)
|
||||
(replace (FMTSPEC FMTSPECIALY) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
|
||||
(k (replace (FMTSPEC FMTHEADINGKEEP) of NEWFMTSPEC with (\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 (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'JUSTIFIED))
|
||||
(c (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'CENTERED))
|
||||
(j (FSETPLOOKS NEWPARALOOKS QUAD 'JUSTIFIED))
|
||||
(c (FSETPLOOKS NEWPARALOOKS QUAD 'CENTERED))
|
||||
(q
|
||||
(* ;; "Profiles are marked here but then interpreted at the top")
|
||||
|
||||
(replace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with 'PROFILE))
|
||||
(FSETPLOOKS NEWPARALOOKS FMTPARATYPE 'PROFILE))
|
||||
(%( (* ; "Collect the named tabs")
|
||||
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position")
|
||||
|
||||
(* ;; "Tabs apparently round down/truncate, not up.")
|
||||
|
||||
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(%) (SETQ TABDEFAULT (FIXR (FQUOTIENT TABX MICASPERPT))))
|
||||
(%) (SETQ TABDEFAULT (HCUNSCALE MICASPERPT TABX)))
|
||||
(%, (CL:WHEN (IGREATERP TABX 14)
|
||||
(HELP TABX " is not a legal tab-name"))
|
||||
(\TEDIT.THELP TABX " is not a legal tab-name"))
|
||||
(SETQ TABNAME (ADD1 TABX)) (* ; "Adding 1 to align with t1, t2...")
|
||||
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T))
|
||||
(CL:UNLESS (EQ (CHARCODE %))
|
||||
(BIN BSTREAM))
|
||||
(HELP "MISSING CLOSING ) IN TABSPEC"))
|
||||
(\TEDIT.THELP "MISSING CLOSING ) IN TABSPEC"))
|
||||
|
||||
(* ;; "Here we collect the tabs declared in this paragraph or inherited from before. 65535 means delete that the named tab (possibly inherited), otherwise the name is given a new TABX for all runs of this paragraph and beyond.")
|
||||
|
||||
@@ -618,23 +642,22 @@
|
||||
else (RPLACD [OR (ASSOC TABNAME NAMEDTABS)
|
||||
(CAR (push NAMEDTABS (CONS TABNAME]
|
||||
(create TAB
|
||||
TABX _ (FIXR (FQUOTIENT TABX MICASPERPT))
|
||||
TABX _ (HCUNSCALE MICASPERPT TABX)
|
||||
TABKIND _ 'LEFT])
|
||||
(HELP "ILLFORMED BRAVO TAB SPEC")))
|
||||
(\TEDIT.THELP "ILLFORMED BRAVO TAB SPEC")))
|
||||
(SPACE)
|
||||
((CR \)
|
||||
(CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;
|
||||
"If there was a Left margin but no firstline left then default it")
|
||||
(replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (fetch (FMTSPEC LEFTMAR)
|
||||
of NEWFMTSPEC)))
|
||||
(replace TABSPEC of NEWFMTSPEC with (CONS TABDEFAULT))
|
||||
(replace (FMTSPEC FMTUSERINFO) of NEWFMTSPEC with (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))
|
||||
(HELP (CHARACTER COMMAND)
|
||||
'" is not a legal Bravo paragraph-format character"])
|
||||
(RETURN NEWPARALOOKS))
|
||||
(\TEDIT.THELP (CHARACTER COMMAND)
|
||||
'" is not a legal Bravo paragraph-format character"])
|
||||
|
||||
(\TFBRAVO.CREATE.RUNS
|
||||
[LAMBDA (BSTREAM PSTART PLEN) (* ; "Edited 14-Nov-2023 13:01 by rmk")
|
||||
@@ -654,7 +677,9 @@
|
||||
(SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN])
|
||||
|
||||
(\TFBRAVO.READ.CHARLOOKS
|
||||
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 9-Sep-2023 21:39 by rmk")
|
||||
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 2-Jan-2025 23:44 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
(* ; "Edited 9-Sep-2023 21:39 by rmk")
|
||||
(* ; "Edited 20-Aug-2023 16:15 by rmk")
|
||||
(* ; "Edited 18-Aug-2023 20:11 by rmk")
|
||||
(* ; "Edited 31-May-91 15:25 by jds")
|
||||
@@ -663,36 +688,39 @@
|
||||
|
||||
(* ;; "The charlooks trailer (from \ to CR) consists of a sequence of run-looks. Each run-look is a sequence of commands followed by the length of the run. If the first run has no commands (i.e. the \ is followed immediately by a length-number), than the first run gets the USER.CM default looks.")
|
||||
|
||||
(bind COMMAND LEN LAST VALUE TABNAMES (NEWCHARLOOKS _ (create CHARLOOKS using OLDCHARLOOKS))
|
||||
until (SETQ LEN (\TFBRAVO.READNUM? BSTREAM))
|
||||
(bind COMMAND LEN LAST VALUE TABNAMES FAMILY SIZE BOLD ITALIC (NEWCHARLOOKS _
|
||||
(create CHARLOOKS
|
||||
using OLDCHARLOOKS))
|
||||
first [SETQ FAMILY (SETQ SIZE (SETQ BOLD (SETQ ITALIC 'OFF] until (SETQ LEN (\TFBRAVO.READNUM?
|
||||
BSTREAM))
|
||||
do
|
||||
(* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safter?")
|
||||
(* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safer?")
|
||||
|
||||
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
|
||||
(s (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with T))
|
||||
(S (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with NIL))
|
||||
(u (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with T))
|
||||
(U (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with NIL))
|
||||
(b (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with T))
|
||||
(B (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with NIL))
|
||||
(i (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with T))
|
||||
(I (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with NIL))
|
||||
(s (FSETCLOOKS NEWCHARLOOKS CLSTRIKE T))
|
||||
(S (FSETCLOOKS NEWCHARLOOKS CLSTRIKE NIL))
|
||||
(u (FSETCLOOKS NEWCHARLOOKS CLULINE T))
|
||||
(U (FSETCLOOKS NEWCHARLOOKS CLULINE NIL))
|
||||
(b (SETQ BOLD T))
|
||||
(B (SETQ BOLD NIL))
|
||||
(i (SETQ ITALIC T))
|
||||
(I (SETQ ITALIC NIL))
|
||||
(g "Graphic T --unsupported")
|
||||
(G "Graphic NIL")
|
||||
(v (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with NIL))
|
||||
(V (AND NIL (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with T)))
|
||||
(v (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE NIL))
|
||||
(V (AND NIL (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE T)))
|
||||
(t
|
||||
(* ;; "Collect the named tabs for writerun")
|
||||
|
||||
(PUSH TABNAMES (CHARACTER (BIN BSTREAM))))
|
||||
(f (* ; "Save the fontface until the end")
|
||||
(SETQ VALUE (CHARACTER (BIN BSTREAM)))
|
||||
(replace (CHARLOOKS CLSIZE) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRSIZE))
|
||||
(replace (CHARLOOKS CLNAME) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRFAMILY)))
|
||||
(SETQ SIZE (\TFBRAVO.GETFONT VALUE BRSIZE))
|
||||
(SETQ FAMILY (\TFBRAVO.GETFONT VALUE BRFAMILY)))
|
||||
(o (SETQ VALUE (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Superscript")
|
||||
(replace (CHARLOOKS CLOFFSET) of NEWCHARLOOKS with (CL:IF (IGREATERP VALUE 127)
|
||||
(IDIFFERENCE VALUE 256)
|
||||
VALUE)))
|
||||
(FSETCLOOKS NEWCHARLOOKS CLOFFSET (CL:IF (IGREATERP VALUE 127)
|
||||
(IDIFFERENCE VALUE 256)
|
||||
VALUE)))
|
||||
(SPACE)
|
||||
(CR
|
||||
(* ;; "We hit the trailer-terminating CR, It is either the end-marker for the last run, or a signal that this paragraph has no run-look information. ")
|
||||
@@ -709,14 +737,14 @@
|
||||
(SETQ LEN PLEN)) (* ;
|
||||
"Otherwise, PLEN is what's left for the final substantive run")
|
||||
(GO $$OUT))
|
||||
(HELP (CHARACTER COMMAND)
|
||||
" is not a legal Bravo command character look"))
|
||||
(\TEDIT.THELP (CHARACTER COMMAND)
|
||||
" is not a legal Bravo command character look"))
|
||||
finally
|
||||
|
||||
(* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length")
|
||||
|
||||
(replace (CHARLOOKS CLUSERINFO) of NEWCHARLOOKS with (DREVERSE TABNAMES))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS)
|
||||
(FSETCLOOKS NEWCHARLOOKS CLUSERINFO (DREVERSE TABNAMES))
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS FAMILY SIZE BOLD ITALIC)
|
||||
(RETURN (create RUN
|
||||
RUNSTART _ RUNSTART
|
||||
RUNLENGTH _ LEN
|
||||
@@ -724,22 +752,29 @@
|
||||
RUNLAST _ LAST])
|
||||
|
||||
(\TFBRAVO.FONT.FROM.CHARLOOKS
|
||||
[LAMBDA (CHARLOOKS) (* ; "Edited 1-Aug-2023 13:21 by rmk")
|
||||
[LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC) (* ; "Edited 2-Jan-2025 23:43 by rmk")
|
||||
(* ; "Edited 1-Aug-2023 13:21 by rmk")
|
||||
(* ; "Edited 31-May-91 15:26 by jds")
|
||||
|
||||
(* ;; "Takes a TEDIT CHARLOOKS with fields filled in (CLNAME = family name) and creates the font to fill it.")
|
||||
|
||||
[replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE (fetch (CHARLOOKS CLNAME) of CHARLOOKS)
|
||||
(fetch (CHARLOOKS CLSIZE) of CHARLOOKS)
|
||||
(LIST (CL:IF (fetch (CHARLOOKS CLBOLD)
|
||||
of CHARLOOKS)
|
||||
'BOLD
|
||||
'MEDIUM)
|
||||
(CL:IF (fetch (CHARLOOKS CLITAL)
|
||||
of CHARLOOKS)
|
||||
'ITALIC
|
||||
'REGULAR)
|
||||
'REGULAR]
|
||||
[LET ((OLDFONT (GETCLOOKS CHARLOOKS CLFONT)))
|
||||
(CL:WHEN (EQ FAMILY 'OFF)
|
||||
(SETQ FAMILY (FONTPROP OLDFONT 'FAMILY)))
|
||||
(CL:WHEN (EQ SIZE 'OFF)
|
||||
(SETQ SIZE (FONTPROP OLDFONT 'SIZE)))
|
||||
(CL:WHEN (EQ BOLD 'OFF)
|
||||
[SETQ BOLD (EQ 'BOLD (FONTPROP OLDFONT 'WEIGHT])
|
||||
(CL:WHEN (EQ ITALIC 'OFF)
|
||||
[SETQ ITALIC (EQ 'ITALIC (FONTPROP OLDFONT 'SLOPE])
|
||||
[SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD
|
||||
'BOLD
|
||||
'MEDIUM)
|
||||
(CL:IF ITALIC
|
||||
'ITALIC
|
||||
'REGULAR)
|
||||
'REGULAR]
|
||||
(SETCLOOKS CHARLOOKS CLNAME (FONTUNPARSE (GETCLOOKS CHARLOOKS CLFONT]
|
||||
CHARLOOKS])
|
||||
|
||||
(\TFBRAVO.READNUM?
|
||||
@@ -775,7 +810,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")
|
||||
@@ -785,31 +822,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")
|
||||
@@ -907,8 +946,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
|
||||
@@ -929,17 +968,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")
|
||||
@@ -949,7 +991,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")
|
||||
@@ -960,7 +1002,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
|
||||
@@ -988,10 +1030,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.")
|
||||
|
||||
@@ -999,7 +1043,7 @@
|
||||
|
||||
(* ;; "This smashes PARA's runs.")
|
||||
|
||||
(LET ((PARAFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
(LET ((PARALOOKS (fetch (PARA PARAFMTSPEC) of PARA))
|
||||
NEWPARAS)
|
||||
|
||||
(* ;;
|
||||
@@ -1007,9 +1051,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))
|
||||
@@ -1040,7 +1084,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)
|
||||
@@ -1050,19 +1094,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).")
|
||||
@@ -1087,60 +1130,66 @@
|
||||
NEWPARAS])
|
||||
|
||||
(\TFBRAVO.RUN.TABSPEC
|
||||
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 15-Mar-2024 19:42 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.")
|
||||
|
||||
(LET ([LASTTAB (CAR (LAST (CDR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC]
|
||||
(TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC))
|
||||
(TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC)))
|
||||
(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 TABSPEC)
|
||||
TAB TABS)
|
||||
(CL:WHEN (AND TABDEFS (NULL RUNTABS))
|
||||
(SETQ RUNTABS (CONS (CAAR TABDEFS))))
|
||||
(CL:WHEN (AND TABDEFS RUNTABS)
|
||||
(CL:WHEN (EQUAL RUNTABS '(0)) (* ;
|
||||
"If e.g. Tab 0 is set but the run has no tn's, assume that the first tn is intended.")
|
||||
(SETQ RUNTABS '(1 2)))
|
||||
[SETQ TABSPEC (for TABNAME in RUNTABS
|
||||
collect
|
||||
[SETQ TABS (for TABNAME in RUNTABS
|
||||
collect
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"For t0 we try to find the tab after the one last used in the previous run.")
|
||||
|
||||
(if (CDR (ASSOC TABNAME TABDEFS))
|
||||
elseif [AND (EQ TABNAME 0)
|
||||
(for TDTAIL TD on TABDEFS
|
||||
eachtime (SETQ TD (CAR TDTAIL))
|
||||
when (EQ LASTTAB (CDR TD))
|
||||
do [SETQ TABDEFAULT (fetch TABX
|
||||
of (CDR (CADR TDTAIL]
|
||||
(RETURN (CDR (CADR TDTAIL]
|
||||
else (GO $$ITERATE]
|
||||
(if (CDR (ASSOC TABNAME TABDEFS))
|
||||
elseif [AND (EQ TABNAME 0)
|
||||
(for TDTAIL TD on TABDEFS eachtime (SETQ TD
|
||||
(CAR TDTAIL))
|
||||
when (EQ LASTTAB (CDR TD))
|
||||
do [SETQ TABDEFAULT (fetch TABX
|
||||
of (CDR (CADR TDTAIL]
|
||||
(RETURN (CDR (CADR TDTAIL]
|
||||
else (GO $$ITERATE]
|
||||
|
||||
(* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.")
|
||||
|
||||
[SETQ TABSPEC (SORT (for TAB in TABDEFS collect (CDR TAB))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT TABSPEC))
|
||||
))
|
||||
PARAFMTSPEC])
|
||||
[SETQ TABS (SORT (for TAB in TABDEFS collect (CDR TAB))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
(SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
|
||||
TABS)))
|
||||
PARALOOKS])
|
||||
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:04 by rmk")
|
||||
@@ -1220,10 +1269,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ASSERT
|
||||
[LAMBDA (X Y) (* ; "Edited 9-Aug-2023 10:32 by rmk")
|
||||
[LAMBDA (X Y) (* ; "Edited 21-Oct-2024 00:27 by rmk")
|
||||
(* ; "Edited 9-Aug-2023 10:32 by rmk")
|
||||
(* gbn "19-Sep-84 21:39")
|
||||
(CL:UNLESS (EQ X Y)
|
||||
(HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y " was found.")))])
|
||||
(\TEDIT.THELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y
|
||||
" was found.")))])
|
||||
|
||||
(\TEST.CHARACTER.LOOKS
|
||||
[LAMBDA (BSTREAM) (* ; "Edited 17-Aug-2023 09:18 by rmk")
|
||||
@@ -1332,7 +1383,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TFBRAVO.ADD.NAMEDTAB
|
||||
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 9-Sep-2023 21:44 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")
|
||||
(* ; "Edited 15-Aug-2023 00:26 by rmk")
|
||||
(* ; "Edited 13-Aug-2023 19:56 by rmk")
|
||||
@@ -1341,43 +1396,43 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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. ")
|
||||
|
||||
(* ;; "")
|
||||
(* ; "")
|
||||
|
||||
(* ;; "THIS IS NOT USED, TO BE REMOVED. RUNTABOFFSETS DOESN'T EXIST")
|
||||
|
||||
(NOTUSED)
|
||||
(LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN))
|
||||
(TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC))
|
||||
(TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC)))
|
||||
(TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO))
|
||||
(TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))
|
||||
(TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN))
|
||||
TAB TABNAMES TABSPEC)
|
||||
TAB TABNAMES TABS)
|
||||
(SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS))
|
||||
(CL:WHEN TABDEFS
|
||||
[if TABNAMES
|
||||
then (SETQ TABSPEC (for TN in TABNAMES eachtime (add TN -1)
|
||||
when (SETQ TAB (CDR (ASSOC TN TABDEFS)))
|
||||
unless (EQ TAB T) until (EQ TN -1) collect TAB))
|
||||
then (SETQ TABS (for TN in TABNAMES eachtime (add TN -1)
|
||||
when (SETQ TAB (CDR (ASSOC TN TABDEFS)))
|
||||
unless (EQ TAB T) until (EQ TN -1) collect TAB))
|
||||
elseif (CDR TABDEFS)
|
||||
then
|
||||
(* ;; "If the run has no names, then assume that its first TAB aligns at the earliest defined tab, next aligns at the second, etc. Sort tabs by increasing TABX, not names. ")
|
||||
|
||||
[SETQ TABSPEC (SORT (for TD in TABDEFS collect (CDR TD))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
[SETQ TABS (SORT (for TD in TABDEFS collect (CDR TD))
|
||||
(FUNCTION (LAMBDA (T1 T2)
|
||||
(ILEQ (fetch (TAB TABX) of T1)
|
||||
(fetch (TAB TABX) of T2]
|
||||
elseif (EQ 0 (CAR (CAR TABDEFS)))
|
||||
then
|
||||
(* ;;
|
||||
"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 TABSPEC (NEQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC]
|
||||
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT
|
||||
TABSPEC)))
|
||||
(\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")
|
||||
@@ -1450,18 +1505,18 @@
|
||||
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6795 13177 (TEDIT.BRAVOFILE? 6805 . 8535) (TEDITFROMBRAVO 8537 . 13175)) (13288 28274 (
|
||||
\TFBRAVO.GET.USER.CM 13298 . 16108) (\TFBRAVO.USER.CM.LOOKS 16110 . 17285) (\TFBRAVO.READ.USER.CM
|
||||
17287 . 21624) (\TFBRAVO.INIT.PARALOOKS 21626 . 23387) (\TFBRAVO.INIT.PAGEFORMAT 23389 . 24269) (
|
||||
\TFBRAVO.GETPARAMS 24271 . 27125) (\TFBRAVO.FIND.LAST.TRAILER 27127 . 28272)) (28316 48329 (
|
||||
\TFBRAVO.PARSE.PARA 28326 . 32013) (\TFBRAVO.READ.PARALOOKS 32015 . 38649) (\TFBRAVO.CREATE.RUNS 38651
|
||||
. 40039) (\TFBRAVO.READ.CHARLOOKS 40041 . 45059) (\TFBRAVO.FONT.FROM.CHARLOOKS 45061 . 46430) (
|
||||
\TFBRAVO.READNUM? 46432 . 48327)) (48366 59117 (\TFBRAVO.HANDLE.HEADING 48376 . 51008) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 51010 . 59115)) (59160 80307 (\TFBRAVO.INSERT.PARA 59170 . 59823) (
|
||||
\TFBRAVO.INSERT.RUN 59825 . 63022) (\TFBRAVO.SPLIT.PARA 63024 . 70266) (\TFBRAVO.RUN.TABSPEC 70268 .
|
||||
74612) (\TFBRAVO.INSTALL.PAGEFORMAT 74614 . 80305)) (80308 84268 (\TFBRAVO.ASSERT 80318 . 80665) (
|
||||
\TEST.CHARACTER.LOOKS 80667 . 82553) (\TEST.PARAGRAPH.LOOKS 82555 . 84266)) (84753 91138 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 84763 . 88096) (\TFBRAVO.COPY.NAMEDTAB 88098 . 88546) (\TFBRAVO.PUT.NAMEDTAB
|
||||
88548 . 88828) (\TFBRAVO.GET.NAMEDTAB 88830 . 89207) (\NAMEDTABNYET 89209 . 89369) (\NAMEDTABSIZE
|
||||
89371 . 89886) (\NAMEDTABPREPRINT 89888 . 90086) (\TEDIT.NAMEDTAB.INIT 90088 . 91136)))))
|
||||
(FILEMAP (NIL (6790 13568 (TEDIT.BRAVOFILE? 6800 . 8530) (TEDITFROMBRAVO 8532 . 13566)) (13679 29406 (
|
||||
\TFBRAVO.GET.USER.CM 13689 . 16499) (\TFBRAVO.USER.CM.LOOKS 16501 . 17836) (\TFBRAVO.READ.USER.CM
|
||||
17838 . 22408) (\TFBRAVO.INIT.PARALOOKS 22410 . 24519) (\TFBRAVO.INIT.PAGEFORMAT 24521 . 25401) (
|
||||
\TFBRAVO.GETPARAMS 25403 . 28257) (\TFBRAVO.FIND.LAST.TRAILER 28259 . 29404)) (29448 50146 (
|
||||
\TFBRAVO.PARSE.PARA 29458 . 33385) (\TFBRAVO.READ.PARALOOKS 33387 . 40277) (\TFBRAVO.CREATE.RUNS 40279
|
||||
. 41667) (\TFBRAVO.READ.CHARLOOKS 41669 . 46698) (\TFBRAVO.FONT.FROM.CHARLOOKS 46700 . 48247) (
|
||||
\TFBRAVO.READNUM? 48249 . 50144)) (50183 61224 (\TFBRAVO.HANDLE.HEADING 50193 . 52920) (
|
||||
\TFBRAVO.PARSE.PROFILE.PARA 52922 . 61222)) (61267 83303 (\TFBRAVO.INSERT.PARA 61277 . 62118) (
|
||||
\TFBRAVO.INSERT.RUN 62120 . 65422) (\TFBRAVO.SPLIT.PARA 65424 . 72739) (\TFBRAVO.RUN.TABSPEC 72741 .
|
||||
77608) (\TFBRAVO.INSTALL.PAGEFORMAT 77610 . 83301)) (83304 87447 (\TFBRAVO.ASSERT 83314 . 83844) (
|
||||
\TEST.CHARACTER.LOOKS 83846 . 85732) (\TEST.PARAGRAPH.LOOKS 85734 . 87445)) (87932 94587 (
|
||||
\TFBRAVO.ADD.NAMEDTAB 87942 . 91545) (\TFBRAVO.COPY.NAMEDTAB 91547 . 91995) (\TFBRAVO.PUT.NAMEDTAB
|
||||
91997 . 92277) (\TFBRAVO.GET.NAMEDTAB 92279 . 92656) (\NAMEDTABNYET 92658 . 92818) (\NAMEDTABSIZE
|
||||
92820 . 93335) (\NAMEDTABPREPRINT 93337 . 93535) (\TEDIT.NAMEDTAB.INIT 93537 . 94585)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
@@ -1,23 +1,24 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Mar-2024 11:16:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;120 47172
|
||||
(FILECREATED "16-Mar-2025 00:20:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;208 53292
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}<library>TEDIT>tedit-exports.all;118)
|
||||
:PREVIOUS-DATE "19-Feb-2025 12:22:24" {WMEDLEY}<library>TEDIT>tedit-exports.all;207)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
PRINT))))))))
|
||||
(FILESLOAD (FROM LOADUPS) EXPORTS.ALL)
|
||||
(PUTPROPS TEDIT-ASSERT MACRO (ARGS (COND (CHECK-TEDIT-ASSERTIONS (BQUOTE (CL:UNLESS (\, (CAR ARGS)) (
|
||||
HELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS))))))))
|
||||
\TEDIT.THELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS)
|
||||
)))))))
|
||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||
(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 "20-Mar-2024 11:08:26"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "16-Mar-2025 00:16:31"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -43,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)
|
||||
@@ -52,23 +52,24 @@ 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 "20-Mar-2024 11:07:07"))
|
||||
(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)).") (* ;;
|
||||
"If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
|
||||
) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ;
|
||||
"X value of left edge of selection on the first line") NIL (* ;
|
||||
"Was DX: Width of the selection, if it's on one line.") CH# (* ; "CH# of the first selected character"
|
||||
) XLIM (* ; "X value of right edge of last selected character on the last line") CHLIM (* ;
|
||||
"X value of left edge of selection on the first line") SELLINES (* ;
|
||||
"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line."
|
||||
) CH# (* ; "CH# of the first selected character") XLIM (* ;
|
||||
"X value of right edge of last selected character on the last line") CHLIM (* ;
|
||||
"Last character is at (SUB1 CHLIM)") DCH (* ;
|
||||
"# of characters selected (can be zero, for empty/point selection.) This controls highlighting") L1 (*
|
||||
; "-> line descriptor for the line where the first selected character is") LN (* ;
|
||||
"-> line descriptor for the line which contains the end of the selection") NIL (* ;
|
||||
"Was YLIM: Y value of the bottom of the line that ends the selection") POINT (* ;
|
||||
"Which end should the caret appear at? (LEFT or RIGHT)") (SET FLAG) (* ;
|
||||
"T if this selection is real; NIL if not") (SELTEXTOBJ FULLXPOINTER) (* ;
|
||||
"TEXTOBJ that describes the selected text") SELKIND (* ;
|
||||
"T if this selection is real; NIL if not") (SELTEXTSTREAM FULLXPOINTER) (* ;
|
||||
"TEXTSTREAM that describes the selected text") SELKIND (* ;
|
||||
"What kind of selection? CHAR or WORD or LINE or PARA") HOW (* ;
|
||||
"SHADE used to highlight this selection") HOWHEIGHT (* ;
|
||||
"Height of the highlight (1 usually, full line for delete selection...)") (HASCARET FLAG) (* ;
|
||||
@@ -76,44 +77,50 @@ by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
"If this selection is inside an object, which object?") (ONFLG FLAG) (* ;
|
||||
"T if the selection is highlighted on the screen, else NIL") SELOBJINFO (* ;
|
||||
"A Place for the selected object to put info about selection inside itself.")) (INIT (DEFPRINT (QUOTE
|
||||
SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS (DX (AND (FIXP (fetch (SELECTION X0) of
|
||||
DATUM)) (FIXP (fetch (SELECTION XLIM) of DATUM)) (IDIFFERENCE (fetch (SELECTION XLIM) of DATUM) (fetch
|
||||
(SELECTION X0) of DATUM))))) SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (
|
||||
QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST NIL))
|
||||
SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS ((SELTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of (GETSEL DATUM SELTEXTSTREAM))) (CHLAST (STANDARD (SUB1 (GETSEL DATUM CHLIM)) (SETSEL DATUM CHLIM (
|
||||
ADD1 NEWVALUE))) (FAST (SUB1 (FSETSEL DATUM CHLIM)) (FSETSEL DATUM CHLIM (ADD1 NEWVALUE)))))) SET _
|
||||
NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST
|
||||
NIL))
|
||||
(DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR))
|
||||
(DEFPRINT (QUOTE SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))
|
||||
(RPAQQ COPYSELSHADE 30583)
|
||||
(RPAQQ COPYLOOKSSELSHADE 30583)
|
||||
(RPAQQ EDITMOVESHADE -1)
|
||||
(RPAQ EDITMOVESHADE BLACKSHADE)
|
||||
(RPAQQ EDITGRAY 32800)
|
||||
(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800))
|
||||
(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (fetch (LINEDESCRIPTOR LCHAR1) of
|
||||
LINE)) (ILEQ CHNO (fetch (LINEDESCRIPTOR LCHARLIM) of LINE)) LINE)))
|
||||
(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLIM) (AND (IGEQ CHLIM (GETLD L LCHAR1)) (ILEQ CH# (
|
||||
FGETLD L LCHARLIM)))))
|
||||
(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800))
|
||||
(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (GETLD LINE LCHAR1)) (ILESSP CHNO
|
||||
(FGETLD LINE LCHARLIM)) LINE)))
|
||||
(PUTPROPS FWITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (FGETLD LINE LCHAR1)) (ILESSP
|
||||
CHNO (FGETLD LINE LCHARLIM)) LINE)))
|
||||
(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (AND (IGEQ (GETLD L LCHARLAST) CH#) (ILEQ (
|
||||
FGETLD L LCHAR1) CHLAST))))
|
||||
(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ;
|
||||
"True if a CH#..CHLAST selection would include L") (AND (IGREATERP (FGETLD L LCHARLIM) CH#) (ILEQ (
|
||||
FGETLD L LCHAR1) CHLAST))))
|
||||
(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (AND (IGEQ X LOW) (ILEQ X HIGH))))
|
||||
(PUTPROPS GETSEL MACRO ((S FIELD) (fetch (SELECTION FIELD) of S)))
|
||||
(PUTPROPS SETSEL MACRO ((S FIELD NEWVALUE) (replace (SELECTION FIELD) of S with NEWVALUE)))
|
||||
(PUTPROPS FGETSEL MACRO ((S FIELD) (ffetch (SELECTION FIELD) of S)))
|
||||
(PUTPROPS FSETSEL MACRO ((S FIELD NEWVALUE) (freplace (SELECTION FIELD) of S with NEWVALUE)))
|
||||
(PUTPROPS SELECTION! MACRO ((SEL) (\DTEST SEL (QUOTE SELECTION))))
|
||||
(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (BIND
|
||||
$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY DECLARE (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST
|
||||
$$SPLENGTH) FIRST (\DTEST (OR $$SELPIECES (GO $$OUT)) (QUOTE SELPIECES)) (SETQ I.V. (SETQ $$SPFIRST (
|
||||
\DTEST (ffetch (SELPIECES SPFIRST) of $$SELPIECES) (QUOTE PIECE)))) (SETQ $$SPLAST (\DTEST (ffetch (
|
||||
SELPIECES SPLAST) of $$SELPIECES) (QUOTE PIECE))) (SETQ $$SPLENGTH (ffetch (SELPIECES SPLEN) of
|
||||
$$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE PIECE)))))) T)
|
||||
(PUTPROPS GETSPC MACRO ((SP FIELD) (fetch (SELPIECES FIELD) of SP)))
|
||||
(PUTPROPS SETSPC MACRO ((SP FIELD NEWVALUE) (replace (SELPIECES FIELD) of SP with NEWVALUE)))
|
||||
(PUTPROPS FGETSPC MACRO ((SP FIELD) (ffetch (SELPIECES FIELD) of SP)))
|
||||
(PUTPROPS FSETSPC MACRO ((SP FIELD NEWVALUE) (freplace (SELPIECES FIELD) of SP with NEWVALUE)))
|
||||
(PUTPROPS SELPIECES! MACRO ((SPC) (\DTEST SPC (QUOTE SELPIECES))))
|
||||
(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
|
||||
(GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION
|
||||
TEDIT.DELETESELECTION)
|
||||
(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (bind
|
||||
$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY declare (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST
|
||||
$$SPLENGTH) first (SETQ I.V. (SETQ $$SPFIRST (\DTEST (OR (fetch (SELPIECES SPFIRST) of $$SELPIECES) (
|
||||
GO $$OUT)) (QUOTE PIECE)))) (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) (SETQ $$SPLENGTH
|
||||
(fetch (SELPIECES SPLEN) of $$SELPIECES)) while I.V. repeatuntil (EQ I.V. $$SPLAST) by (NEXTPIECE
|
||||
I.V.))))) T)
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:55"))
|
||||
(DATATYPE THISLINE ((* ;;
|
||||
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
|
||||
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
|
||||
"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ;
|
||||
"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width."
|
||||
) CHARSLOTS (* ;
|
||||
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
|
||||
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
|
||||
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 22:39:40"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
"The bitmap that will be used by this instance of the cache") (LCNEXTCACHE FULLXPOINTER) (* ;
|
||||
"The next cache in the chain, for screen updates.")))
|
||||
@@ -125,12 +132,13 @@ CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.
|
||||
RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ;
|
||||
"X value of right edge of LCHARLIM character on the line (may exceed right margin, if char is a space.). In natural stream units"
|
||||
) LX1 (* ; "X value of the left edge of LCHAR1 from the left margin, in stream natural units.")
|
||||
LHEIGHT (* ; "Total height of hte line, Ascent+Descent plus leading") ASCENT (* ;
|
||||
"Ascent of the line above YBASE, adjusted for line leading") DESCENT (* ;
|
||||
LHEIGHT (* ;
|
||||
"Total height of hte line, Ascent+Descent plus leading. Includes paragraph and line leading") LASCENT
|
||||
(* ; "Ascent of the line above YBASE, adjusted for line and paragraph leading") LDESCENT (* ;
|
||||
"How far line descends below YBASE, adjusted for line leading") LTRUEDESCENT (* ;
|
||||
"The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ;
|
||||
"The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") LCHAR1 (* ;
|
||||
"CH# of the first character on the line.") LCHARLIM (* ; "CH# of the last character on the line")
|
||||
"CH# of the first character on the line.") LCHARLAST (* ; "CH# of the last character on the line")
|
||||
FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
|
||||
"Was CHARTOP: CH# of the character which forced the line break (may be less than CHARLIM)") NEXTLINE
|
||||
(* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ;
|
||||
@@ -140,20 +148,28 @@ 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)") (LDIRTY FLAG) (* ;
|
||||
"T if this line has changed since it was last formatted.") (NIL FLAG) (* ; "Was FORCED-END flag") (
|
||||
DELETED FLAG) (* ;
|
||||
"T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)"
|
||||
) (LHASPROT FLAG) (* ; "This line contains protected text.") (LDUMMY FLAG) (* ;
|
||||
) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LPARALOOKS
|
||||
(* ; "The paragraph looks for this line's paragraph (eventually)") (NIL FLAG) (* ;
|
||||
"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)"
|
||||
) (NIL FLAG) (* ; "Was LHASPROT This line contains protected text.") (LDUMMY FLAG) (* ;
|
||||
"This is a dummy line. Was: LHASTABS. But never fetched and this descriptions wasn't true: If this line has a tab in it, this is the line-relative ch# of the final tab. This is to let us punt properly with tabs in a line."
|
||||
) (1STLN FLAG) (* ; "This line is the first line in a paragraph") (LSTLN FLAG) (* ;
|
||||
"This is the last line in a paragraph")) (INIT (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION
|
||||
\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (IPLUS (FGETLD DATUM YBOT) (FGETLD DATUM LHEIGHT))
|
||||
) (LTRUEHEIGHT (IPLUS (FGETLD DATUM LTRUEASCENT (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYTOP (IPLUS (
|
||||
GETLD DATUM YBOT) (FGETLD DATUM LTRUEHEIGHT))) (LTRUEYBOT (IDIFFERENCE (FGETLD DATUM YBASE) (FGETLD
|
||||
DATUM LTRUEDESCENT))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LCHARLIM _ 1000000 NEXTLINE _ NIL
|
||||
PREVLINE _ NIL LDIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL)
|
||||
\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (STANDARD (IPLUS (GETLD DATUM YBASE) (GETLD DATUM
|
||||
LASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM LASCENT)))) (LTRUEYTOP (STANDARD (IPLUS (
|
||||
GETLD DATUM YBASE) (FGETLD DATUM LTRUEASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM
|
||||
LTRUEASCENT)))) (LTRUEHEIGHT (STANDARD (IPLUS (GETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT))
|
||||
FAST (IPLUS (FGETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYBOT (STANDARD (
|
||||
IDIFFERENCE (GETLD DATUM YBASE) (FGETLD DATUM LTRUEDESCENT)) FAST (IDIFFERENCE (FGETLD DATUM YBASE) (
|
||||
FGETLD DATUM LTRUEDESCENT)))) (LLEADBEFORE (STANDARD (IDIFFERENCE (GETLD DATUM LASCENT) (FGETLD DATUM
|
||||
LTRUEASCENT)) FAST (IDIFFERENCE (FGETLD DATUM LASCENT) (FGETLD DATUM LTRUEASCENT)))) (LCHARLIM (
|
||||
STANDARD (ADD1 (GETLD DATUM LCHARLAST)) FAST (ADD1 (FGETLD DATUM LCHARLAST))) (STANDARD (SETLD DATUM
|
||||
LCHARLAST (SUB1 NEWVALUE)) FAST (FSETLD DATUM LCHARLAST (SUB1 NEWVALUE)))) (LNCH (STANDARD (
|
||||
IDIFFERENCE (GETLD DATUM LCHARLIM) (GETLD DATUM LCHAR1)) FAST (IDIFFERENCE (FGETLD DATUM LCHARLIM) (
|
||||
FGETLD DATUM LCHAR1)))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 YBOT _ 0 YBASE _ 0 LEFTMARGIN _
|
||||
0)
|
||||
(DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT))
|
||||
(I.S.OPR (QUOTE inlines) NIL (QUOTE (bind $$PREVLINE declare (LOCALVARS $$PREVLINE) first (SETQ I.V. (
|
||||
\DTEST (OR BODY (GO $$OUT)) (QUOTE LINEDESCRIPTOR))) by (PROGN (SETQ $$PREVLINE I.V.) (\DTEST (OR (
|
||||
@@ -165,18 +181,39 @@ fetch (LINEDESCRIPTOR PREVLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR))))))
|
||||
(PUTPROPS FGETLD MACRO ((L FIELD) (ffetch (LINEDESCRIPTOR FIELD) of L)))
|
||||
(PUTPROPS SETLD MACRO ((L FIELD NEWVALUE) (replace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
|
||||
(PUTPROPS FSETLD MACRO ((L FIELD NEWVALUE) (freplace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
|
||||
(PUTPROPS SETYPOS MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE DESCENT) (
|
||||
(PUTPROPS SETYBOT MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE LDESCENT) (
|
||||
FSETLD LINE YBOT BOTTOM)))))
|
||||
(PUTPROPS SETYTOP MACRO (OPENLAMBDA (LINE TOP) (SETYBOT LINE (IDIFFERENCE TOP (GETLD LINE LHEIGHT)))))
|
||||
(PUTPROPS SETYBASE MACRO (OPENLAMBDA (LINE BASE) (FSETLD LINE YBOT (IDIFFERENCE (GETLD LINE LDESCENT)
|
||||
(FSETLD LINE YBASE BASE)))))
|
||||
(PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN
|
||||
LINE2 (SETLD LINE2 PREVLINE LINE1))))
|
||||
(PUTPROPS LINEDESCRIPTOR! MACRO ((LD) (\DTEST LD (QUOTE LINEDESCRIPTOR))))
|
||||
(PUTPROPS HCSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
|
||||
FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
|
||||
(PUTPROPS HCUNSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
|
||||
FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
||||
(PUTPROPS SCALEUP MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I in
|
||||
ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
|
||||
(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I
|
||||
in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
(ADDTOVAR CHARACTERNAMES (EM-DASH "357,045") (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (
|
||||
NONBREAKING-SPACE "357,041"))
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
||||
192) (ILEQ CHAR 207))))
|
||||
(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
|
||||
FGETLD LINE LHEIGHT) HEIGHT))))
|
||||
(* ; "Formatting slots held by THISLINE")
|
||||
(DATATYPE THISLINE ((* ;;
|
||||
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
|
||||
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
|
||||
"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ;
|
||||
"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width."
|
||||
) CHARSLOTS (* ;
|
||||
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
|
||||
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
|
||||
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
|
||||
(BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS.")))
|
||||
(PUTPROPS CHAR MACRO ((CSLOT) (ffetch (CHARSLOT CHAR) of CSLOT)))
|
||||
(PUTPROPS CHARW MACRO ((CSLOT) (ffetch (CHARSLOT CHARW) of CSLOT)))
|
||||
@@ -224,9 +261,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)
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
||||
192) (ILEQ CHAR 207))))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:35"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 6-Mar-2025 11:42:48"))
|
||||
(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)."
|
||||
@@ -234,8 +269,8 @@ repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
|
||||
PBYTELEN (* ; "Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (* ;
|
||||
"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.")
|
||||
NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ;
|
||||
"-> Prior piece in this text object.") PLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (* ;
|
||||
"The number of bytes per character, given that all characters in a piece are the same length.") (
|
||||
"-> Prior piece in this text object.") PCHARLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (*
|
||||
; "The number of bytes per character, given that all characters in a piece are the same length.") (
|
||||
PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") (
|
||||
PNEW FLAG) (* ;
|
||||
"This text is new here; used by the tentative edit system, and anyone else interested.") (NIL FLAG) (
|
||||
@@ -243,28 +278,31 @@ PNEW FLAG) (* ;
|
||||
XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ;
|
||||
"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;
|
||||
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
|
||||
POBJ (IMAGEOBJP (PCONTENTS DATUM))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _
|
||||
TEDIT.DEFAULT.FMTSPEC)
|
||||
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
|
||||
PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM) FAST (fetch (PIECE PCHARLOOKS) of DATUM)) (
|
||||
STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE) FAST (freplace (PIECE PCHARLOOKS) of
|
||||
DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
|
||||
(DATATYPE TEXTOBJ ((* ;;
|
||||
"This is where TEdit stores its state information, and internal data about the text being edited.")
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PANES (* ;
|
||||
"A list of panes (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")
|
||||
NIL (* ;
|
||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
||||
"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
|
||||
) SUFFIXPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
|
||||
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# (* ;
|
||||
"Was # of characters already in the piece.") INSERTSTRING (* ;
|
||||
"A substring of storage that is available for an insertion.") TXTHISTORYUNDONE (* ;
|
||||
"Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece."
|
||||
) (TXTLINELEADINGABOVE FLAG) (* ;
|
||||
"NIL for old/existing Tedit files whose lines are formatted with leading below, T for newer files. Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL."
|
||||
) \WINDOW (* ; "The window-pane<s> where this textobj is displayed") MOUSEREGION (* ;
|
||||
"Section of the window the mouse is in.") NIL (* ;
|
||||
) (NIL FLAG) (* ;
|
||||
" Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL."
|
||||
) (TXTREADONLYQUIET FLAG) (* ; "T => don't print READONLY abort messages") PARABREAKCHARS (* ;
|
||||
"Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE"
|
||||
) MOUSEREGION (* ; "Section of the window the mouse is in.") LOOPFN (* ;
|
||||
"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") SCRATCHSEL (* ;
|
||||
"Scratch space for the selection code") SCRATCHSEL2 (* ;
|
||||
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 (* ;
|
||||
@@ -272,12 +310,12 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG)
|
||||
(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
|
||||
"-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ;
|
||||
"T => The guy has asked the editor to go way") CARET (* ;
|
||||
"Describes the flashing caret for the editing window") CARETLOOKS (* ;
|
||||
"T => The guy has asked the editor to go way") NIL (* ;
|
||||
"Was CARET: Describes the flashing caret for the editing window") CARETLOOKS (* ;
|
||||
"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) (* ;
|
||||
@@ -292,7 +330,8 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
|
||||
"The READTABLE to be used to decide on word breaks") EDITPROPS (* ;
|
||||
"The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ;
|
||||
"T if the next insertion in this document is to be preceded by a deletion of the then-current selection"
|
||||
) TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ;
|
||||
) (TXTHISTORYINACTIVE FLAG) (* ; "T if history events are not recorded (e.g. for transcript files)")
|
||||
TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ;
|
||||
"The pane in which the last 'real' selection got made for this edit; used by TEDIT.NORMALIZECAREET")
|
||||
PROMPTWINDOW (* ;
|
||||
"A window to be used for unscheduled interactions; normally a small window above the edit window")
|
||||
@@ -301,18 +340,20 @@ 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") (
|
||||
TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ;
|
||||
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) (* ;
|
||||
"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 (* ;
|
||||
"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) SCRATCHSEL _ (create SELECTION) SCRATCHSEL2 _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0
|
||||
WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 TXTFILE _ NIL \XDIRTY _ NIL MOUSEREGION _ (QUOTE TEXT) THISLINE _ (
|
||||
create THISLINE) MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL INSERTSTRING _ NIL)
|
||||
(\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)
|
||||
@@ -320,23 +361,25 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i
|
||||
(PIECE (fetch (STREAM F5) of DATUM) (REPLACE (STREAM F5) OF DATUM WITH NEWVALUE)) (* ;
|
||||
"The PIECE we're currently fetching chars from/putting chars into") (PCCHARSLEFT (fetch (STREAM F1) of
|
||||
DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") (
|
||||
CURRENTLOOKS (fetch (STREAM F10) of DATUM) (replace (STREAM F10) of DATUM with NEWVALUE)) (* ;
|
||||
"The CHARLOOKS that are currently applicable to characters being taken from the stream.") (
|
||||
CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with
|
||||
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."
|
||||
) (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ;
|
||||
"Function to be called 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 STREAM BINABLE _ NIL BOUTABLE _ NIL
|
||||
ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4
|
||||
_ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL)))
|
||||
"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
|
||||
STREAM BINABLE _ NIL BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _
|
||||
\TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS
|
||||
IMAGEDATA _ NIL)))
|
||||
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
|
||||
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
|
||||
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
|
||||
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
|
||||
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
|
||||
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
|
||||
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
(PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
|
||||
(PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
|
||||
(PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
|
||||
@@ -345,16 +388,16 @@ ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _
|
||||
(PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC)))
|
||||
(PUTPROPS PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC)))
|
||||
(PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
|
||||
(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
|
||||
(PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
|
||||
(PUTPROPS FSETPC MACRO ((PC FIELD NEWVALUE) (freplace (PIECE FIELD) of PC with NEWVALUE)))
|
||||
(PUTPROPS GETPC MACRO ((PC FIELD) (fetch (PIECE FIELD) of PC)))
|
||||
(PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
|
||||
(PUTPROPS THINPIECEP MACRO ((PC) (* ;;
|
||||
"Assume that objects start out thin, for CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care."
|
||||
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) (OBJECT.PTYPE
|
||||
T) NIL)))
|
||||
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (NOT (OR (EQ 0 (PLEN PC)) (fetch (CHARLOOKS CLINVISIBLE) of (
|
||||
PLOOKS PC))))))
|
||||
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) NIL)))
|
||||
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC)
|
||||
CLINVISIBLE)))))
|
||||
(PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat (
|
||||
VISIBLEPIECEP NPC))))
|
||||
(PUTPROPS \PREV.VISIBLE.PIECE MACRO ((PC) (find PPC backpieces (AND PC (PREVPIECE PC)) suchthat (
|
||||
@@ -366,12 +409,18 @@ VISIBLEPIECEP PPC))))
|
||||
(PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ)))
|
||||
(PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ)))
|
||||
(PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ))))
|
||||
(PUTPROPS GETTSTR MACRO ((TSTR FIELD) (fetch (TEXTSTREAM FIELD) of TSTR)))
|
||||
(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
|
||||
(PUTPROPS FGETTSTR MACRO ((TSTR FIELD) (ffetch (TEXTSTREAM FIELD) of TSTR)))
|
||||
(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
|
||||
(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR
|
||||
TSTR TEXTOBJ)) TSTR)))
|
||||
(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
|
||||
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
|
||||
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
|
||||
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE))))
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))))
|
||||
(RPAQQ THINFILE.PTYPE 0)
|
||||
(RPAQQ FATFILE1.PTYPE 1)
|
||||
(RPAQQ FATFILE2.PTYPE 2)
|
||||
@@ -388,61 +437,37 @@ UTF16LE.PTYPE))
|
||||
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
||||
(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
|
||||
(CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
|
||||
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
|
||||
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
|
||||
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)))
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:37"))
|
||||
(RPAQQ NONE.TTC 0)
|
||||
(RPAQQ CHARDELETE.TTC 1)
|
||||
(RPAQQ WORDDELETE.TTC 2)
|
||||
(RPAQQ DELETE.TTC 3)
|
||||
(RPAQQ FUNCTIONCALL.TTC 4)
|
||||
(RPAQQ REDO.TTC 5)
|
||||
(RPAQQ UNDO.TTC 6)
|
||||
(RPAQQ CMD.TTC 7)
|
||||
(RPAQQ NEXT.TTC 8)
|
||||
(RPAQQ EXPAND.TTC 9)
|
||||
(RPAQQ CHARDELETE.FORWARD.TTC 10)
|
||||
(RPAQQ WORDDELETE.FORWARD.TTC 11)
|
||||
(RPAQQ PUNCT.TTC 20)
|
||||
(RPAQQ TEXT.TTC 21)
|
||||
(RPAQQ WHITESPACE.TTC 22)
|
||||
(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (
|
||||
REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) (
|
||||
WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* Test to see if only the specified mouse button is down.
|
||||
DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it WAS called.) (
|
||||
SELECTQ (CAR BUTTON) (LEFT (QUOTE (IEQP LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (IEQP LASTMOUSEBUTTONS 1)
|
||||
)) (RIGHT (QUOTE (IEQP LASTMOUSEBUTTONS 2))) (SHOULDNT))))
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:39:40"))
|
||||
(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))
|
||||
) (RIGHT (QUOTE (EQ LASTMOUSEBUTTONS 2))) (SHOULDNT))))
|
||||
(PUTPROPS \TEDIT.CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (for
|
||||
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 "20-Mar-2024 11:07:16"))
|
||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 23:21:12"))
|
||||
(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 "20-Mar-2024 11:06:52"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:42"))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "14-Mar-2025 15:29:22"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:09:40"))
|
||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||
CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;;
|
||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||
"The font descriptor for these characters") CLFONTUNPARSE (* ;;
|
||||
"Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
|
||||
) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") (
|
||||
CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
) NIL (* ; "Was CLSIZE. Font size, in points") (NIL FLAG) (* ;
|
||||
"Was CLITAL: T if the characters are italic, else NIL") (NIL FLAG) (* ;
|
||||
"Was CLBoldT if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ;
|
||||
"T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ;
|
||||
"T if the characters are to be struck thru, else nil.") CLOFFSET (* ;
|
||||
@@ -450,9 +475,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"T if small caps, else NIL") (CLINVERTED FLAG) (* ;
|
||||
"T if the characters are to be shown white-on-black") (CLPROTECTED FLAG) (* ;
|
||||
"T if chars can't be selected, else NIL") (CLINVISIBLE FLAG) (* ;
|
||||
"T if TEDIT is to ignore these chars; else NIL") (CLSELHERE FLAG) (* ;;
|
||||
"T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED."
|
||||
) (CLCANCOPY FLAG) (* ;;
|
||||
"T if TEDIT is to ignore these chars; else NIL") (CLSELAFTER FLAG) (* ;
|
||||
"T if TEDIT can put selection after this char (for menu fields).") (* ;; "Was CLSELHERE. ") (CLCANCOPY
|
||||
FLAG) (* ;;
|
||||
"T if this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)"
|
||||
) (CLUNBREAKABLE FLAG) (* ; "Spaces are treated as nonbreaking spaces") CLSTYLE (* ;
|
||||
"The style to be used in marking these characters; overridden by the other fields") CLUSERINFO (* ;
|
||||
@@ -461,8 +486,11 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs."
|
||||
) (CLMARK FLAG) (* ;;
|
||||
"Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
|
||||
)) CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
|
||||
(DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
|
||||
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields)."))
|
||||
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))) (ACCESSFNS (
|
||||
CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (CHARLOOKS CLFONTUNPARSE) of DATUM with
|
||||
NEWVALUE))))
|
||||
(DATATYPE PARALOOKS ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
|
||||
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 (* ;
|
||||
@@ -470,9 +498,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
|
||||
"Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") LINELEAD (* ;
|
||||
"Leading between lines, in points. This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented."
|
||||
) FMTBASETOBASE (* ;
|
||||
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
|
||||
TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default tab width") QUAD (* ;
|
||||
"How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
|
||||
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
|
||||
NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width")
|
||||
QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
|
||||
"The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ;
|
||||
"The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)"
|
||||
) FMTUSERINFO (* ; "Space for a PLIST of user info") FMTSPECIALX (* ;
|
||||
@@ -492,17 +520,36 @@ TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default t
|
||||
) (FMTHARDCOPY FLAG) (* ; "T if this paragraph is to be displayed in hardcopy-format.") FMTREVISED (*
|
||||
;
|
||||
"T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output."
|
||||
) FMTHARDCOPYSCALE) (* ;
|
||||
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T)"
|
||||
) (INIT (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
|
||||
LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL))
|
||||
) FMTHARDCOPYSCALE (* ;
|
||||
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T"
|
||||
) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT (
|
||||
DEFPRINT (QUOTE PARALOOKS) (FUNCTION \TEDIT.PARALOOKS.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
|
||||
LINELEAD _ 0)
|
||||
(DEFPRINT (QUOTE 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)))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:29"))
|
||||
(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 CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
|
||||
(PUTPROPS GETPLOOKS MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS SETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
|
||||
))
|
||||
(PUTPROPS FGETPLOOKS MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||
NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||
(PUTPROPS FSETPARA MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)
|
||||
))
|
||||
(PUTPROPS FGETPARA MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS GETPARA MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
|
||||
(PUTPROPS SETPARA MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "21-Feb-2025 09:49:05"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:31:28"))
|
||||
(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
|
||||
@@ -513,64 +560,86 @@ the caret up during screen updates) TCCARETX (* X position in the window that th
|
||||
TCCARETY (* Y position in the window where the caret appears) TCCARET (* A lisp CARET to be flashed (
|
||||
eventually))) TCNOWTIME _ (CREATECELL \FIXP) TCTHENTIME _ (CREATECELL \FIXP) TCCURSORBM _ BXCARET
|
||||
TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET))
|
||||
(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM (QUOTE TEDIT-NEXT-PANE-DOWN)) (PUTWINDOWPROP
|
||||
DATUM (QUOTE TEDIT-NEXT-PANE-DOWN) NEWVALUE)) (WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (
|
||||
PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (
|
||||
TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
|
||||
WTEXTSTREAM) of DATUM))) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES
|
||||
) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (
|
||||
QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM
|
||||
(QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP
|
||||
DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN))
|
||||
(LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN) NV) NV))))
|
||||
(DATATYPE PANE ((XPWINDOW FULLXPOINTER) PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER))
|
||||
(ACCESSFNS (PWINDOW (PROGN DATUM))))
|
||||
(PUTPROPS FGETPANE MACRO ((P FIELD) (ffetch (PANE FIELD) of P)))
|
||||
(PUTPROPS GETPANE MACRO ((P FIELD) (fetch (PANE FIELD) of P)))
|
||||
(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) (replace (PANE FIELD) of P with NEWVALUE)))
|
||||
(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) (freplace (PANE FIELD) of P with NEWVALUE)))
|
||||
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (inside (fetch (TEXTOBJ \WINDOW) of BODY))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:16:27"))
|
||||
(TYPERECORD MB.3STATE ((* ;; "Describes a 3-state menu button.") MBLABEL (* ;
|
||||
"Label for the button on the screen") MBFONT (* ; "Font the label text should appear in")
|
||||
MBCHANGESTATEFN (* ; "Function to call when the button's state changes") MBINITSTATE (* ;
|
||||
"Button's initial state.")) MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
|
||||
(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) MBBUTTONEVENTFN _ (QUOTE MB.DEFAULTBUTTON.FN)
|
||||
MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
|
||||
(TYPERECORD MB.INSERT (MBINITENTRY))
|
||||
(TYPERECORD MB.MARGINBAR (ignoredfield))
|
||||
(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) MBFONT _ (
|
||||
FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
|
||||
(TYPERECORD MB.TEXT (MBSTRING MBFONT))
|
||||
(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) MBFONT _ (FONTCREATE (QUOTE
|
||||
HELVETICA) 8 (QUOTE BOLD)))
|
||||
(RECORD MBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (
|
||||
QUOTE MB.DISPLAY)) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.THREESTATE.DISPLAY)) (EQ (
|
||||
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE \TEXTMENU.TOGGLE.DISPLAY))))))
|
||||
(RECORD NWAYBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE
|
||||
MB.NB.DISPLAYFN)))))
|
||||
(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (TYPE? (AND (IMAGEOBJP DATUM) (EQ (
|
||||
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.MARGINBAR.DISPLAYFN)))))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:06"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 12:06:12"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "15-Mar-2024 14:07:55"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:37"))
|
||||
(ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (PUTWINDOWPROP DATUM (
|
||||
QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
|
||||
of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) (
|
||||
CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (QUOTE
|
||||
TEDIT.CURSORREGION) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (
|
||||
PUTWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (PANEPROPS (GETWINDOWPROP DATUM (QUOTE PANEPROPS)
|
||||
) (PUTWINDOWPROP DATUM (QUOTE PANEPROPS) NEWVALUE))) (TYPE? (AND (WINDOWP DATUM) (TYPENAMEP (fetch (
|
||||
TEXTWINDOW PTEXTOBJ) of DATUM) (QUOTE TEXTOBJ)))))
|
||||
(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") PREFIXLINE (* ;
|
||||
"Dummy line that covers all the characters above the first visible line") SUFFIXLINE (* ;
|
||||
"Dummy line that covers all the characters below the last visible line") PCARET NEXTPANE (PREVPANE
|
||||
XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION))
|
||||
(PUTPROPS FGETPANEPROP MACRO ((P FIELD) (ffetch (PANEPROPS FIELD) of P)))
|
||||
(PUTPROPS GETPANEPROP MACRO ((P FIELD) (fetch (PANEPROPS FIELD) of P)))
|
||||
(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) (replace (PANEPROPS FIELD) of P with NEWVALUE)))
|
||||
(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) (freplace (PANEPROPS FIELD) of P with NEWVALUE)))
|
||||
(PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE)))
|
||||
(PUTPROPS PANEPREFIX MACRO ((PANE) (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) PREFIXLINE))))
|
||||
(PUTPROPS PANESUFFIX MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) SUFFIXLINE)))
|
||||
(PUTPROPS PANETOPLINE MACRO ((PANE) (FGETLD (PANEPREFIX PANE) NEXTLINE)))
|
||||
(PUTPROPS PANECARET MACRO ((PANE) (\DTEST (GETPANEPROP (PANEPROPS PANE) PCARET) (QUOTE TEDITCARET))))
|
||||
(PUTPROPS PANESTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))
|
||||
(PUTPROPS PANETOBJ MACRO ((PANE) (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
|
||||
WTEXTSTREAM) of PANE)))))
|
||||
(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) (GETLD (PANESUFFIX PANE) PREVLINE)))
|
||||
(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) (FSETLD (PANEPREFIX PANE) LCHARLAST CHNO)))
|
||||
(PUTPROPS PANETOP MACRO ((PANE PREG) (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE)))))
|
||||
(PUTPROPS PANEWIDTH MACRO ((PANE PREG) (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
|
||||
)))
|
||||
(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
|
||||
)
|
||||
(PUTPROPS PANERIGHT MACRO ((PANE PREG) (fetch (REGION RIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
|
||||
)))
|
||||
(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
|
||||
)))))
|
||||
(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
|
||||
)))))
|
||||
(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (DSPCLIPPINGREGION NIL PANE))))
|
||||
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (bind $$BODY _ BODY declare (LOCALVARS $$BODY) first (SETQ I.V. (
|
||||
OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BODY) (GO $$OUT))) by (OR
|
||||
(GETPANEPROP (PANEPROPS I.V.) NEXTPANE) (GO $$OUT)))))
|
||||
(I.S.OPR (QUOTE backpanes) NIL (QUOTE (first (SETQ I.V. (OR (find P inpanes BODY suchthat (NULL (
|
||||
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
||||
$$OUT)))))
|
||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 00:33:15"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "14-Mar-2025 15:29:51"))
|
||||
(RPAQQ PTSPERPICA 12)
|
||||
(RPAQQ PTSPERINCH 72)
|
||||
(RPAQQ PICASPERINCH 6)
|
||||
(RPAQQ MICASPERINCH 2540)
|
||||
(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
|
||||
(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
|
||||
(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH))
|
||||
(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT
|
||||
PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT
|
||||
MICASPERINCH PTSPERINCH)))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 23:41:25"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 00:35:11"))
|
||||
(RPAQQ \TEDIT.TTCCODES ((NONE 0) (CHARDELETE 1) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
|
||||
UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT
|
||||
21) (WHITESPACE 22)))
|
||||
(CONSTANTS \TEDIT.TTCCODES)
|
||||
(PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "16-Mar-2025 00:03:34"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:34:37"))
|
||||
(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 (* ;
|
||||
"First piece involved") THOLDINFO (* ; "Old info, for undo") NIL (* ;
|
||||
"Was THAUXINFO: Auxiliary info about the event, primarily for redo") THDELETEDPIECES) (ACCESSFNS
|
||||
TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT THCH#) of DATUM) (IPLUS (fetch (
|
||||
TEDITHISTORYEVENT THCH#) of DATUM) (fetch (TEDITHISTORYEVENT THLEN) of DATUM)))))) (INIT (DEFPRINT (
|
||||
QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
|
||||
TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (TEDITHISTORYEVENT THCH#) of DATUM) 0) (OR (fetch (
|
||||
TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION
|
||||
\TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
|
||||
(DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))
|
||||
(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
|
||||
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
||||
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
|
||||
NEWVALUE)))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:20"))
|
||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 22:42:11"))
|
||||
(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."
|
||||
@@ -601,9 +670,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 "17-Mar-2024 18:15:40"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:27:18"))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "23-Feb-2025 10:06:16"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "11-Mar-2025 23:30:40"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:18:40"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-May-2024 14:53:20" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;260 131326
|
||||
(FILECREATED "20-Jan-2025 11:00:54" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;263 131893
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS COMPAREDIRECTORIES)
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259)
|
||||
:PREVIOUS-DATE "23-Dec-2024 23:54:13" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;262)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -15,6 +15,8 @@
|
||||
[
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
(FILES (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES
|
||||
CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE
|
||||
CD.UPDATEWIDTHS)
|
||||
@@ -59,6 +61,9 @@
|
||||
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
PDFSTREAM)
|
||||
(DEFINEQ
|
||||
|
||||
(COMPAREDIRECTORIES
|
||||
@@ -1955,6 +1960,8 @@
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 23-Dec-2024 23:53 by rmk")
|
||||
|
||||
(* ;; "Edited 21-May-2022 21:59 by rmk")
|
||||
|
||||
(* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
@@ -1968,52 +1975,64 @@
|
||||
(* ; "Close the previous ones")
|
||||
(CLOSEWITH.DOIT WINDOW))
|
||||
(LET (CHILDREN)
|
||||
(SETQ CHILDREN (SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE
|
||||
(WINDOWPROP WINDOW 'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1
|
||||
(RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2
|
||||
(RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(SETQ CHILDREN
|
||||
(SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
|
||||
WINDOW
|
||||
'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (if (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
else (TEDIT-SEE FILE1 (RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (if (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (TEDIT-SEE FILE2 (RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(IF (PDFFILEP FILE1)
|
||||
then (SEE-PDF FILE1)
|
||||
(CL:WHEN (PDFFILEP FILE2)
|
||||
(SEE-PDF FILE2))
|
||||
elseif (PDFFILEP FILE2)
|
||||
then (SEE-PDF FILE2)
|
||||
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
NIL))))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
|
||||
@@ -2202,25 +2221,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2526 22889 (COMPAREDIRECTORIES 2536 . 7871) (COMPAREDIRECTORIES.INFOS 7873 . 10831) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10833 . 14218) (CDENTRIES.SELECT 14220 . 18995) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18997 . 20123) (MATCHNAME 20125 . 20805) (CD.INSURECDVALUE 20807 . 22421
|
||||
) (CD.UPDATEWIDTHS 22423 . 22887)) (22890 33512 (CDFILES 22900 . 28914) (CDFILES.MATCH 28916 . 30541)
|
||||
(CDFILES.PATS 30543 . 33510)) (33513 51334 (CDPRINT 33523 . 36040) (CDPRINT.HEADER 36042 . 36939) (
|
||||
CDPRINT.LINE 36941 . 40173) (CDPRINT.MAXWIDTHS 40175 . 44290) (CDPRINT.COLHEADERS 44292 . 45577) (
|
||||
CDPRINT.COLUMNS 45579 . 50699) (CDTEDIT 50701 . 51332)) (51335 60456 (CDMAP 51345 . 52777) (CDENTRY
|
||||
52779 . 53088) (CDSUBSET 53090 . 54529) (CDMERGE 54531 . 58515) (CDMERGE.COMMON 58517 . 59832) (
|
||||
CD.SORT 59834 . 60454)) (60457 67995 (BINCOMP 60467 . 64756) (EOLTYPE 64758 . 67320) (EOLTYPE.SHOW
|
||||
67322 . 67993)) (68523 81050 (FIND-UNCOMPILED-FILES 68533 . 72176) (FIND-UNSOURCED-FILES 72178 . 74562
|
||||
) (FIND-SOURCE-FILES 74564 . 76302) (FIND-COMPILED-FILES 76304 . 78181) (FIND-UNLOADED-FILES 78183 .
|
||||
79036) (FIND-LOADED-FILES 79038 . 79466) (FIND-MULTICOMPILED-FILES 79468 . 81048)) (81051 89482 (
|
||||
CREATED-AS 81061 . 85858) (SOURCE-FOR-COMPILED-P 85860 . 88787) (COMPILE-SOURCE-DATE-DIFF 88789 .
|
||||
89480)) (89483 100246 (FIX-DIRECTORY-DATES 89493 . 92943) (FIX-EQUIV-DATES 92945 . 94470) (
|
||||
COPY-COMPARED-FILES 94472 . 96293) (COPY-MISSING-FILES 96295 . 98452) (COMPILED-ON-SAME-SOURCE 98454
|
||||
. 100244)) (100440 108278 (CDBROWSER 100450 . 104377) (CDBROWSER.STRINGS 104379 . 108276)) (108440
|
||||
110176 (CD.TABLEITEM 108450 . 108670) (CD.TABLEITEM.PRINTFN 108672 . 108871) (CD.TABLEITEM.COPYFN
|
||||
108873 . 109931) (CDTABLEBROWSER.HEADING.REPAINTFN 109933 . 110174)) (110177 130832 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 110187 . 110655) (CD.COMMANDSELECTEDFN 110657 . 115758) (CD-MENUFN
|
||||
115760 . 120071) (CD-COMPARE-FILES 120073 . 123425) (CDBROWSER-COPY 123427 . 127096) (
|
||||
CDBROWSER-DELETE-FILE 127098 . 130311) (CD-SWAPDIRS 130313 . 130830)))))
|
||||
(FILEMAP (NIL (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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13 65523
|
||||
(FILECREATED "25-May-2024 13:19:49" {WMEDLEY}<lispusers>DINFO.;14 65819
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM DINFO.UPDATE.TEXT.DISPLAY)
|
||||
|
||||
:PREVIOUS-DATE "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12)
|
||||
:PREVIOUS-DATE "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DINFOCOMS)
|
||||
@@ -988,17 +988,18 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.TEXT.DISPLAY
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 3-Feb-2022 11:50 by rmk")
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 25-May-2024 13:16 by rmk")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(LET ((WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(FILENAME (DINFO.GET.FILENAME GRAPH NODE))
|
||||
(FROM (fetch (DINFONODE FROMBYTE) of NODE))
|
||||
(TO (fetch (DINFONODE TOBYTE) of NODE))
|
||||
(PROPS (APPEND (LIST 'READONLY T 'NOTITLE T 'TITLEMENUFN 'DINFO.TITLEMENUFN)
|
||||
(PROPS (APPEND (LIST 'READONLY 'QUIET 'NOTITLE T 'TITLEMENUFN (FUNCTION DINFO.TITLEMENUFN))
|
||||
(fetch (DINFOGRAPH TEXTPROPS) of GRAPH)))
|
||||
(OLD.TEXTSTREAM (WINDOWPROP (fetch (DINFOGRAPH WINDOW) of GRAPH)
|
||||
'TEXTSTREAM))
|
||||
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
|
||||
TEXTSTREAM FULLFILENAME) (* ; "Default directory and host.")
|
||||
(if (OR OFF? (NULL FILENAME))
|
||||
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
|
||||
WINDOW NIL NIL PROPS)
|
||||
@@ -1036,7 +1037,8 @@
|
||||
(PROMPTPRINT "DInfo is busy"])
|
||||
|
||||
(DINFO.OPENTEXTSTREAM
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 25-May-2024 13:17 by rmk")
|
||||
(* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 15:37 by rmk")
|
||||
(* drc%: "25-Jan-86 18:24")
|
||||
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
|
||||
@@ -1053,7 +1055,8 @@
|
||||
(CLEARW T)
|
||||
(CLEARW WINDOW)
|
||||
[RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
|
||||
(PROG1 (OPENTEXTSTREAM FILE WINDOW FROM TO PROPS)
|
||||
(PROG1 (TEDIT (OPENTEXTSTREAM FILE NIL FROM TO PROPS)
|
||||
WINDOW)
|
||||
(replace (DINFOGRAPH LAST.TEXT) of (DINFOGRAPH WINDOW) with THIS.TEXT))])
|
||||
|
||||
(DINFO.SHOWSEL
|
||||
@@ -1110,21 +1113,21 @@
|
||||
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4556 6015 (DINFOGRAPHPROP 4556 . 6015)) (7269 24407 (DINFO 7279 . 8893) (DINFO.UPDATE
|
||||
8895 . 11759) (DINFOGRAPH 11761 . 12179) (DINFO.SPECIAL.UPDATE 12181 . 13879) (DINFO.READ.GRAPH 13881
|
||||
. 15736) (DINFO.WRITE.GRAPH 15738 . 16828) (DINFO.SELECT.GRAPH 16830 . 17737) (DINFO.DEFAULT.MENU
|
||||
17739 . 20263) (DINFO.FIND 20265 . 22851) (DINFO.LOOKUP 22853 . 24405)) (24408 27102 (
|
||||
DINFO.READ.KOTO.GRAPH 24418 . 27100)) (27103 29417 (DINFO.SETUP.WINDOW 27113 . 27794) (DINFO.CLOSEFN
|
||||
27796 . 28229) (DINFO.SHRINKFN 28231 . 28427) (DINFO.EXPANDFN 28429 . 28986) (DINFO.ICONFN 28988 .
|
||||
29415)) (29418 40740 (DINFO.ADD.FMENU 29428 . 30523) (DINFO.CREATE.FMENU 30525 . 34552) (
|
||||
DINFO.FMW.CLOSEFN 34554 . 35399) (DINFO.FMENU.HANDLER 35401 . 36040) (DINFO.UPDATE.FMENU 36042 . 38231
|
||||
) (DINFO.TOGGLE.MENU 38233 . 38823) (DINFO.TOGGLE.GRAPH 38825 . 39324) (DINFO.TOGGLE.HISTORY 39326 .
|
||||
39870) (DINFO.TOGGLE.TEXT 39872 . 40738)) (40741 48536 (DINFO.UPDATE.MENU.DISPLAY 40751 . 44872) (
|
||||
DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINFO.HISTORIC.UPDATE
|
||||
47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
|
||||
. 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
|
||||
DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
|
||||
58867 64936 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
|
||||
DINFO.OPENTEXTSTREAM 61954 . 63296) (DINFO.SHOWSEL 63298 . 64031) (DINFO.GET.FILENAME 64033 . 64934)))
|
||||
(FILEMAP (NIL (4582 6041 (DINFOGRAPHPROP 4582 . 6041)) (7295 24433 (DINFO 7305 . 8919) (DINFO.UPDATE
|
||||
8921 . 11785) (DINFOGRAPH 11787 . 12205) (DINFO.SPECIAL.UPDATE 12207 . 13905) (DINFO.READ.GRAPH 13907
|
||||
. 15762) (DINFO.WRITE.GRAPH 15764 . 16854) (DINFO.SELECT.GRAPH 16856 . 17763) (DINFO.DEFAULT.MENU
|
||||
17765 . 20289) (DINFO.FIND 20291 . 22877) (DINFO.LOOKUP 22879 . 24431)) (24434 27128 (
|
||||
DINFO.READ.KOTO.GRAPH 24444 . 27126)) (27129 29443 (DINFO.SETUP.WINDOW 27139 . 27820) (DINFO.CLOSEFN
|
||||
27822 . 28255) (DINFO.SHRINKFN 28257 . 28453) (DINFO.EXPANDFN 28455 . 29012) (DINFO.ICONFN 29014 .
|
||||
29441)) (29444 40766 (DINFO.ADD.FMENU 29454 . 30549) (DINFO.CREATE.FMENU 30551 . 34578) (
|
||||
DINFO.FMW.CLOSEFN 34580 . 35425) (DINFO.FMENU.HANDLER 35427 . 36066) (DINFO.UPDATE.FMENU 36068 . 38257
|
||||
) (DINFO.TOGGLE.MENU 38259 . 38849) (DINFO.TOGGLE.GRAPH 38851 . 39350) (DINFO.TOGGLE.HISTORY 39352 .
|
||||
39896) (DINFO.TOGGLE.TEXT 39898 . 40764)) (40767 48562 (DINFO.UPDATE.MENU.DISPLAY 40777 . 44898) (
|
||||
DINFO.UPDATE.FROM.MENU 44900 . 45199) (DINFO.UPDATE.HISTORY 45201 . 47731) (DINFO.HISTORIC.UPDATE
|
||||
47733 . 48560)) (48563 58892 (DINFO.UPDATE.GRAPH.DISPLAY 48573 . 50025) (DINFO.UPDATE.FROM.GRAPH 50027
|
||||
. 50503) (DINFO.GET.GRAPH.WINDOW 50505 . 51090) (DINFO.CREATE.GRAPH.WINDOW 51092 . 52209) (
|
||||
DINFO.SHOWGRAPH 52211 . 53936) (DINFO.INVERT.NODE 53938 . 55326) (DINFO.LAYOUTGRAPH 55328 . 58890)) (
|
||||
58893 65232 (DINFO.UPDATE.TEXT.DISPLAY 58903 . 60963) (DINFO.TITLEMENUFN 60965 . 62090) (
|
||||
DINFO.OPENTEXTSTREAM 62092 . 63592) (DINFO.SHOWSEL 63594 . 64327) (DINFO.GET.FILENAME 64329 . 65230)))
|
||||
))
|
||||
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,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Mar-2024 23:42:37" {WMEDLEY}<lispusers>DOC-OBJECTS.;36 52788
|
||||
(FILECREATED " 9-Dec-2024 21:07:13" {WMEDLEY}<lispusers>DOC-OBJECTS.;58 52672
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DOCOBJ-INCLUDE-EDIT-WINDOWP)
|
||||
:CHANGES-TO (FNS DOCOBJ-STRING-IMAGEBOX)
|
||||
|
||||
:PREVIOUS-DATE "19-Mar-2024 19:36:25" {WMEDLEY}<lispusers>DOC-OBJECTS.;35)
|
||||
:PREVIOUS-DATE " 8-Dec-2024 15:49:01" {WMEDLEY}<lispusers>DOC-OBJECTS.;57)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DOC-OBJECTSCOMS)
|
||||
@@ -17,7 +17,7 @@
|
||||
(* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities. The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object. This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands). Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ. Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments. They can be (and are) used freely to record state or other desired info. The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc.")
|
||||
|
||||
(FILES (SYSLOAD)
|
||||
TEDIT TEDIT IMAGEOBJ)
|
||||
TEDIT IMAGEOBJ)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
|
||||
(VARS (DocObjectsMenu NIL)
|
||||
(DocObjectsConfirmEditMenu NIL))
|
||||
@@ -28,7 +28,7 @@
|
||||
|
||||
(FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS
|
||||
DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE
|
||||
DOCOBJ-INVOKE-IMAGEOBJFN DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
|
||||
DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
|
||||
[COMS
|
||||
(* ;; "Eval'd Form")
|
||||
|
||||
@@ -108,7 +108,7 @@
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
TEDIT TEDIT IMAGEOBJ)
|
||||
TEDIT IMAGEOBJ)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD TEDIT-EXPORTS.ALL)
|
||||
@@ -167,44 +167,37 @@
|
||||
(GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM])
|
||||
|
||||
(DOCOBJ-GET-LOOKS
|
||||
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 19-Mar-2024 19:36 by rmk")
|
||||
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 5-Apr-2024 12:20 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 19:36 by rmk")
|
||||
(* ; "Edited 29-Oct-2022 21:30 by rmk")
|
||||
(* Koomen " 4-Feb-87 23:37")
|
||||
|
||||
(* ;;; "Adapted from {ERIS}<TEDIT>TEDITLOOKS.;30 dated '15-Oct-85 16:51:10' to return looks itself, rather than a proplist.")
|
||||
(* jds "10-Jul-85 16:02")
|
||||
(* ; "Return a PLIST of character looks")
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
LOOKS FONT NLOOKS)
|
||||
[COND
|
||||
((type? CHARLOOKS CH#ORCHARLOOKS) (* ;
|
||||
(LET ((TEXTOBJ (TEXTOBJ TEXTOBJ)))
|
||||
(if (type? CHARLOOKS CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"He handed us a CHARLOOKS. Unparse it for him.")
|
||||
(SETQ LOOKS CH#ORCHARLOOKS))
|
||||
((ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) (* ;
|
||||
CH#ORCHARLOOKS
|
||||
elseif (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
|
||||
then (* ;
|
||||
"There's no text in the document. Use the extant caret looks.")
|
||||
(SETQ LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)))
|
||||
[(FIXP CH#ORCHARLOOKS) (* ;
|
||||
(FGETTOBJ TEXTOBJ CARETLOOKS)
|
||||
else (PLOOKS (\TEDIT.CHTOPC (if (FIXP CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"He gave us a CH# to get the looks of. Grab it.")
|
||||
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
CH#ORCHARLOOKS)
|
||||
TEXTOBJ]
|
||||
[(type? SELECTION CH#ORCHARLOOKS) (* ;
|
||||
CH#ORCHARLOOKS
|
||||
elseif (type? SELECTION CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"Get the looks of the selected text")
|
||||
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
(GETSEL CH#ORCHARLOOKS CH#))
|
||||
TEXTOBJ]
|
||||
((NULL CH#ORCHARLOOKS) (* ;
|
||||
(GETSEL CH#ORCHARLOOKS CH#)
|
||||
elseif (NULL CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"Get the looks of the selected text")
|
||||
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||
(GETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
CH#))
|
||||
TEXTOBJ]
|
||||
(RETURN LOOKS)
|
||||
|
||||
(* ;;; "Now break the looks apart into a PROPLIST")
|
||||
|
||||
(SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS))
|
||||
(RETURN NLOOKS])
|
||||
(GETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
CH#))
|
||||
TEXTOBJ])
|
||||
|
||||
(DOCOBJ-REGISTER-OBJECT
|
||||
[LAMBDA (OBJECT) (* ; "Edited 23-Oct-87 14:48 by Koomen")
|
||||
@@ -218,8 +211,9 @@
|
||||
OBJECT])
|
||||
|
||||
(DOCOBJ-STRING-IMAGEBOX
|
||||
[LAMBDA (STRING IMAGESTREAM) (* Koomen " 9-Feb-87 17:22")
|
||||
(DECLARE (SPECVARS CHNO TEXTOBJ))
|
||||
[LAMBDA (STRING IMAGESTREAM) (* ; "Edited 9-Dec-2024 21:04 by rmk")
|
||||
(* Koomen " 9-Feb-87 17:22")
|
||||
(DECLARE (USEDFREE CHNO TEXTOBJ))
|
||||
(PROG (LOOKS CLOFFSET FONT DEVICE HEIGHT DESCENT)
|
||||
(SETQ LOOKS (DOCOBJ-GET-LOOKS TEXTOBJ CHNO))
|
||||
(SETQ CLOFFSET (fetch (CHARLOOKS CLOFFSET) of LOOKS))
|
||||
@@ -230,10 +224,10 @@
|
||||
(SETQ HEIGHT (FONTHEIGHT FONT))
|
||||
(SETQ DESCENT (FONTPROP FONT 'DESCENT))
|
||||
(RETURN (create IMAGEBOX
|
||||
XSIZE _ (STRINGWIDTH STRING FONT)
|
||||
YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
|
||||
YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
|
||||
XKERN _ 0])
|
||||
XSIZE _ (STRINGWIDTH STRING FONT)
|
||||
YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
|
||||
YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
|
||||
XKERN _ 0])
|
||||
|
||||
(DOCOBJ-WAIT-MOUSE
|
||||
[LAMBDA (STREAM) (* ;
|
||||
@@ -245,108 +239,104 @@
|
||||
(LASTMOUSEY STREAM)))
|
||||
then (RETURN NIL)) finally (RETURN T])
|
||||
|
||||
(DOCOBJ-INVOKE-IMAGEOBJFN
|
||||
[LAMBDA (CH# PIECE IMAGEOBJFNNAME) (* ; "Edited 28-Jun-2023 19:45 by rmk")
|
||||
(* ; "Edited 9-Sep-2022 16:10 by rmk")
|
||||
(* ; "Edited 7-Sep-2022 23:11 by rmk")
|
||||
(* ; "Edited 6-Sep-2022 10:05 by rmk")
|
||||
(* ; "Edited 15-Oct-87 23:35 by Koomen")
|
||||
|
||||
(* ;; "If PIECE is an IMAGEOBJ, invoke the function associated with the ImageObj property IMAGEOBJFNNAME on the IMAGEOBJ and the character position where the IMAGEOBJ is located. ")
|
||||
|
||||
(CL:WHEN (AND (type? PIECE PIECE)
|
||||
(EQ OBJECT.PTYPE (PTYPE PIECE)))
|
||||
(LET ((IMAGEOBJ (PCONTENTS PIECE))
|
||||
IMAGEOBJFN)
|
||||
(SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME))
|
||||
(CL:WHEN (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN))
|
||||
(APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE))))])
|
||||
|
||||
(DOCOBJ-BEFOREHARDCOPYFN
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 16-Mar-2024 10:05 by rmk")
|
||||
[LAMBDA (TEXTSTREAM) (* ; "Edited 8-Dec-2024 15:48 by rmk")
|
||||
(* ; "Edited 12-Jul-2024 12:46 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 00:09 by rmk")
|
||||
(* ; "Edited 8-May-2024 00:05 by rmk")
|
||||
(* ; "Edited 6-May-2024 22:50 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:03 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:05 by rmk")
|
||||
(* ; "Edited 16-Jul-2023 16:53 by rmk")
|
||||
(* ; "Edited 10-Jul-2023 22:29 by rmk")
|
||||
(* ;
|
||||
"Edited 25-May-93 13:07 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "This is the only BEFOREHARDCOPYFN, provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and the piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")
|
||||
(* ;; "This is the only BEFOREHARDCOPYFN provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and te piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")
|
||||
|
||||
(* ;; "This runs through the file applying the BEFOREHARDCOPYFN of every object that has one. For example, an include object will replace the object by its target file.")
|
||||
|
||||
(* ;; "This records all of the history events created during the object pass into a single composite even so that the DOCOBJ-AFTERHARDCOPYFN can restore the stream to its original state.")
|
||||
|
||||
(RESETLST
|
||||
|
||||
(* ;; "We don't want to update the display lines to show the intermediate state while we are updating the pieces. ")
|
||||
|
||||
(RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
|
||||
`(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
|
||||
(LET ((PREVEVENTS (GETTOBJ TEXTOBJ TXTHISTORY))
|
||||
(OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
|
||||
(PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
|
||||
FAILED)
|
||||
(TEDIT.DEFER.UPDATES TEXTSTREAM)
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
|
||||
(PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
|
||||
FAILED EVENTS)
|
||||
|
||||
(* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.")
|
||||
(* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.")
|
||||
|
||||
[bind OBJ FN PREVPC (CH# _ 1)
|
||||
(PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC
|
||||
do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC))
|
||||
(SETQ OBJ (PCONTENTS PC))
|
||||
(SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
|
||||
(DEFINEDP FN))
|
||||
then (SETQ PREVPC (PREVPIECE PC))
|
||||
(CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
|
||||
(SETQ FAILED T)
|
||||
(RETURN))
|
||||
(if PREVPC
|
||||
then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC))
|
||||
then
|
||||
(* ;;
|
||||
[bind OBJ FN PREVPC (CH# _ 1)
|
||||
(PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC
|
||||
do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC))
|
||||
(SETQ OBJ (PCONTENTS PC))
|
||||
(SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
|
||||
(DEFINEDP FN))
|
||||
then (SETQ PREVPC (PREVPIECE PC))
|
||||
(CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
|
||||
(SETQ FAILED T)
|
||||
(RETURN))
|
||||
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
|
||||
(* ; "Accumulate undo events")
|
||||
(if PREVPC
|
||||
then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC))
|
||||
then
|
||||
(* ;;
|
||||
"Nothing affected this PC, advance")
|
||||
|
||||
(add CH# (PLEN PC))
|
||||
PC
|
||||
else
|
||||
(* ;;
|
||||
(add CH# (PLEN PC))
|
||||
PC
|
||||
else
|
||||
(* ;;
|
||||
"Otherwise investigate its replacement")
|
||||
|
||||
PREVPC))
|
||||
elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
then (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC)
|
||||
else
|
||||
(* ;;
|
||||
PREVPC))
|
||||
elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
then (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC)
|
||||
else
|
||||
(* ;;
|
||||
"Investigate the replacement of the previous first piece.")
|
||||
|
||||
(\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
else (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC] (* ; "Restore previous settings")
|
||||
(\TEDIT.FIRSTPIECE TEXTOBJ))
|
||||
else (add CH# (PLEN PC))
|
||||
(NEXTPIECE PC] (* ; "Restore previous settings")
|
||||
(* ;
|
||||
"The history event may restore SEL, but...")
|
||||
(SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
|
||||
(SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
|
||||
|
||||
(* ;; "Make a single undoing event for the after fn")
|
||||
(* ;; "Make a single event for the afterfn to undo")
|
||||
|
||||
(for ETAIL on (GETTOBJ TEXTOBJ TXTHISTORY) until (EQ ETAIL PREVEVENTS)
|
||||
collect (CAR ETAIL) finally (SETTOBJ TEXTOBJ TXTHISTORY (CONS $$VAL PREVEVENTS)))
|
||||
|
||||
(* ;; "In case something screws up, at least redisplaying will show something correctly (even if we aren't \DIRTY)")
|
||||
|
||||
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
|
||||
(CL:WHEN FAILED
|
||||
(DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM TEXTOBJ) (* ; "UNDO whatever was saved")
|
||||
(SETTOBJ TEXTOBJ SEL PREVSEL)
|
||||
'DON'T)))])
|
||||
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS)
|
||||
(CL:WHEN FAILED
|
||||
(DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM) (* ; "UNDO whatever was saved")
|
||||
(SETTOBJ TEXTOBJ SEL PREVSEL)
|
||||
'DON'T)))])
|
||||
|
||||
(DOCOBJ-AFTERHARDCOPYFN
|
||||
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 15-Mar-2024 14:24 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 7-Jul-2024 00:07 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 22:59 by rmk")
|
||||
(* ; "Edited 3-Jul-2024 09:55 by rmk")
|
||||
(* ; "Edited 8-May-2024 10:42 by rmk")
|
||||
(* ; "Edited 7-May-2024 08:20 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 08:05 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 14:24 by rmk")
|
||||
(* ; "Edited 15-Jul-2023 15:57 by rmk")
|
||||
(* ;
|
||||
"Edited 25-May-93 13:08 by sybalsky:mv:envos")
|
||||
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
|
||||
(RESETLST
|
||||
(RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
|
||||
`(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
|
||||
(LET ((PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
|
||||
(TEDIT.UNDO TEXTOBJ)
|
||||
(SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)
|
||||
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
|
||||
(\TEDIT.UPDATE.SCREEN TEXTOBJ)))])
|
||||
[RESETSAVE (TEXTPROP TSTREAM 'DON'TUPDATE T)
|
||||
`(PROGN (TEXTPROP ,TSTREAM 'DON'TUPDATE OLDVALUE)
|
||||
(\TEDIT.FILL.PANES ,TSTREAM]
|
||||
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
|
||||
(TEDIT.UNDO TSTREAM T)
|
||||
(SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -750,11 +740,10 @@
|
||||
IMAGEOBJ])
|
||||
|
||||
(DOCOBJ-INCLUDE-EDIT
|
||||
[LAMBDA (INCLOBJ) (* ; "Edited 9-May-2018 11:09 by rmk:")
|
||||
(* ; "Edited 9-May-2018 10:35 by rmk:")
|
||||
(* ;
|
||||
"Edited 26-Oct-87 19:57 by Koomen")
|
||||
(DECLARE (SPECVARS TEXTOBJ))
|
||||
[LAMBDA (INCLOBJ TSTREAM) (* ; "Edited 12-May-2024 09:03 by rmk")
|
||||
(* ; "Edited 9-May-2018 11:09 by rmk:")
|
||||
(* ; "Edited 9-May-2018 10:35 by rmk:")
|
||||
(* ; "Edited 26-Oct-87 19:57 by Koomen")
|
||||
(SELECTQ [MENU (OR DOCOBJ-INCLUDE-EDITMENU (SETQ DOCOBJ-INCLUDE-EDITMENU
|
||||
(create MENU
|
||||
TITLE _ "Edit Include"
|
||||
@@ -771,41 +760,38 @@
|
||||
CENTERFLG _ T
|
||||
MENUOFFSET _ '(-1 . 30)
|
||||
CHANGEOFFSETFLG _ 'Y]
|
||||
(NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TEXTOBJ "Enter new file name: " (fetch
|
||||
(INCLOBJ FILENAME)
|
||||
(NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TSTREAM "Enter new file name: " (fetch (INCLOBJ
|
||||
FILENAME)
|
||||
of INCLOBJ]
|
||||
(if [AND NEWNAME (SETQ NEWNAME (MKSTRING NEWNAME))
|
||||
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
then (replace (INCLOBJ FILENAME) of INCLOBJ with NEWNAME)
|
||||
T)))
|
||||
T)))
|
||||
(EDIT.FILE (for W in (OPENWINDOWS)
|
||||
bind [FULLNAME _ (OR [FINDFILE (fetch (INCLOBJ FILENAME) of INCLOBJ
|
||||
)
|
||||
T
|
||||
(CONS (PACKFILENAME.STRING 'HOST
|
||||
(FILENAMEFIELD (FETCH TXTFILE
|
||||
OF TEXTOBJ)
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD (FETCH TXTFILE
|
||||
OF TEXTOBJ)
|
||||
'DIRECTORY]
|
||||
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
bind [FULLNAME _ (OR (FINDFILE-WITH-EXTENSIONS
|
||||
(fetch (INCLOBJ FILENAME) of INCLOBJ)
|
||||
(CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
|
||||
TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE 'DIRECTORY))
|
||||
DIRECTORIES)
|
||||
*TEDIT-EXTENSIONS*)
|
||||
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
first (if (NULL FULLNAME)
|
||||
then (TEDIT.PROMPTPRINT TEXTOBJ "Can't find " T)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (fetch (INCLOBJ FILENAME)
|
||||
of INCLOBJ))
|
||||
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP
|
||||
FULLNAME W))
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Can't find " T)
|
||||
(TEDIT.PROMPTPRINT TSTREAM (fetch (INCLOBJ FILENAME)
|
||||
of INCLOBJ))
|
||||
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W))
|
||||
do (TOTOPW W)
|
||||
(GIVE.TTY.PROCESS W)
|
||||
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
|
||||
(GIVE.TTY.PROCESS W)
|
||||
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
|
||||
(ENABLE (if (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ))
|
||||
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with T)
|
||||
T))
|
||||
T))
|
||||
(DISABLE (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
|
||||
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL)
|
||||
T))
|
||||
T))
|
||||
NIL])
|
||||
|
||||
(DOCOBJ-INCLUDE-EDIT-WINDOWP
|
||||
@@ -842,56 +828,51 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DOCOBJ-INCLUDE-BEFOREHARDCOPYFN
|
||||
[LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 16-Feb-2024 23:47 by rmk")
|
||||
[LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 13-Sep-2024 15:13 by rmk")
|
||||
(* ; "Edited 12-May-2024 08:48 by rmk")
|
||||
(* ; "Edited 7-May-2024 23:33 by rmk")
|
||||
(* ; "Edited 16-Feb-2024 23:47 by rmk")
|
||||
(* ; "Edited 23-Jul-2023 22:45 by rmk")
|
||||
(* ; "Edited 16-Jul-2023 11:14 by rmk")
|
||||
(* ; "Edited 10-Jul-2023 22:18 by rmk")
|
||||
(* ; "Edited 22-Jun-2023 16:44 by rmk")
|
||||
|
||||
(* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the lookos of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.'")
|
||||
(* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the looks of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.")
|
||||
|
||||
(* ;; "Returns T if the inclusion is succeeds as intended, NIL otherwise.")
|
||||
|
||||
(* ;; "Not sure why the INCLUDEDP property. If enabled, it's included.")
|
||||
|
||||
(if (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM))
|
||||
then (LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM]
|
||||
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||
INCLSTREAM)
|
||||
[SETQ INCLFILE (FINDFILE INCLFILE T (AND TXTFILE (CONS (PACKFILENAME.STRING
|
||||
'HOST
|
||||
(FILENAMEFIELD TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE
|
||||
'DIRECTORY))
|
||||
DIRECTORIES]
|
||||
(if INCLFILE
|
||||
then
|
||||
(* ;; "No point in prompting: it just flashes by")
|
||||
(CL:WHEN (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM))
|
||||
(LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM]
|
||||
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE)))
|
||||
(SETQ INCLFILE (FINDFILE-WITH-EXTENSIONS INCLFILE
|
||||
(AND TXTFILE (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
|
||||
TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE 'DIRECTORY))
|
||||
DIRECTORIES))
|
||||
*TEDIT-EXTENSIONS*))
|
||||
(if INCLFILE
|
||||
then (* ; "Don't update/show until end")
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
CH# 1 'LEFT) (* ; "Deletes this include-object")
|
||||
(\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ))
|
||||
(TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included " INCLFILE))
|
||||
|
||||
(AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE "...")
|
||||
T))
|
||||
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
|
||||
CH# 1 'LEFT T) (* ; "Set the destination")
|
||||
(\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)
|
||||
T)
|
||||
(TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
|
||||
(AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE
|
||||
"...done")))
|
||||
else
|
||||
(* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")
|
||||
(* ;; "Succeeded as intended")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME
|
||||
)
|
||||
of OBJ)
|
||||
" not found")
|
||||
T T)
|
||||
NIL))
|
||||
else
|
||||
(* ;; "Succeeded as intended")
|
||||
T
|
||||
else
|
||||
(* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")
|
||||
|
||||
T])
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME)
|
||||
of OBJ)
|
||||
" not found")
|
||||
T T)
|
||||
NIL)))])
|
||||
|
||||
(DOCOBJ-INCLUDE-CLEANUPFN
|
||||
[LAMBDA (TEXTSTREAM STARTPOS LEN) (* ; "Edited 15-Mar-2024 14:08 by rmk")
|
||||
@@ -919,12 +900,13 @@
|
||||
|
||||
(DOCOBJ-INCLUDE-BUTTONEVENTINFN
|
||||
[LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
|
||||
(* ; "Edited 12-May-2024 09:01 by rmk")
|
||||
(* ; "Edited 23-Oct-87 00:46 by Koomen")
|
||||
|
||||
(if (AND (EQ BUTTON 'MIDDLE)
|
||||
(DOCOBJ-WAIT-MOUSE WINDOWSTREAM))
|
||||
then (ALLOW.BUTTON.EVENTS)
|
||||
(if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))
|
||||
(if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)
|
||||
HOSTSTREAM)
|
||||
then (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ)
|
||||
'CHANGED])
|
||||
|
||||
@@ -1011,30 +993,29 @@
|
||||
(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7682 21029 (DOCOBJ-ACQUIRE-OBJECT 7692 . 8693) (DOCOBJ-INIT 8695 . 9323) (
|
||||
DOCOBJ-TEDIT-MENU-ENTRY 9325 . 9747) (DOCOBJ-GET-LOOKS 9749 . 12364) (DOCOBJ-REGISTER-OBJECT 12366 .
|
||||
13020) (DOCOBJ-STRING-IMAGEBOX 13022 . 13970) (DOCOBJ-WAIT-MOUSE 13972 . 14432) (
|
||||
DOCOBJ-INVOKE-IMAGEOBJFN 14434 . 15557) (DOCOBJ-BEFOREHARDCOPYFN 15559 . 20205) (
|
||||
DOCOBJ-AFTERHARDCOPYFN 20207 . 21027)) (21059 21326 (DOCOBJ-ACQUIRE-EVALED-OBJECT 21069 . 21324)) (
|
||||
21526 21668 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21536 . 21666)) (22007 26803 (DOCOBJ-EDIT-TIMESTAMP 22017
|
||||
. 22546) (DOCOBJ-MAKE-TIMESTAMP 22548 . 22959) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 22961 . 24031) (
|
||||
DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24033 . 24564) (DOCOBJ-TIMESTAMP-COPYFN 24566 . 24891) (
|
||||
DOCOBJ-TIMESTAMP-DISPLAYFN 24893 . 25186) (DOCOBJ-TIMESTAMP-GETFN 25188 . 25428) (
|
||||
DOCOBJ-TIMESTAMP-IMAGEBOXFN 25430 . 25786) (DOCOBJ-TIMESTAMP-PREPRINTFN 25788 . 26019) (
|
||||
DOCOBJ-TIMESTAMP-PUTFN 26021 . 26390) (DOCOBJ-TIMESTAMP-TO-STRING 26392 . 26801)) (27097 31404 (
|
||||
DOCOBJ-MAKE-FILESTAMP 27107 . 27448) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27450 . 28492) (
|
||||
DOCOBJ-FILESTAMP-COPYFN 28494 . 28809) (DOCOBJ-FILESTAMP-DISPLAYFN 28811 . 29099) (
|
||||
DOCOBJ-FILESTAMP-GETFN 29101 . 29454) (DOCOBJ-FILESTAMP-IMAGEBOXFN 29456 . 29794) (
|
||||
DOCOBJ-FILESTAMP-GET-FULLNAME 29796 . 30414) (DOCOBJ-FILESTAMP-NEW-FULLNAME 30416 . 30889) (
|
||||
DOCOBJ-FILESTAMP-PREPRINTFN 30891 . 31100) (DOCOBJ-FILESTAMP-PUTFN 31102 . 31402)) (31727 34224 (
|
||||
DOCOBJ-MAKE-HRULE 31737 . 32151) (DOCOBJ-EDIT-HRULE 32153 . 32625) (DOCOBJ-HRULE-INIT 32627 . 32959) (
|
||||
DOCOBJ-HRULE-GET-WIDTH 32961 . 33772) (DOCOBJ-HRULE-BUTTONEVENTINFN 33774 . 34222)) (34643 43315 (
|
||||
DOCOBJ-MAKE-INCLUDE 34653 . 35054) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35056 . 36061) (
|
||||
DOCOBJ-INCLUDE-CREATE-OBJ 36063 . 36831) (DOCOBJ-INCLUDE-EDIT 36833 . 41432) (
|
||||
DOCOBJ-INCLUDE-EDIT-WINDOWP 41434 . 42290) (DOCOBJ-INCLUDE-RESET-OBJ 42292 . 43313)) (43316 52247 (
|
||||
DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43326 . 47048) (DOCOBJ-INCLUDE-CLEANUPFN 47050 . 48569) (
|
||||
DOCOBJ-INCLUDE-BUTTONEVENTINFN 48571 . 49105) (DOCOBJ-INCLUDE-COPYFN 49107 . 49325) (
|
||||
DOCOBJ-INCLUDE-DISPLAYFN 49327 . 50079) (DOCOBJ-INCLUDE-GETFN 50081 . 50804) (
|
||||
DOCOBJ-INCLUDE-IMAGEBOXFN 50806 . 51815) (DOCOBJ-INCLUDE-PREPRINTFN 51817 . 52036) (
|
||||
DOCOBJ-INCLUDE-PUTFN 52038 . 52245)))))
|
||||
(FILEMAP (NIL (7640 21328 (DOCOBJ-ACQUIRE-OBJECT 7650 . 8651) (DOCOBJ-INIT 8653 . 9281) (
|
||||
DOCOBJ-TEDIT-MENU-ENTRY 9283 . 9705) (DOCOBJ-GET-LOOKS 9707 . 12167) (DOCOBJ-REGISTER-OBJECT 12169 .
|
||||
12823) (DOCOBJ-STRING-IMAGEBOX 12825 . 13881) (DOCOBJ-WAIT-MOUSE 13883 . 14343) (
|
||||
DOCOBJ-BEFOREHARDCOPYFN 14345 . 19815) (DOCOBJ-AFTERHARDCOPYFN 19817 . 21326)) (21358 21625 (
|
||||
DOCOBJ-ACQUIRE-EVALED-OBJECT 21368 . 21623)) (21825 21967 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21835 . 21965
|
||||
)) (22306 27102 (DOCOBJ-EDIT-TIMESTAMP 22316 . 22845) (DOCOBJ-MAKE-TIMESTAMP 22847 . 23258) (
|
||||
DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23260 . 24330) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24332 . 24863) (
|
||||
DOCOBJ-TIMESTAMP-COPYFN 24865 . 25190) (DOCOBJ-TIMESTAMP-DISPLAYFN 25192 . 25485) (
|
||||
DOCOBJ-TIMESTAMP-GETFN 25487 . 25727) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25729 . 26085) (
|
||||
DOCOBJ-TIMESTAMP-PREPRINTFN 26087 . 26318) (DOCOBJ-TIMESTAMP-PUTFN 26320 . 26689) (
|
||||
DOCOBJ-TIMESTAMP-TO-STRING 26691 . 27100)) (27396 31703 (DOCOBJ-MAKE-FILESTAMP 27406 . 27747) (
|
||||
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27749 . 28791) (DOCOBJ-FILESTAMP-COPYFN 28793 . 29108) (
|
||||
DOCOBJ-FILESTAMP-DISPLAYFN 29110 . 29398) (DOCOBJ-FILESTAMP-GETFN 29400 . 29753) (
|
||||
DOCOBJ-FILESTAMP-IMAGEBOXFN 29755 . 30093) (DOCOBJ-FILESTAMP-GET-FULLNAME 30095 . 30713) (
|
||||
DOCOBJ-FILESTAMP-NEW-FULLNAME 30715 . 31188) (DOCOBJ-FILESTAMP-PREPRINTFN 31190 . 31399) (
|
||||
DOCOBJ-FILESTAMP-PUTFN 31401 . 31701)) (32026 34523 (DOCOBJ-MAKE-HRULE 32036 . 32450) (
|
||||
DOCOBJ-EDIT-HRULE 32452 . 32924) (DOCOBJ-HRULE-INIT 32926 . 33258) (DOCOBJ-HRULE-GET-WIDTH 33260 .
|
||||
34071) (DOCOBJ-HRULE-BUTTONEVENTINFN 34073 . 34521)) (34942 43284 (DOCOBJ-MAKE-INCLUDE 34952 . 35353)
|
||||
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35355 . 36360) (DOCOBJ-INCLUDE-CREATE-OBJ 36362 . 37130) (
|
||||
DOCOBJ-INCLUDE-EDIT 37132 . 41401) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41403 . 42259) (
|
||||
DOCOBJ-INCLUDE-RESET-OBJ 42261 . 43282)) (43285 52131 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43295 . 46789)
|
||||
(DOCOBJ-INCLUDE-CLEANUPFN 46791 . 48310) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48312 . 48989) (
|
||||
DOCOBJ-INCLUDE-COPYFN 48991 . 49209) (DOCOBJ-INCLUDE-DISPLAYFN 49211 . 49963) (DOCOBJ-INCLUDE-GETFN
|
||||
49965 . 50688) (DOCOBJ-INCLUDE-IMAGEBOXFN 50690 . 51699) (DOCOBJ-INCLUDE-PREPRINTFN 51701 . 51920) (
|
||||
DOCOBJ-INCLUDE-PUTFN 51922 . 52129)))))
|
||||
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